/*
 * ZMailer router LISPic memory allocator routines by Matti Aarnio
 * <mea@nic.funet.fi>  Copyright 1996
 *
 * LISPish memory object allocation routines.  We keep  conscells  in
 * bucket arrays for ease of finding them for the Deutch-Schorr-Waite
 * garbage collector (and to minimize malloc overheads..)
 */

#include "hostenv.h"
#include "listutils.h"

/*
 * We allocate conscells in set of blocks, where we do garbage collections
 * at every N requests, or other trigger criteria..
 * Strings are allocated with malloc(), and explicitely freed at garbage
 * collection of unused cells.
 * Free cells are collected into a chain of free cells (via next ptr),
 * from which they are picked into use.
 */
struct consblock {
	struct consblock  *nextblock;
	int		   cellcount;
	struct conscell	   cells[1]; /* Array of ``cellcount'' cells */
};

/*
 * Variable pointers -- arrays of pointers to conscells
 */
struct consvarptrs {
	struct consvarptrs *nextvars;
	int		 count;	  /* large (?) sets of vars */
	int		 first;	  /* this block has vars of indices
				     ``first .. first+count-1'' */
	const struct conscell *vars[1]; /* Address of an variable */
};

/*
 * Some book-keeping variables, and one of GC-trigger counters
 */
int consblock_cellcount   = 1000; /* Optimizable for different systems.
				     Alphas have 8kB pages, and most others
				     have 4kB pages.. */
int newcell_gc_interval   = 1000; /* Number of newcell() calls before GC */
int newcell_gc_callcount  = 0;	/* ... trigger-count of those calls ... */
int newcell_callcount     = 0;	/* ... cumulative count of those calls ... */

struct consblock *consblock_root     = NULL;
struct consblock *consblock_tail     = NULL;
struct conscell  *conscell_freechain = NULL; /* pick first .. */
int               consblock_count    = 0;    /* How many allocated ? */

int                 consvars_cellcount = 4000;
struct consvarptrs *consvars_root   = NULL;
struct consvarptrs *consvars_tail   = NULL;
int		    consvars_cursor = 0; /* How many variables are in use ?
					    Actually NOT direct pointer, and
					    the user might have to traverse
					    the chains a bit at first.. */
struct consvarptrs *consvars_markptr = NULL; /* For speedier insert */
int		    consvars_count = 0; /* Allocation count */

static struct consblock * new_consblock();
static struct consblock * new_consblock()
{
	struct consblock *new;
	int i;
	int newsize = (sizeof(struct consblock) +
		       sizeof(struct conscell) * (consblock_cellcount-1));

	new = malloc(newsize);
	if (!new) return NULL;

	new->cellcount = consblock_cellcount;
	new->nextblock = NULL;
	if (consblock_root == NULL)
	  consblock_root = new;
	else
	  consblock_tail->nextblock = new;
	consblock_tail = new;

	/* chain them together, and prepend to the free chain via ``next'' */
	new->cells[0].next  = conscell_freechain;
	new->cells[0].flags = 0;
	for (i = 1; i < consblock_cellcount; ++i) {
	  new->cells[i].next  = &new->cells[i-1];
	  new->cells[i].flags = 0;
	}
	conscell_freechain = &new->cells[consblock_cellcount-1];

	++consblock_count;
	return new;
}

static struct consvarptrs *new_consvars();
static struct consvarptrs *new_consvars(first)
	int first;
{
	struct consvarptrs *new;
	int newsize = (sizeof(struct consvarptrs) +
		       sizeof(struct conscell *) *
		       (consvars_cellcount-1));

	new = (struct consvarptrs *) malloc(newsize);
	if (!new) return NULL;

	new->first = first;
	new->count = consvars_cellcount;
	new->nextvars = NULL;
	if (consvars_root == NULL) {
	  consvars_root    = new;
	  consvars_markptr = new;
	} else
	  consvars_tail->nextvars = new;
	consvars_tail = new;
	++consvars_count;
	return new;
}

void *consvar_mark()
{
	return (void*)consvars_cursor;
}

void consvar_release(marker)
void *marker;
{
	int newmark = (int) marker;

	if (newmark > consvars_cursor) {
	  abort(); /* XX: Something seriously wrong, release INCREASED
		          the count of variables! */
	}
	consvars_cursor = newmark;
	--newmark; /* change into index -- from counter (sort of) */

	if (consvars_markptr == NULL) return; /* no cells ? */

	if ((consvars_markptr->first <= newmark) &&
	    (newmark < (consvars_markptr->first + consvars_markptr->count)))
	  return; /* The markptr is ok */

	/* Lookup for the block marker */
	consvars_markptr = consvars_root;
	while (newmark < consvars_markptr->first) {
	  consvars_markptr = consvars_markptr -> nextvars;
	}
}

/* ConsCell variable pointer registry */
int consvar_register(varptr)
const struct conscell *varptr;
{
	int marklast, idx;

	if (consvars_root == NULL) {
	  if (new_consvars(0) == NULL)
	    return -1;
	  consvars_cursor = 0;
	}

	marklast = (consvars_markptr -> first +
		    consvars_markptr -> count);
	++consvars_cursor;
	if (marklast <= consvars_cursor) {
	  if (consvars_markptr->nextvars == NULL)
	    consvars_markptr = new_consvars(marklast /* the previous last is
							the next first.. */ );
	  else
	    consvars_markptr = consvars_markptr->nextvars;
	  if (consvars_markptr == NULL)
	    return -1;
	}
	idx = (consvars_cursor -1) - consvars_markptr->first;
	consvars_markptr->vars[idx] = varptr;
	return 0; /* Stored ok.. */
}

