/*
	Little Smalltalk, version 2
	Written by Tim Budd, Oregon State University, July 1987

	Improved incorporating suggestions by 
		Steve Crawley, Cambridge University, October 1987
		Steven Pemberton, CWI, Amsterdam, Oct 1987

	memory management module

	This is a rather simple, straightforward, reference counting scheme.
	There are no provisions for detecting cycles, nor any attempt made
	at compaction.  Free lists of various sizes are maintained.
	At present only objects up to 255 bytes can be allocated, 
	which mostly only limits the size of method (in text) you can create.

	reference counts are not stored as part of an object image, but
	are instead recreated when the object is read back in.
	This is accomplished using a mark-sweep algorithm, similar
	to those used in garbage collection.

	There is a large amount of differences in the qualities of malloc
	procedures in the Unix world.  Some perform very badly when asked
	to allocate thousands of very small memory blocks, while others
	take this without any difficulty.  The routine mBlockAlloc is used
	to allocate a small bit of memory; the version given below
	allocates a large block and then chops it up as needed; if desired,
	for versions of malloc that can handle small blocks with ease
	this can be replaced using the following macro: 

# define mBlockAlloc(size) (object *) calloc((unsigned) size, sizeof(object))

	This can, and should, be replaced by a better memory management
	algorithm.
*/
# include <stdio.h>
# include "env.h"
# include "memory.h"
# ifdef STRING
# include <string.h>
# endif
# ifdef STRINGS
# include <strings.h>
# endif

# define ObjectTableMax 5000
# define MemoryBlockSize 2000

# ifdef ALLOC
# include <alloc.h>
# endif
# ifndef ALLOC
extern char *calloc();
# endif
# ifdef A_ST
extern char *lcalloc();
# endif

boolean debugging = false;
object sysobj;	/* temporary used to avoid rereference in macros */
object intobj;

object symbols;		/* table of all symbols created */
object globalNames;	/* table of all accessible global names */

/*
	in theory the objectTable should only be accessible to the memory
	manager.  Indeed, given the right macro definitions, this can be
	made so.  Never the less, for efficiency sake some of the macros
	can also be defined to access the object table directly
*/

#ifndef	A_ST
struct objectStruct objectTable[ObjectTableMax];
#else
struct objectStruct *objectTable;
#endif

/*
	The following global variables are strictly local to the memory
	manager module
*/

# define FREELISTMAX 256
static object objectFreeList[FREELISTMAX];/* free list of objects */

# ifndef mBlockAlloc
		/* the current memory block being hacked up */
static object *memoryBlock;		/* malloc'ed chunck of memory */
static int    currentMemoryPosition;	/* last used position in above */
# endif


/* initialize the memory management module */
noreturn initMemoryManager() {
	int i;

#ifdef	A_ST
	objectTable = (struct objectStruct *)lcalloc((long)sizeof(struct objectStruct),
		(long)ObjectTableMax);
#endif

	/* set all the free list pointers to zero */
	for (i = 0; i < FREELISTMAX; i++)
		objectFreeList[i] = nilobj;

	/* set all the reference counts to zero */
	for (i = 0; i < ObjectTableMax; i++) {
#ifdef	A_ST
		(objectTable + i)->referenceCount = 0;
		(objectTable + i)->size = 0;
#else
		objectTable[i].referenceCount = 0;
		objectTable[i].size = 0;
#endif
		}

	/* make up the initial free lists */
	setFreeLists();

# ifndef mBlockAlloc
	/* force an allocation on first object assignment */
	currentMemoryPosition = MemoryBlockSize + 1;
# endif

	/* object at location 0 is the nil object, so give it nonzero ref */
#ifdef	A_ST
	(objectTable + 0)->referenceCount = 1;
	(objectTable + 0)->size = 0;
	(objectTable + 0)->type = objectMemory;
#else
	objectTable[0].referenceCount = 1;
	objectTable[0].size = 0;
	objectTable[0].type = objectMemory;
#endif

}

