/****************************************************************/
/* memory.c:	memory manager for eulisp			*/
/*	Copyright(c) Toshihiro MATSUI
/*		     Electrotechnical Laboratory,1986.
/****************************************************************/

#if vxworks
#include	<sys/types.h>
#else
#include 	<sys/types.h>
#include	<sys/times.h>
#endif

#include	"eus.h"
#include	<synch.h>
#include	<thread.h>

#define nextbuddy(p) ((bpointer)((int)p+(buddy[p->h.bix].size<<2)))
#define marked(p)  (p->h.mark)
#define markon(p)  p->h.mark=1
#define markoff(p) p->h.mark=0

extern _end();

char *maxmemory=(char *)0x100000;
long freeheap=0,totalheap=0;	/*size of heap left and allocated*/
struct chunk *chunklist=NULL;
/* timers */
long gccount,marktime,sweeptime;
long alloccount[MAXBUDDY];

mutex_t alloc_lock;

newchunk(k)
register int k;
{ register int s;
  register struct chunk *cp;
  if (k<DEFAULTCHUNKINDEX) k=DEFAULTCHUNKINDEX;
  if (QDEBUG && debug) fprintf(stderr,";; newchunk: k=%d\n",k);
  s=buddy[k].size;
  cp=(struct chunk *)(malloc((s+2)*sizeof(pointer)+3) & ~3);
  maxmemory=(char *)sbrk(0);
  if (cp==NULL) return(ERR);	/*can't allocate new memory*/
  cp->nextchunk=chunklist;	/*link to chunk list*/
  chunklist=cp;
  cp->chunkbix=k;
  cp->rootcell.h.mark=0;
  cp->rootcell.h.b=1;		/*initial buddy marks*/
  cp->rootcell.h.m=0;
  cp->rootcell.h.bix=k;
  cp->rootcell.b.nextbcell=0;
  buddy[k].bp= &cp->rootcell;
  totalheap += s; freeheap += s;
  return(k);
  }

static void splitheap(k)	/*heart of the allocator*/
register int k;
{ register bpointer b1,b2,bnext;
  b1= buddy[k].bp;	/*root buddy pointer*/
  bnext=b1->b.nextbcell;
  buddy[k].bp= bnext;	/*remove first element*/
  b2= (bpointer)((long)b1+buddy[k-1].size*sizeof(pointer));
  if (k==2) {	/*b1 and b2 are of the same size*/
    b1->b.nextbcell=b2;
    b2->b.nextbcell=buddy[k-1].bp;
    buddy[k-1].bp=b1;
    b2->h.bix= 1;}
  else {
    b1->b.nextbcell= buddy[k-1].bp;
    buddy[k-1].bp=b1;
    b2->b.nextbcell=buddy[k-2].bp;
    buddy[k-2].bp=b2;
    b2->h.bix= k-2;}
  b2->h.m=b1->h.m;
  b1->h.m=b1->h.b;
  b1->h.b=0; b1->h.bix= k-1; b2->h.b=1;
  b2->h.mark=b2->h.smark=b2->h.pmark=0;}

pointer halloc(req,e,cid)
register int req;	/*index to buddy: must be greater than 0*/
int e;			/*element type*/
int cid;		/*class id*/
{ register int k=req;
  register struct buddybase *bbreq= &buddy[req];
  register bpointer b;
  register pointer p;
  numunion nu;

  mutex_lock(&alloc_lock);
  while (buddy[k].bp==0) k++;	/*find blocks of adequate size*/
  if (k>=MAXBUDDY) {		/*no enough room*/
    if (bbreq->size<totalheap/8) {	/*relatively small cell is requested;*/
      gc();			/* then try garbage collection*/
      while (freeheap<(totalheap*min(5.0,fltval(spevalof(GCMARGIN)))))
	newchunk(req); /*still not enough space*/
      for (k=req; buddy[k].bp==0; ) k++;}
    if (k>=MAXBUDDY) {
      k=newchunk(req);
      if (k==ERR) { mutex_unlock(&alloc_lock); error(E_ALLOCATION);}}}
  while (req<k) { splitheap(k--); if (k>req) k--;}
  b=bbreq->bp;
  b->h.elmtype=e;
  b->h.cix=cid;
  bbreq->bp=b->b.nextbcell;
  freeheap -= bbreq->size;
  alloccount[k]++;
  p=makepointer(b);
  euscontexts[thr_self()]->lastalloc=p;
  mutex_unlock(&alloc_lock);
  return(p);}

pointer alloc(s,e,cid,nils)	/*allocate heap of 's' longwords*/
register int s,nils;
int e,cid;
{ register int i=1,ss;
  register cell *c;
  register pointer *v;
  ss=max(3,s+1);	 /*one more word for the allocation information*/
  while (buddy[i].size<ss) i++;
  if (i>=MAXBUDDY) return(NULL);
  c=halloc(i,e,cid);
  i=buddy[i].size-1;
  v=c->c.obj.iv;
  while (nils<s) v[nils++]=NIL;	/*fill NILs in user's  slots*/
  while (s<i) v[s++]=NULL;	/*fill NULLs in buddy-cells extra slots*/
  return(c);}

/****************************************************************/
/* gc: garbage collector
/****************************************************************/

context *markctx;

