/* (C) Copyright International Business Machines Corporation 23 January */
/* 1990.  All Rights Reserved. */
/*  */
/* See the file USERAGREEMENT distributed with this software for full */
/* terms and conditions of use. */
/* SCCS Info: @(#)storage.c	1.19 3/13/90 */

/* Routines to allocate and deallocate storage needed by the */
/* interpreter.  We use quick-cells (linked lists of pre-allocated */
/* cells) for the most common allocation sizes, and malloc (for the */
/* time being) for everything else. */

#define ISSTORAGE

#include <stdio.h>
#include "li.h"
#include "storage.h"
#include "sysdep.h"

/* Following array lists the sizes for which we want quickcells. */
/* First two are filled in dynamically in init_storage(). */

int qcSizes[] = {
    40,				/* li/t_vector.cc:get_default_vector_size() */
    16,				/* fe/tempstore.c:get_object_talloc_size() */
    8,				/* li/t_vector.cc:get_vector_size(0) */
    dotsize(1), dotsize(2), dotsize(3),
    sizeof(handlr_stack),
    sizeof(dfd_nominal),
    sizeof(dfd_table),
    sizeof(avlnode_t),
    0 };

#define DEFAULT_VECTOR 0
#define OBJECT_TALLOC 1
#define EMPTY_VECTOR 2

/* Following array, indexed by cell size, gives the number of */
/* quickcells of that size that are allocated in a single quickcell */
/* block.  Zero means no quickcells are not used for that size.  Sizes are */
/* filled in by init_storage() */
int qcBSize[MAXQCSIZE+1];

/* headers for the quickcell lists... all initially nil */
generic *qcHeads[MAXQCSIZE+1];

#ifdef QCDEBUG
unsigned long usedcnt[MAXQCSIZE+1];
#endif
/* following array needed for both QCDEBUG and for QCTRACK */
#ifdef QCDEBUG
#  define KEEPALLOCS
#endif
#ifdef QCTRACK
#  define KEEPALLOCS
#endif
#ifdef KEEPALLOCS
static generic *qcAllocs[MAXQCSIZE+1];
#endif

#if (QCHISTSIZE != 0)
unsigned long qcHist[QCHISTSIZE];
unsigned long qcxHist;
#endif


#ifdef QCTRACK
char *stg_allocator;
static generic *tracked_stg = nil;
#define QCTRACK_EXTRA sizeof(char *)
#define NONQCTRACK_EXTRA (sizeof(char *) + sizeof(generic *))
#else
#define QCTRACK_EXTRA 0
#define NONQCTRACK_EXTRA 0
#endif

/* global temporaries required by storage macros */
counter _stgsize;
generic *_stg;

/* counters so we can compute quick-cell hit ratios */
unsigned long nonqcallocs = 0;
unsigned long qcallocs = 0;

char *malloc();			/* c-runtime storage allocater. */

/* initialize all the quickcell data structures at startup */

void
init_storage()
{
    int size, i;

    for (i = 0; i <= MAXQCSIZE; i++)
      qcBSize[i] = 0;

    qcSizes[DEFAULT_VECTOR] = get_default_vector_size();
    qcSizes[OBJECT_TALLOC] = get_object_talloc_size();
    qcSizes[EMPTY_VECTOR] = get_vector_size(0);

    for (i = 0; qcSizes[i] isnt 0; i++)
      if (qcSizes[i] <= MAXQCSIZE)
	qcBSize[qcSizes[i]] = QCBLOCKSIZE;
      else
	(void) fprintf(stderr,
		    "Quick cells requested for size %d, max allowed is %d\n",
		    qcSizes[i], MAXQCSIZE);

    for (size = 0; size <= MAXQCSIZE; size++) {
	qcHeads[size] = nil;
#ifdef KEEPALLOCS
	qcAllocs[size] = nil;
#endif
#ifdef QCDEBUG
	usedcnt[size] = 0;
#endif
    }

#if (QCHISTSIZE != 0)
    for (size = 0; size < QCHISTSIZE; size++)
      qcHist[size] = 0;
    qcxHist = 0;
#endif

}

/* non-inlined versions of getmain and freemain, sometimes useful in */
/* debugging */

#ifdef NOINLINE
generic *
getmain(size)
counter size;
{
    return GETMAIN(size);
}

void freemain(stg, size)
generic *stg;
int size;
FREEMAIN((generic *) stg, size)
#endif