/* setFreeLists - initialise the free lists */
setFreeLists() {
	int z, i;
	struct objectStruct *p;

	for (z=ObjectTableMax-1; z>0; z--) {
#ifdef	A_ST
		if ((objectTable + z)->referenceCount == 0){
			/* Unreferenced, so do a sort of sysDecr: */
			p= objectTable + z;
#else
		if (objectTable[z].referenceCount == 0){
			/* Unreferenced, so do a sort of sysDecr: */
			p= &objectTable[z];
#endif
/*if (p->size > 0) printf("Unreferenced: %d\n", z);*/
			p->class = objectFreeList[p->size];
			objectFreeList[p->size]= z;
			for (i= p->size; i>0; )
				p->memory[--i] = nilobj;
			}
		}
}

/* report a (generally fatal) memory manager error */
noreturn sysError(s1, s2)
char *s1, *s2;
{
	ignore fprintf(stderr,"%s\n%s\n", s1, s2);
#ifdef	A_ST
	ignore exit(-1);
#else
	ignore abort();
#endif	A_ST
}

/*
  mBlockAlloc - rip out a block (array) of object of the given size from
	the current malloc block 
*/
# ifndef mBlockAlloc
static object *mBlockAlloc(memorySize)
int memorySize;
{	object *objptr;

	if (currentMemoryPosition + memorySize >= MemoryBlockSize) {
		
		/* we toss away space here.  Space-Frugal users may want to
		fix this by making a new object of size
		MemoryBlockSize - currentMemoryPositon - 1
		and putting it on the free list, but I think
		the savings is potentially small */

		memoryBlock = (object *) calloc((unsigned) MemoryBlockSize, sizeof(object));
		if (! memoryBlock)
			sysError("out of memory","malloc failed");
		currentMemoryPosition = 0;
		}
	objptr = (object *) &memoryBlock[currentMemoryPosition];
	currentMemoryPosition += memorySize;
	return(objptr);
}
# endif

/* allocate a new memory object */
object alcObject(memorySize, memoryType)
int memorySize;
int memoryType;
{	int i;
	register int position;
	boolean done;

	if (memorySize >= FREELISTMAX) {
		sysError("allocation bigger than 255","");
		}

	/* first try the free lists, this is fastest */
	if ((position = objectFreeList[memorySize]) != 0) {
#ifdef	A_ST
		objectFreeList[memorySize] = (objectTable + position)->class;
#else
		objectFreeList[memorySize] = objectTable[position].class;
#endif
		}

	/* if not there, next try making a size zero object and
		making it bigger */
	else if ((position = objectFreeList[0]) != 0) {
#ifdef	A_ST
		objectFreeList[0] = (objectTable + position)->class;
		(objectTable + position)->size = memorySize;
		(objectTable + position)->memory = mBlockAlloc(memorySize);
#else
		objectFreeList[0] = objectTable[position].class;
		objectTable[position].size = memorySize;
		objectTable[position].memory = mBlockAlloc(memorySize);
#endif
		}

	else {		/* not found, must work a bit harder */
		done = false;

		/* first try making a bigger object smaller */
		for (i = memorySize + 1; i < FREELISTMAX; i++)
			if ((position = objectFreeList[i]) != 0) {
#ifdef	A_ST
				objectFreeList[i] = (objectTable + position)->class;
				/* just trim it a bit */
				(objectTable + position)->size = memorySize;
#else
				objectFreeList[i] = objectTable[position].class;
				/* just trim it a bit */
				objectTable[position].size = memorySize;
#endif
				done = true;
				break;
				}

		/* next try making a smaller object bigger */
		if (! done)
			for (i = 1; i < memorySize; i++)
				if ((position = objectFreeList[i]) != 0) {
#ifdef	A_ST
					objectFreeList[i] =
						(objectTable + position)->class;
					(objectTable + position)->size = memorySize;
# ifdef mBlockAlloc
					free((objectTable + position)->memory);
# endif
					(objectTable + position)->memory = 
						mBlockAlloc(memorySize);
#else
					objectFreeList[i] =
						objectTable[position].class;
					objectTable[position].size = memorySize;
# ifdef mBlockAlloc
					free(objectTable[position].memory);
# endif
					objectTable[position].memory = 
						mBlockAlloc(memorySize);
#endif
					done = true;
					break;
					}

		/* if we STILL don't have it then there is nothing */
		/* more we can do */
		if (! done)
			sysError("out of objects","alloc");
		}

	/* set class and type */
#ifdef	A_ST
	(objectTable + position)->referenceCount = 0;
	(objectTable + position)->class = nilobj;
	(objectTable + position)->type = memoryType;
#else
	objectTable[position].referenceCount = 0;
	objectTable[position].class = nilobj;
	objectTable[position].type = memoryType;
#endif
	return(position << 1);
}

object allocSymbol(str)
char *str;
{	object newSym;

	newSym = alcObject((2 + strlen(str))/2, charMemory);
	ignore strcpy(charPtr(newSym), str);
	return(newSym);
}

# ifdef incr
object incrobj;		/* buffer for increment macro */
# endif
# ifndef incr
noreturn incr(z)
object z;
{
	if (z && ! isInteger(z)) {
#ifdef	A_ST
		(objectTable + (z>>1))->referenceCount++;
#else
		objectTable[z>>1].referenceCount++;
#endif
		}
}
# endif

# ifndef decr
noreturn decr(z)
object z;
{
	if (z && ! isInteger(z)) {
#ifdef	A_ST
		if (--(objectTable + (z>>1))->referenceCount <= 0) {
#else
		if (--objectTable[z>>1].referenceCount <= 0) {
#endif
			sysDecr(z);
			}
		}
}
# endif

/* do the real work in the decr procedure */
noreturn sysDecr(z)
object z;
{	register struct objectStruct *p;
	register int i;

#ifdef	A_ST
	p = objectTable + (z>>1);
#else
	p = &objectTable[z>>1];
#endif
	if (p->referenceCount < 0) {
		sysError("negative reference count","");
		}
	decr(p->class);
	p->class = objectFreeList[p->size];
	objectFreeList[p->size] = z>>1;
	if (((int) p->size) > 0) {
		if (p->type == objectMemory)
			for (i = p->size; i > 0 ; )
				decr(p->memory[--i]);
		for (i = p->size; i > 0; )
			p->memory[--i] = nilobj;
		}

}

# ifndef basicAt
object basicAt(z, i)
object z;
register int i;
{
	if (isInteger(z))
		sysError("attempt to index","into integer");
	else if ((i <= 0) || (i > objectSize(z))) {
		ignore fprintf(stderr,"index %d size %d\n", i, (int) objectSize(z));
		sysError("index out of range","in basicAt");
		}
	else
		return(sysMemPtr(z)[i-1]);
	return(0);
}
# endif
# ifndef basicAtPut

noreturn basicAtPut(z, i, v)
object z, v;
register int i;
{
	if (isInteger(z))
		sysError("assigning index to","integer value");
	else if ((i <= 0) || (i > objectSize(z))) {
		ignore fprintf(stderr,"index %d size %d\n", i, (int) objectSize(z));
		sysError("index out of range","in basicAtPut");
		}
	else {
		incr(v);
		decr(sysMemPtr(z)[i-1]);
		sysMemPtr(z)[i-1] = v;
		}
}
# endif

# ifndef byteAt
int byteAt(z, i)
object z;
register int i;
{	char *bp;

	if (isInteger(z))
		sysError("indexing integer","byteAt");
	else if ((i <= 0) || (i > 2 * objectSize(z))) {
		sysError("index out of range","byteAt");
		}
	else {
		bp = charPtr(z);
		i = bp[i-1];
		}
	return(i);
}
# endif

# ifndef byteAtPut
noreturn byteAtPut(z, i, x)
object z;
int i, x;
{	char *bp;

	if (isInteger(z))
		sysError("indexing integer","byteAtPut");
	else if ((i <= 0) || (i > 2 * objectSize(z))) {
		sysError("index out of range", "byteAtPut");
		}
	else {
		bp = charPtr(z);
		bp[i-1] = x;
		}
}
# endif
/*
	imageWrite - write out an object image
*/
static iwerr() { sysError("imageWrite count error",""); }

/* ptr - used for conversions to keep lint happy */
# define ptr(x) ((char *) x)

noreturn imageWrite(fp)
FILE *fp;
{	short i;

	if (fwrite(ptr(&symbols), sizeof(object), 1, fp) != 1) iwerr();
	if (fwrite(ptr(&globalNames), sizeof(object), 1, fp) != 1) iwerr();

	for (i = 0; i < ObjectTableMax; i++) {
#ifdef	A_ST
		if ((objectTable + i)->referenceCount > 0) {
#else
		if (objectTable[i].referenceCount > 0) {
#endif
			if (fwrite(ptr(&i), sizeof(short), 1, fp) != 1) iwerr();
#ifdef	A_ST
			if (fwrite(ptr(&(objectTable + i)->class), sizeof(object), 1, fp)
				!= 1) iwerr();
			if (fwrite(ptr(&(objectTable + i)->size), sizeof(byte), 1, fp)
				!= 1) iwerr();
			if (fwrite(ptr(&(objectTable + i)->type), sizeof(byte), 1, fp)
				!= 1) iwerr();
			if ((objectTable + i)->size != 0)
				if (fwrite(ptr((objectTable + i)->memory), sizeof(object),
					(int) byteToInt((objectTable + i)->size), fp) != byteToInt((objectTable + i)->size))
						iwerr();
			}
#else
			if (fwrite(ptr(&objectTable[i].class), sizeof(object), 1, fp)
				!= 1) iwerr();
			if (fwrite(ptr(&objectTable[i].size), sizeof(byte), 1, fp)
				!= 1) iwerr();
			if (fwrite(ptr(&objectTable[i].type), sizeof(byte), 1, fp)
				!= 1) iwerr();
			if (objectTable[i].size != 0)
				if (fwrite(ptr(objectTable[i].memory), sizeof(object),
					(int) byteToInt(objectTable[i].size), fp) != byteToInt(objectTable[i].size))
						iwerr();
			}
#endif
		}
}

/*
Written by Steven Pemberton:
The following routine assures that objects read in are really referenced,
eliminating junk that may be in the object file but not referenced.
It is essentially a marking garbage collector algorithm using the 
reference counts as the mark
*/

static visit(x)
object x;
{
	int i, s;
	object *p;

	if (x && !isInteger(x)) {
#ifdef	A_ST
		if (++((objectTable + (x>>1))->referenceCount) == 1) {
			/* then it's the first time we've visited it, so: */
			visit((objectTable + (x>>1))->class);
			s= (int) byteToInt((objectTable + (x>>1))->size);
			if (s>0 && (objectTable + (x>>1))->type == objectMemory) {
				p= (objectTable + (x>>1))->memory;
				for (i=0; i < s; i++) visit(p[i]);
				}
			}
#else
		if (++(objectTable[x>>1].referenceCount) == 1) {
			/* then it's the first time we've visited it, so: */
			visit(objectTable[x>>1].class);
			s= (int) byteToInt(objectTable[x>>1].size);
			if (s>0 && objectTable[x>>1].type == objectMemory) {
				p= objectTable[x>>1].memory;
				for (i=0; i < s; i++) visit(p[i]);
				}
			}
#endif
		}
}

/*
	imageRead - read in an object image
		we toss out the free lists built initially,
		reconstruct the linkages, then rebuild the free
		lists around the new objects.
		The only objects with nonzero reference counts
		will be those reachable from either symbols or
		globalNames.
*/
static irerr() { sysError("imageWrite count error",""); }

noreturn imageRead(fp)
FILE *fp;
{	short i;
	object *p;

	if (fread(ptr(&symbols), sizeof(object), 1, fp) != 1) irerr();
	if (fread(ptr(&globalNames), sizeof(object), 1, fp) != 1) irerr();

	while(fread(ptr(&i), sizeof(short), 1, fp) == 1) {
		if ((i < 0) || (i > ObjectTableMax))
			sysError("index out of range","imageRead");
#ifdef	A_ST
		if (fread(ptr(&(objectTable + i)->class), sizeof(object), 1, fp)
				!= 1) irerr();
		if (((objectTable + i)->class < 0) || 
			((objectTable + i)->class > ObjectTableMax))
				sysError("class out of range","imageRead");
		if (fread(ptr(&(objectTable + i)->size), sizeof(byte), 1, fp)
				!= 1) irerr();
		if (fread(ptr(&(objectTable + i)->type), sizeof(byte), 1, fp)
				!= 1) irerr();
		if ((objectTable + i)->size != 0) {
			p = (objectTable + i)->memory = mBlockAlloc((int) (objectTable + i)->size);
			if (fread(ptr(p), sizeof(object),
				 (int) byteToInt((objectTable + i)->size), fp) != byteToInt((objectTable + i)->size))
						irerr();
			}
		else
			(objectTable + i)->memory = (object *) 0;
		}
#else
		if (fread(ptr(&objectTable[i].class), sizeof(object), 1, fp)
				!= 1) irerr();
		if ((objectTable[i].class < 0) || 
			(objectTable[i].class > ObjectTableMax))
				sysError("class out of range","imageRead");
		if (fread(ptr(&objectTable[i].size), sizeof(byte), 1, fp)
				!= 1) irerr();
		if (fread(ptr(&objectTable[i].type), sizeof(byte), 1, fp)
				!= 1) irerr();
		if (objectTable[i].size != 0) {
			p = objectTable[i].memory = mBlockAlloc((int) objectTable[i].size);
			if (fread(ptr(p), sizeof(object),
				 (int) byteToInt(objectTable[i].size), fp) != byteToInt(objectTable[i].size))
						irerr();
			}
		else
			objectTable[i].memory = (object *) 0;
		}
#endif
	/* now restore ref counts, getting rid of unneeded junk */
	visit(symbols);
	visit(globalNames);
	/* toss out the old free lists, build new ones */
	objectFreeList[0] = nilobj;
	setFreeLists();
}

static ncopy(p, q, n)
char *p, *q;
int n;
{

	while (n>0) {
		*p++ = *q++; 
		n--;
		}
}

object allocFloat(d)
double d;
{	object newObj;

	newObj = alcObject((int) sizeof (double), floatMemory);
	ncopy(charPtr(newObj), (char *) &d, (int) sizeof (double));
	return(newObj);
}

double floatValue(obj)
object obj;
{	double d;

	ncopy((char *) &d, charPtr(obj), (int) sizeof (double));
	return(d);
}

int objcount() 
{	int i, count;

	
	for (count = i = 0; i < ObjectTableMax; i++)
#ifdef	A_ST
		if ((objectTable + i)->referenceCount > 0)
#else
		if (objectTable[i].referenceCount > 0)
#endif
			count++;
	return(count);
}
objects up to 255 bytes can