picolisp

Unnamed repository; edit this file to name it for gitweb.
git clone https://logand.com/git/picolisp.git/
Log | Files | Refs | README | LICENSE

gc.c (3762B)

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