mark(p)
register pointer p;
{ register int s;
  register bpointer bp;

  if ((int)p<(int)_end || (pointer)0x20000000<p) return(NULL);
markagain:
  bp=bpointerof(p);
  if (marked(bp)) return;	/*already marked*/
  markon(bp);			/*mark it first to avoid endless marking*/
  if (pisclosure(p)) return;	/*avoid marking contents of closure*/
  if (bp->h.elmtype==ELM_FIXED) {	/*contents are all pointers*/
    if (bp->h.cix==conscp.cix) {	/*save stack when cons*/
      p=bp->b.c[0];
      if ((int)p>(int)_end && (int)p<0x20000000 && ispointer(p)) mark(p);
      p=bp->b.c[1];
      if ((int)p>(int)_end && (int)p<0x20000000 && ispointer(p)) goto markagain; 
      }
    else {
      s=buddy[bp->h.bix].size-1;
      while (s>0) {
        p=bp->b.c[--s];
        if (ispointer(p)) mark(p);}}}
  else if (bp->h.elmtype==ELM_POINTER) { /*varing number of pointers*/
    s=buddy[bp->h.bix].size-1;
    while (--s>0) {
      p=bp->b.c[s];
      if (ispointer(p)) mark(p);}
    }
  }

markall()
{ register pointer *p,*spsave;
  register int i,j;
  register context *ctx;
  markctx=euscontexts[thr_self()];
  mark(sysobj);		/*mark internally reachable objects*/
  mark(pkglist);	/*mark all packages*/
  for (i=0; i<MAXTHREAD; i++) {
    /*mark everything reachable from stacks in euscontexts*/
    if (ctx=euscontexts[i]) {
      markctx=ctx;
      for (p=ctx->stack; p<ctx->vsp; p++)
        if (ispointer(*p) && ((ctx->stack>(pointer *)*p)
	    || ((pointer *)*p>ctx->stacklimit)))  {  mark(*p); } ;
      mark(ctx->lastalloc);}}
  for (i=0; i<MAXCLASS; i++) {
    markctx=euscontexts[thr_self()];
    if (ispointer(classtab[i].def)) mark(classtab[i].def); }
  }

reclaim(p)
register bpointer p;
{ register int rbix,stat;
  register pointer s;
  s=makepointer(p);
  if (pisfilestream(s)) {
    if (!isint(s->c.fstream.fname) && s->c.fstream.direction!=NIL) {
      if (s->c.fstream.fd==makeint(0) || s->c.fstream.fd==makeint(1)) {
	fprintf(stderr,";; gc! bogus stream at %x fd=%d\n",
		(int)s,intval(s->c.fstream.fd));}
      else if ((closestream(s)==0) && debug)
        fprintf(stderr,";; gc: dangling stream(address=%x fd=%d) is closed\n",
	        (int)s,intval(s->c.fstream.fd)); } }
  p->h.cix= -1;
  rbix=p->h.bix;
  p->b.nextbcell=buddy[rbix].bp;
  buddy[rbix].bp=p;
  freeheap+=buddy[rbix].size;}

static bpointer mergecell(p,cbix)
register bpointer p;
int cbix;
/*the cell pointed by 'p' must not be marked*/
/*mergecell kindly returns next uncollectable cell address*/
{ register bpointer np,p2;
  np=nextbuddy(p);
  while (p->h.b==0 && (int)p->h.bix<cbix) {
    if (marked(np)) return(np);
    p2=mergecell(np,cbix);	/*merge neighbor cell*/
    if (np->h.b==1) {		/*can be merged*/
      p->h.b=p->h.m;		/*merge them into bigger cell*/
      p->h.m=np->h.m;
      p->h.bix++;
      np=p2;}
    else {
      reclaim(np);
      return(p2);}}
  return(np);}
  
static void sweep(cp)
struct chunk *cp;
{ register int s,gcmerge;
  register bpointer p,np,tail;
  numunion nu;

  gcmerge=totalheap * min(1.0,fltval(spevalof(GCMARGIN)))
		    * max(0.1,fltval(spevalof(GCMERGE)));
  s=buddy[cp->chunkbix].size;
  p= &cp->rootcell;
  tail=(bpointer)((int)p+(s<<2));
  while (p<tail) {
    if (marked(p)) { markoff(p); p=nextbuddy(p);}	/*don't collect*/
    else if (gcmerge<freeheap) { /* no merge */
	np=nextbuddy(p);
        reclaim(p);
	p=np;} 
     else {
	np=mergecell(p,cp->chunkbix);	/*update free buddy list*/
        reclaim(p);
        p=np;} }
  }  

void sweepall()
{ 
  register struct chunk *chp;
  register int i;
  for (i=0; i<MAXBUDDY-1; i++) buddy[i].bp=0;	/*purge buddies*/
  freeheap=0;
  for (chp=chunklist; chp!=0; chp=chp->nextchunk) sweep(chp);
  }

#if vxworks
gc()
{ if (debug)  fprintf(stderr,"\n;; gc:");
  breakck;
  gccount++;
  markall();
  sweepall();
  if (debug) {
    fprintf(stderr," free/total=%d/%d stack=%d ",
        	freeheap,totalheap,markctx->vsp-markctx->stack);
    }
  breakck;
  }
#else 
gc()
{ struct tms tbuf1,tbuf2,tbuf3;

  if (debug)  fprintf(stderr,"\n;; gc:");
  breakck;
  mutex_lock(&mark_lock);
  gccount++;
  times(&tbuf1);
  markall();
  times(&tbuf2);
  marktime+=(tbuf2.tms_utime-tbuf1.tms_utime);
  sweepall();
  times(&tbuf3);
  sweeptime+=(tbuf3.tms_utime-tbuf2.tms_utime);
  if (debug) {
    fprintf(stderr," thread=%d free/total=%d/%d stack=%d ",
		thr_self(),
		freeheap,totalheap,markctx->vsp - markctx->stack);
    fprintf(stderr," mark=%d sweep=%d\n", marktime,sweeptime);}
  mutex_unlock(&mark_lock);
  breakck;
}
#endif