generic *
d_getmain(size)
counter size;			/* size to alloc in bytes. */
{
    generic *storage;
    generic *get_qcBlock();
    generic **qcHead = nil;

#if (QCHISTSIZE != 0)
    if (size <= QCHISTSIZE)
      qcHist[size-1]++;
    else
      qcxHist++;
#endif

    if (size <= MAXQCSIZE)	/* use a quickcell if possible */
      if (qcBSize[size] isnt 0)
	qcHead = &qcHeads[size];
    if (qcHead is nil) {
#if QCMINHIT != 0
	nonqcallocs++;		/* count the non-quickcell allocation */
#endif
	storage = (generic *) malloc(size + NONQCTRACK_EXTRA);
#ifdef QCTRACK
	if (storage is nil) {
	  void reclaim_tracked_stg();
	  
	  reclaim_tracked_stg();
	  storage = (generic *) malloc(size + NONQCTRACK_EXTRA);
	}
	if (storage isnt nil) {
	  *((generic **)storage) = tracked_stg;
	  tracked_stg = storage;
	  storage = (generic *) (((char *) storage) + NONQCTRACK_EXTRA);
	}
#endif
    }
    else {
#if QCMINHIT != 0
	qcallocs++;		/* count the quickcell hit */
#endif
				/* try to get a block of storage. */
        if (*qcHead is nil)
	  *qcHead = get_qcBlock(size); /* allocate a new quickcell */
				       /* block if needed */
	if ((storage = *qcHead) isnt nil) /* grab the next quick cell */
	  *qcHead = *((generic **) *qcHead); /* and bump the list */
#ifdef QCDEBUG
	if (storage isnt nil)
	  usedcnt[size]++;
#endif QCDEBUG
    }

    if (storage is nil)		/* malloc failed? */
      nilperror("getmain", "Malloc() failed");
				/* print informative(?) message. */

#ifdef QCTRACK
    *(((char *) storage)-1) = stg_allocator;
#endif

    return(storage);		/* return the pointer to new storage. */
}


/* allocate a dotcontainer and bottom out all its data elements */
dotcontainer *
getdotmain(nobj)
int nobj;			/* number of objects in data vector */
{
    dotcontainer *d;

    d = (dotcontainer *) getmain((counter) dotsize(nobj));
    if (d isnt nil)
      while (nobj-- > 0)
	d->data[nobj].tsdr = &dr_bottom;
    return(d);
}

/* allocate a block of quick cells of the given size... block size (# */
/* of cells) given in qcBSize array.  All cells are linked together */
/* via their first sizeof(generic *) bytes */
generic *
get_qcBlock(size)
counter size;
{
    generic *storage;
    char *s;
    counter i, realsize;

    realsize = STGALIGN*(1+(size-1)/STGALIGN);
    storage = (generic *) malloc((realsize+QCTRACK_EXTRA) * qcBSize[size]);
    if (storage isnt nil) {
      /* link the cells together */
      s = ((char *) storage) + QCTRACK_EXTRA;
      for (i = 1; i < qcBSize[size]; i++) {
	*((generic **) s) = (generic *) (s+realsize+QCTRACK_EXTRA);
	s += realsize + QCTRACK_EXTRA;
      }
      *((generic **) s) = nil; /* tie off final cell in block */
    }
#ifdef KEEPALLOCS
    /* first cell goes on list of block addresses if we're debugging */
    /* quickcells or tracking storage */
    {
	generic *first = storage + QCTRACK_EXTRA;
	storage = *((generic **) first);
	*((generic **) first) = qcAllocs[size];
	qcAllocs[size] = first;
    }
#endif KEEPALLOCS
    return(storage);
}

#ifdef QCDEBUG
/* Following routine thoroughly checks the quickcell lists to */
/* determine whether there are any problems.  If so, an informative */
/* message is printed and the Hermes interpreter is halted. */
/* If size is nonzero, only the list for the given size is checked. */
/* Otherwise all lists are checked. */