/*
 *  Deutch-Schorr-Waite garbage collection routine of the conscells..
 *
 */
static void cons_DSW();

#define DSW_MASK  (DSW_MARKER | DSW_BACKPTR)

#define DSW_BLOCKLEFT(cptr)	\
		((cptr)->flags & ~DSW_MASK)
#define DSW_BLOCKRIGHT(cptr)	\
		((cptr)->next == NULL)
#define DSW_BLOCK(cptr)		\
		(((cptr)->flags & DSW_MARKER) ||	\
		 (DSW_BLOCKLEFT(cptr) && DSW_BLOCKRIGHT(cptr)))

static void cons_DSW_rotate(pp1,pp2,pp3)
struct conscell **pp1, **pp2, **pp3;
{
	struct conscell *t;

	t = *pp1;
	*pp1 = *pp2;
	*pp2 = *pp3;
	*pp3 = t;
}

static void cons_DSW(source)
struct conscell *cource;
{
	struct conscell *current, *prev;
	int state;

	current = source->next;
	prev = source;
	/* source->flags.back = 'next' -- current backptr value */
	source->flags &= ~DSW_BACKPTR;
	source->flags |=  DSW_MARKER;

	state = 1;
	while (state != 0) {
	  switch(state) {
	  case 1:
	    /* Mark in every case */
	    current->flags |= DSW_MARKER;
	    /* Try to advance */
	    if (DSW_BLOCK(current)) {
	      /* Prepare to retreat */
	      state = 2;
	    } else {
	      /* Advance */
	      if (DSW_BLOCKLEFT(current)) {
		/* Follow right (next) pointer */
		current->flags &= ~DSW_BACKPTR;
		cons_DSW_rotate(&prev, &current, &current->next);
	      } else {
		/* Follow left (dptr) pointer */
		current->flags |= DSW_BACKPTR;
		cons_DSW_rotate(&prev, &current, &current->dptr);
	      }
	    }
	    break;
	  case 2:
	    /* Finish, retreat or switch */
	    if (prev == current)
	      /* Finish */
	      state = 0;
	    else {
	      if (prev->flags & DSW_BACKPTR /* Non-zero == 'dptr' */) {
		if (!DSW_BLOCKRIGHT(prev)) {
		  prev->flags &= ~DSW_BACKPTR;
		  cons_DSW_rotate(&prev->dptr,&current,&prev->next);
		  state = 1;
		} else {
		  cons_DSW_rotate(&prev,&prev->dptr,&current);
		}
	    } else {
	      cons_DSW_rotate(&prev,&prev->next,&current);
	    }
	    break;
	  default:
	    break;
	  }
	}
}

int cons_garbage_collect()
{
	int i, freecnt;
	struct consblock *cb = consblock_root;
	struct consvarptrs *vb = consvars_root;
	struct conscell *cc;

	if (cb == NULL) return 0; /* Nothing to do! */

	/* Start by clearing all DSW_MARKER bits */
	for ( ; cb != NULL; cb = cb->nextblock) {
	  cc = cb->cells;
	  for (i = 0; i < cb->cellcount; ++i, ++cc)
	    cc->flags &= ~(DSW_MARKER|DSW_BACKPTR);
	}
	/* Hookay...  Now we run marking on all cells that are
	   reachable from some (any) of our registered variables */
	for ( ; vb != NULL; vb = vb->nextvars) {
	  for (i = 0; i < vb->count; ++i)
	    cons_DSW(vb->vars[i]);
	}
	/* All are marked.. now we can scan all non-marked, and declare
	   them to belong into free..   Oh yes, all  ISNEW(cellptr)  cells
	   will do  free(cellptr->string)    */
	conscell_freechain = NULL;
	freecnt = 0;
	for ( ; cb != NULL; cb = cb->nextblock) {
	  cc = cb->cells;
	  for (i = 0; i < cb->cellcount; ++i)
	    if (cc->flags & DSW_MARKER) {
	      /* It was reachable, just clean the marker bit(s) */
	      cc->flags &= ~(DSW_MARKER|DSW_BACKPTR);
	    } else {
	      /* This was not reachable, no marker.. */
	      if (cc->flags & NEWSTRING)
		free(cc->string);
	      cc->flags = 0;
	      /* this resulting list is ``reversed'' in memory order,
		 however that should not cause any trouble anyway.. */
	      cc->next = conscell_freechain;
	      conscell_freechain = cc;
	      ++freecnt;
	    }
	}
	return freecnt;
}



/*
 * Actual heart of this all:  Allocate the conscell!
 */
struct conscell *
newcell()
{
	struct conscell *new;

	/* At first, see if we are to do some GC ... */
	++newcell_callcount;
	if (++newcell_gc_callcount >= newcell_gc_interval)
	  cons_garbage_collect();
	/* Ok, if we were lucky, we got free cells from GC,
	   or had them otherwise.. */
	if (conscell_freechain == NULL)
	  if (new_consblock() == NULL)
	    if (cons_garbage_collect() == 0) {
	      /* XX: Unable to allocate memory, nor any freeable!
		 Print something, and abort ? */
	      return NULL;
	    }
	/* Ok, the devil is at loose now, if we don't have at least ONE cell
	   in the free chain now..  We do NOT store anything into flags, or
	   other fields of the structure -- to help memory access checkup
	   routines, like Purify, or DEC OSF/1 ATOM Third-Degree */
	new = conscell_freechain;
	conscell_freechain = new->next;
	new->next = NULL;
	return new;
}
