mplisp

miniPicoLisp with FFI and modules for Buddy BDD library, OpenGL, Gtk and GMP
git clone https://logand.com/git/mplisp.git/
Log | Files | Refs

gc.c (3337B)

      1 /* 15nov07abu
      2  * (c) Software Lab. Alexander Burger
      3  */
      4 
      5 #include "pico.h"
      6 
      7 /* Mark data */
      8 static void mark(any x) {
      9    while (isCell(x)) {
     10       if (!(num(cdr(x)) & 1))
     11          return;
     12       *(long*)&cdr(x) &= ~1;
     13       mark(car(x)),  x = cdr(x);
     14    }
     15    if (!isNum(x)  &&  num(val(x)) & 1) {
     16       *(long*)&val(x) &= ~1;
     17       mark(val(x)),  x = tail(x);
     18       while (isCell(x)) {
     19          if (!(num(cdr(x)) & 1))
     20             return;
     21          *(long*)&cdr(x) &= ~1;
     22          mark(cdr(x)),  x = car(x);
     23       }
     24       if (!isTxt(x))
     25          do {
     26             if (!(num(val(x)) & 1))
     27                return;
     28             *(long*)&val(x) &= ~1;
     29          } while (!isNum(x = val(x)));
     30    }
     31 }
     32 
     33 /* Garbage collector */
     34 static void gc(long c) {
     35    any p;
     36    heap *h;
     37    int i;
     38 
     39    h = Heaps;
     40    do {
     41       p = h->cells + CELLS-1;
     42       do
     43          *(long*)&cdr(p) |= 1;
     44       while (--p >= h->cells);
     45    } while (h = h->next);
     46    /* Mark */
     47    mark(Nil+1);
     48    mark(Intern[0]),  mark(Intern[1]);
     49    mark(Transient[0]), mark(Transient[1]);
     50    mark(ApplyArgs),  mark(ApplyBody);
     51    mark(Reloc);
     52    for (p = Env.stack; p; p = cdr(p))
     53       mark(car(p));
     54    for (p = (any)Env.bind;  p;  p = (any)((bindFrame*)p)->link)
     55       for (i = ((bindFrame*)p)->cnt;  --i >= 0;) {
     56          mark(((bindFrame*)p)->bnd[i].sym);
     57          mark(((bindFrame*)p)->bnd[i].val);
     58       }
     59    for (p = (any)CatchPtr; p; p = (any)((catchFrame*)p)->link)
     60       mark(((catchFrame*)p)->tag);
     61    for (p = (any)Env.meth;  p;  p = (any)((methFrame*)p)->link)
     62       mark(((methFrame*)p)->key),  mark(((methFrame*)p)->cls);
     63    if (Env.make)
     64       mark(car(Env.make));
     65    if (Env.parser)
     66       mark(Env.parser->sym);
     67    /* Sweep */
     68    Avail = NULL;
     69    h = Heaps;
     70    if (c) {
     71       do {
     72          p = h->cells + CELLS-1;
     73          do
     74             if (num(p->cdr) & 1)
     75                Free(p),  --c;
     76          while (--p >= h->cells);
     77       } while (h = h->next);
     78       while (c >= 0)
     79          heapAlloc(),  c -= CELLS;
     80    }
     81    else {
     82       heap **hp = &Heaps;
     83       cell *av;
     84 
     85       do {
     86          c = CELLS;
     87          av = Avail;
     88          p = h->cells + CELLS-1;
     89          do
     90             if (num(p->cdr) & 1)
     91                Free(p),  --c;
     92          while (--p >= h->cells);
     93          if (c)
     94             hp = &h->next,  h = h->next;
     95          else
     96             Avail = av,  h = h->next,  free(*hp),  *hp = h;
     97       } while (h);
     98    }
     99 }
    100 
    101 // (gc ['num]) -> num | NIL
    102 any doGc(any x) {
    103    x = cdr(x);
    104    gc(isNum(x = EVAL(car(x)))? CELLS*unBox(x) : CELLS);
    105    return x;
    106 }
    107 
    108 /* Construct a cell */
    109 any cons(any x, any y) {
    110    cell *p;
    111 
    112    if (!(p = Avail)) {
    113       cell c1, c2;
    114 
    115       Push(c1,x);
    116       Push(c2,y);
    117       gc(CELLS);
    118       drop(c1);
    119       p = Avail;
    120    }
    121    Avail = p->car;
    122    p->car = x;
    123    p->cdr = y;
    124    return p;
    125 }
    126 
    127 /* Construct a symbol */
    128 any consSym(any val, word w) {
    129    cell *p;
    130 
    131    if (!(p = Avail)) {
    132       cell c1;
    133 
    134       if (!val)
    135          gc(CELLS);
    136       else {
    137          Push(c1,val);
    138          gc(CELLS);
    139          drop(c1);
    140       }
    141       p = Avail;
    142    }
    143    Avail = p->car;
    144    p = symPtr(p);
    145    val(p) = val ?: p;
    146    tail(p) = txt(w);
    147    return p;
    148 }
    149 
    150 /* Construct a name cell */
    151 any consName(word w, any n) {
    152    cell *p;
    153 
    154    if (!(p = Avail)) {
    155       gc(CELLS);
    156       p = Avail;
    157    }
    158    Avail = p->car;
    159    p = symPtr(p);
    160    val(p) = n;
    161    tail(p) = (any)w;
    162    return p;
    163 }