shithub: mlisp

ref: a88cd71d79e142d686b01ff33624a4cc8febb268
dir: /mem.c/

#include "lisp.h"

C cstore[NUMCONS];
F fstore[NUMFW];
word fmark[NUMFW/B2W];

int
cellp(C *c)
{
	return c >= &cstore[0] && c < &cstore[NUMCONS];
}
int
fwp(C *c)
{
	F *f = (F*)c;
	return f>= &fstore[0] && f < &fstore[NUMFW];
}


void
mark(C *c)
{
	C *a;
	F *f;
	int n;

tail:
	if(c == nil)
		return;

	/* Mark full word */
	f = (F*)c;
	if(fwp(c)){
		n = f - fstore;
		fmark[n/B2W] |= (word)1 << n%B2W;
		return;
	}

	/* Must be a cons cell */
	if(cellp(c)){
if(c->a == noval) print("car is NOVAL\n");
if(c->d == noval) print("cdr is NOVAL\n");
		if(c->ap & CAR_MARK)
			return;
		a = c->a;
		c->ap |= CAR_MARK;
		if(c->ap & CAR_ATOM){
			if(c->ap & (CAR_NUM|CAR_STR))
				return;
		}else
			mark(a);
		c = c->d;
		goto tail;
	}

	panic("invalid ptr: %p\n", c);
}

void
gc(void)
{
	int i, j;
	C *c, **cp;
	F *f;
	word m;
	int nc, nf;

	/* Mark */
	mark(oblist);
	for(i = 0; i < pdp; i++)
		mark(pdl[i]);
	for(cp = (C**)&temlis; cp < (C**)(&temlis+1); cp++)
		mark(*cp);

	/* Sweep */
	fclist = nil;
	nc = 0;
	for(c = cstore; c < &cstore[NUMCONS]; c++){
		if(c->ap & CAR_MARK)
			c->ap &= ~CAR_MARK;
		else{
			if(c->ap & CAR_ATOM){
				/* special handling for atoms */
				if(c->ap & CAR_STR)
print("freeing string <%s>\n", c->str),
					free(c->str);
			}
			c->a = nil;
			c->d = fclist;
			fclist = c;
			nc++;
		}
	}

	fflist = nil;
	f = fstore;
	nf = 0;
	for(i = 0; i < NUMFW/B2W; i++){
		m = fmark[i];
		fmark[i] = 0;
		for(j = 0; j < B2W; j++){
			if(!(m&1)){
				f->p = fflist;
				fflist = f;
				nf++;
			}
			m >>= 1;
			f++;
		}
	}

//	fprintf(stderr, "reclaimed: %d %d\n", nc, nf);
}