void
qc_verify(size)
int size;
{
    int minsize, maxsize, blkok;
    unsigned long cnt, acnt, gap;
    char buf[100];
    register generic *p, *q;

    buf[0] = '\0';
    if (size is 0)
      if (qcHeads[0] isnt nil) {
	  (void) sprintf(buf, "Size 0 quickcell list not empty: %x", 
			 qcHeads[0]);
	goto bad;
      }
    minsize = (size is 0 ? 1 : size);
    maxsize = (size is 0 ? MAXQCSIZE : size);
    for (size = minsize; size <= maxsize; size++) {
	if (qcBSize[size] is 0)
	  if (qcHeads[size] isnt nil) {
	      (void) sprintf(buf,
		      "Size %d quickcell list should be empty, head = %x",
		      size, qcHeads[size]);
	      goto bad;
	  }
	  else
	    continue;
	for (p = qcHeads[size], cnt = 0;
	     p isnt nil;
	     p = *((generic **)p), cnt++) {
	    blkok = FALSE;
	    for (q = qcAllocs[size]; q isnt nil; q = *((generic **) q)) {
		gap = ((char *) p) - ((char *) q);
		if ((gap % size) isnt 0)
		  continue;
		gap /= size;
		if (gap is 0) {
		    (void) sprintf(buf,
				   "Free block %x(%d) was 1st in alloc block",
				   p, size);
		    goto bad;
		}
		if (gap < 0 || gap >= qcBSize[size])
		  continue;
		blkok = TRUE;
		break;
	    }
	    if (! blkok) {
		(void) sprintf(buf,
			"Block %x(%d) does not fit into any alloc block",
			p, size);
		goto bad;
	    }
	}
	acnt = 0;
	for (q = qcAllocs[size]; q isnt nil; q = *((generic **) q))
	  acnt++;

	if ((cnt + usedcnt[size]) isnt (acnt * (qcBSize[size]-1))) {
	    (void) sprintf(buf,
			   "Size %d: used(%lu) + free(%lu) <> total (%lu)",
			   size, usedcnt[size], cnt, acnt*(qcBSize[size]-1));
	    goto bad;
	}
    }
  ok:
    return;
  bad:
    nilerror("qc_verify",buf);
    abort_nili("qc_verify");
}
#endif QCDEBUG

/* Following routine checks the quick-cell hit ratio and complains if */
/* it was lower than the minimum allowed. */

void 
term_storage()
{
#if QCMINHIT != 0
    {
	float ratio;
	char buf[100];

				/* compute actual ratio */
	ratio = (100.0 * qcallocs) / (qcallocs + nonqcallocs);
	if (ratio < QCMINHIT) {
	    (void) sprintf(buf,"Low quick-cell hit ratio: %ul/%ul (%.2f%%)",
			   qcallocs, qcallocs+nonqcallocs, ratio);
	    nilerror("term_storage",buf);
	}
    }
#endif

#if (QCHISTSIZE != 0)
    {
	int i;
	flag isqcsize;
	unsigned long total = qcxHist;
	unsigned long hits = 0;
	float pct;

	(void) fprintf(stderr,"\nHistogram of allocation requests:\n");
	(void) fprintf(stderr,"['*' indicates current quick-cell sizes]\n");
	(void) fprintf(stderr,"    Size      Count    Pct\n");
	(void) fprintf(stderr,"    ----      -----    ---\n");
	for (i = 0; i < QCHISTSIZE; i++)
	  total += qcHist[i];
	for (i = 0; i < QCHISTSIZE; i++)
	  if (qcHist[i] isnt 0) {
	      pct = (100.0 * qcHist[i]) / total;
	      isqcsize = i < MAXQCSIZE ? (qcBSize[i+1] ? TRUE : FALSE) : FALSE;
	      (void) fprintf(stderr,"%c%7d %10lu %6.2f\n",
			     (isqcsize ? '*' : ' '), i+1, qcHist[i], pct);
	      if (isqcsize)
		hits += qcHist[i];
	  }
	if (qcxHist != 0) {
	    pct = (100.0 * qcxHist) / total;
	    (void) fprintf(stderr,">%7d %10lu %6.2f\n",
			   QCHISTSIZE, qcxHist, pct);
	}
	pct = (100.0 * hits) / total;
	(void) fprintf(stderr,"\n[Quick-cell hit ratio = %.2f%%, ", pct);
	(void) fprintf(stderr,"excluding cell sizes > %d]\n", QCHISTSIZE);
    }
#endif

#if QCTRACK
    {
      void track_report();
      track_report();
    }
#endif    
}


#ifdef QCTRACK

/* Following routine garbage collects the tracked malloc cell list */

static void
reclaim_tracked_stg()
{
  generic *cell, *next, *newlist = nil;
  char **id;

  for (cell = tracked_stg; cell isnt nil; cell = next) {
    next = *((generic **) cell);
    id = (char **) (((char *) cell) + (NONQCTRACK_EXTRA - QCTRACK_EXTRA));
    if (*id is nil)
      free(cell);
    else {
      *((generic **) cell) = newlist;
      newlist = cell;
    }
  }
  tracked_stg = newlist;
}

static void
track_report()
{
}
#endif
