/* diskmem.c : convert things from core to disk and back */
	
#include <stdio.h>

#define nblk 16
#undef SCOPE
#define SCOPE extern

#include "dc.h"
#include "fa.h"

#include "diskmem.h"		/* include "MemAssoc.h" */
#include "ev_tokens.h"		/* includes "hash.h" */

static int	dm_Inited = 0;
static DM_HDR	dm_hdr;
static MemAssocTable *	DC_tab;	/* disk-to-core table */
static MemAssocTable *	CD_tab;	/* core-to-disk table */

#define CheckInit(s)	if( !dm_Inited ) { printf(s); exit(1); }

static int	dm_Debug = 0;

/* ---- routines for various structures: Put(), Get(), Free() ---- */

int
dm_Init(fn,prog)	/* MUST BE CALLED FIRST */
	char *fn;
	char *prog;	/* this should be argv[0] from your main program */
{
HashTablePtr	cprog_link();
char *		tcore;
long		tdisk;

	if( dm_Inited )
		return 0;

	/* first, see if the core-to-disk-to-core conversion has a prayer */
	tcore = (char *) NIL;
	tdisk = (long) dm_Init;
	if( (long) tcore != NIL )
	{
		printf("DISKMEM ERROR: core-to-disk pointer conversion does not work!\n");
		exit(1);
	}
	if( (char *) tdisk != (char *) dm_Init )
	{
		printf("DISKMEM ERROR: disk-to-core pointer conversion does not work!\n");
		exit(1);
	}

	if( (Fa=FaOpen(fn,nblk,NULL)) == NULL )
	{
		printf("dm_Init(): FaOpen() failed on file '%s'\n",fn);
		return -1;
	}

	FaGet( Fa, (long) FAHDRZ, &dm_hdr, sizeof(dm_hdr) );
	if( dm_hdr.flags == NIL )
	{
		printf("dm_Init(): starting new Fa-file\n");
		FaAlloc( Fa, sizeof(DM_HDR) );/* reserve for later; starts at FAHDRZ */
		dm_hdr.Cdeclarations = NIL;
		dm_hdr.EnvHead = NIL;
		FaPut( Fa, (long) FAHDRZ, &dm_hdr, sizeof(DM_HDR) );
		FaAlloc( Fa, 1024 );		/* ensure all disk pointers are > 1024 */
		dm_hdr.flags = 0;
	}
	
	if( C_ht == NULL )
		C_ht = cprog_link( prog );

	DC_tab = MemCreateAssocTable( 128 );
	CD_tab = MemCreateAssocTable( 128 );

	dm_Inited = 1;
	return 0;
}

int
dm_CleanUp()		/* MUST BE CALLED LAST */
{
	CheckInit("dm_CleanUp(): ERROR: not initialized\n");
	FaPut( Fa, (long) FAHDRZ, &dm_hdr, sizeof(DM_HDR) );
	FaFlush( Fa );
	FaClose( Fa );
	MemDestroyAssocTable( DC_tab );
	MemDestroyAssocTable( CD_tab );
	dm_Inited = 0;
}

int
dm_ResetMemAssoc()
{
	CheckInit("dm_ResetMemAssoc(): ERROR: not initialized\n");
	MemDestroyAssocTable( DC_tab );
	MemDestroyAssocTable( CD_tab );	
	DC_tab = MemCreateAssocTable( 128 );
	CD_tab = MemCreateAssocTable( 128 );
	return 0;
}

/* ------- determine disk-thing type from magic number in struct ---- */

int
dm_GetMagic( dloc )
	long	dloc;
{
int	magic;

	CheckInit("dm_GetMagic(): ERROR: not initialized\n");
	if( dloc == NIL || dloc == NULL )
		return 0;

	FaGet( Fa, dloc, &magic, sizeof(int) );
	if( magic == VAR_MAGIC || magic == FCALL_MAGIC || magic == EXPR_MAGIC )
		return magic;
	else
		return 0;	/* indicate unknown disk-thing type */
}

/* -------- String functions ---------- */

long
dm_PutString( s )
	char *s;
{
long	dloc;
STRING_HDR	len;

	if( dm_Debug )
		printf("dm_PutString(): '%s'\n",(s?s:"NULL"));

	CheckInit("dm_PutString(): ERROR: not initialized\n");

	if( !s )
		return NIL;

	/* string is saved as:  short;str;0 (includes NULL byte) */
	
	len = strlen(s)+1;
	dloc = FaAlloc( Fa, len+sizeof(STRING_HDR) );
	FaPut( Fa, dloc, &len, sizeof(STRING_HDR) );
	FaPut( Fa, dloc+sizeof(STRING_HDR), s, len );
	return dloc;
}

char *
dm_GetString( dloc )
	long	dloc;
{
STRING_HDR	len;
char *		s;
char *		calloc();

	CheckInit("dm_GetString(): ERROR: not initialized\n");
	if( dloc == NIL || dloc == NULL )
		return NULL;

	FaGet( Fa, dloc, &len, sizeof(STRING_HDR) );
	s = calloc( 1, len );
	FaGet( Fa, dloc+sizeof(STRING_HDR), s, len );
	return s;
}

int
dm_FreeString( dloc )
	long	dloc;
{
STRING_HDR	len;

	CheckInit("dm_FreeString(): ERROR: not initialized\n");
	if( dloc == NIL || dloc == NULL )
		return -1;
	
	FaGet( Fa, dloc, &len, sizeof(STRING_HDR) );
	FaFree( Fa, dloc, len+sizeof(STRING_HDR) );
	return 0;
}

/* ---- VarList functions ----- */

long
dm_PutVarList( vp )	/* returns disk mem ptr */
	VAR_PTR	vp;
{
long	dloc;
VAR	temp;

	if( dm_Debug )
	{
		printf("dm_PutVarList(): ");
		if( vp )
			print_var(vp);
		else
			printf("NULL");
		printf("\n");
	}
			
	CheckInit("dm_PutVarList(): ERROR: not initialized\n");
	if( !vp || vp->magic != VAR_MAGIC )
		return NIL;

	dloc = FaAlloc( Fa, sizeof(VAR) );
	bcopy( vp, &temp, sizeof(VAR) );

	/* change all the core pointers to disk pointers */
	temp.name = (char *) dm_PutString( temp.name );
	temp.Cptr = 0;
	temp.val.sval = (char *) dm_PutString( temp.val.sval );
	temp.next = (VAR_PTR) dm_PutVarList( temp.next );

	/* write it out; set MemAssoc */
	MemMakeAssoc( DC_tab, dloc, (long) vp );
	MemMakeAssoc( CD_tab, (long) vp, dloc );
	FaPut( Fa, dloc, &temp, sizeof(VAR) );
	return dloc;
}

VAR_PTR
dm_GetVarList( dloc )
	long	dloc;
{
VAR_PTR	vp;
VAR	temp;
char *	str;
char *	calloc();
HashNodePtr	cprog_lookup();
HashNodePtr	hnp;

	CheckInit("dm_GetVarList(): ERROR: not initialized\n");
	if( dm_GetMagic( dloc ) != VAR_MAGIC )
		return NULL;

	FaGet( Fa, dloc, &temp, sizeof(VAR) );

	/* convert disk pointers to core pointers */
	temp.name = dm_GetString( (long)temp.name );
	if( IsCvar(&temp) )	/* fill in the appropriate address from C-table */
	{
		hnp = cprog_lookup( C_ht, temp.name );
		temp.Cptr = hnp->ptr;
	}
	else
		temp.Cptr = NULL;

	/* note special handling to create a MAXSTR in temp.val.sval */
	str = dm_GetString( (long) temp.val.sval );
	temp.val.sval = calloc( 1, MAXSTR );
	strcpy( temp.val.sval, str );
	free( (char *) str );

	temp.next = dm_GetVarList( (long)temp.next );

	vp = (VAR_PTR) calloc(1,sizeof(VAR));
	bcopy( &temp, vp, sizeof(VAR) );

	/* set MemAssoc */
	MemMakeAssoc( DC_tab, dloc, (long) vp );
	MemMakeAssoc( CD_tab, (long) vp, dloc );

	return vp;
}

int
dm_FreeVarList( dloc )
	long	dloc;
{
VAR	temp;
MemId	core;

	CheckInit("dm_FreeVarList(): ERROR: not initialized\n");
	if( dm_GetMagic( dloc ) != VAR_MAGIC )
		return -1;

	FaGet( Fa, dloc, &temp, sizeof(VAR) );

	dm_FreeVarList( (long) temp.next );
	FaFree( Fa, dloc, sizeof(VAR) );

	core = MemLookUpAssoc( DC_tab, dloc );
	if( core )
	{
		MemDeleteAssoc( DC_tab, dloc );
		MemDeleteAssoc( CD_tab, core );	
	}
	return 0;
}
	
/* ---------- CdecList functions --------------- */

long
dm_PutCdecList( cdp )
	C_DCL_PTR	cdp;
{
long	dloc;
C_DCL	temp;

	if( dm_Debug )
		printf("dm_PutCdecList()\n");

	CheckInit("dm_PutCdecList(): ERROR: not initialized\n");
	if( !cdp )
		return NIL;

	dloc = FaAlloc( Fa, sizeof(C_DCL) );
	bcopy( cdp, &temp, sizeof(C_DCL) );

	/* convert core pointers to disk pointers */
	temp.name = (char *) dm_PutString( temp.name );	
	temp.next = (C_DCL_PTR) dm_PutCdecList( temp.next );

	FaPut( Fa, dloc, &temp, sizeof(C_DCL) );
	return dloc;
}

C_DCL_PTR
dm_GetCdecList( dloc )
	long	dloc;
{
C_DCL	temp;
C_DCL_PTR	cdp;
HashNodePtr	hnp, cprog_lookup();
char *	calloc();

	CheckInit("dm_GetCdecList(): ERROR: not initialized\n");
	if( dloc == NIL || dloc == NULL )
		return NULL;

	FaGet( Fa, dloc, &temp, sizeof(C_DCL) );
	/* convert disk pointers to core pointers */
	temp.name = dm_GetString( (long) temp.name );
	temp.next = dm_GetCdecList( (long) temp.next );

	cdp = (C_DCL_PTR) calloc(1,sizeof(C_DCL));
	bcopy( &temp, cdp, sizeof(C_DCL) );

	/* just for kicks, verify that the C items are part of code-space */
	hnp = cprog_lookup( C_ht, temp.name );
	if( hnp == NULL )
		printf("dm_GetCdecList(): WARNING: C-item '%s' not in current code-space!\n",
			temp.name );
	return cdp;
}

int
dm_FreeCdecList( dloc )
	long	dloc;
{
C_DCL	temp;

	CheckInit("dm_FreeCdecList(): ERROR: not initialized\n");
	if( dloc == NIL || dloc == NULL )
		return -1;

	FaGet( Fa, dloc, &temp, sizeof(C_DCL) );
	dm_FreeCdecList( (long) temp.next );

	FaFree( Fa, dloc, sizeof(C_DCL) );
	
	return 0;
}

/* ------ Thing functions: for stuff in exprs and fcalls --- */

long
dm_PutThing( thingPtr )
	char *thingPtr;
{
int *	ip;
long	dloc;
MemId	core, disk;

	if( dm_Debug )
	{
		printf("dm_PutThing(): <");
		if( thingPtr )
		{
			switch( *(ip=(int *)thingPtr) )
			{
			case VAR_MAGIC:
				print_var((VAR_PTR)thingPtr);
				break;
			case FCALL_MAGIC:
				print_fcall((FCALL_PTR)thingPtr);
				break;
			case EXPR_MAGIC:
				print_expr((EXPR_PTR)thingPtr);
				break;
			default:
				printf("UNKNOWN");
			}
		}
		else
			printf("NULL");
		printf(">\n");
	}

	CheckInit("dm_PutThing(): ERROR: not initialized\n");
	if( !thingPtr )
		return NIL;

	ip = (int *) thingPtr;
	switch( *ip )
	{
	case VAR_MAGIC:
		dloc = MemLookUpAssoc( CD_tab, (long) thingPtr );
		if( !dloc )
		{
			printf("dm_PutThing(): ERROR: Var not found in MemAssocTable\n");
			return NIL;
		}
		break;
	case EXPR_MAGIC:
		dloc = dm_PutExpr( (EXPR_PTR) thingPtr );
		break;
	case FCALL_MAGIC:
		dloc = dm_PutFcall( (FCALL_PTR) thingPtr );
		break;
	default:
		if( !thingPtr )
			printf("dm_PutThing(): ERROR: given a NULL pointer\n");
		else
		{
			printf("dm_PutThing(): ERROR: unknown type of thing at %lx: %d\n",
				thingPtr,*ip);
			core = MemLookUpAssoc( DC_tab, (MemId) thingPtr );
			disk = MemLookUpAssoc( CD_tab, (MemId) thingPtr );

			if( disk )
			{
				printf("INTERNAL ERROR: %lx is in DiskToCore table at %lx\n",
					thingPtr,disk);
			}
			if( core )
			{
				printf("INTERNAL ERROR: %lx is in CoreToDisk table at %lx\n",
					thingPtr,core);
			}
		}
		dloc = NIL;
		break;
	}
	return dloc;
}

char *
dm_GetThing( dloc )
	unsigned long dloc;
{
char *	thingPtr;

	CheckInit("dm_GetThing(): ERROR: not initialized\n");
	if( dloc == NULL || dloc == NIL )
		return NULL;

	switch( dm_GetMagic( dloc ) )
	{
	case VAR_MAGIC:
		thingPtr = (char *) MemLookUpAssoc( DC_tab, dloc );
		if( !thingPtr )
		{
			printf("dm_GetThing(): ERROR: disk ptr not in MemAssocTable\n");
			thingPtr = NULL;
		}
		break;
	case EXPR_MAGIC:
		thingPtr = (char *) dm_GetExpr( dloc );
		break;
	case FCALL_MAGIC:
		thingPtr = (char *) dm_GetFcall( dloc );
		break;
	default:
		printf("dm_GetThing(): ERROR: unknown type of thing\n");
		thingPtr = NULL;
		break;
	}
	return thingPtr;
}

int
dm_FreeThing( dloc )
	long dloc;
{
int	res;

	CheckInit("dm_FreeThing(): ERROR: not initialized\n");
	switch( dm_GetMagic( dloc ) )
	{
	case VAR_MAGIC:
		/* do nothing!! */
		break;
	case EXPR_MAGIC:
		res = dm_FreeExpr( dloc );
		break;
	case FCALL_MAGIC:
		res = dm_FreeFcall( dloc );
		break;
	default:
		printf("dm_FreeThing(): ERROR: unknown type of thing\n");
		res = -1;
		break;
	}
	return res;
}
	
/* ------- Expr functions --------- */

long
dm_PutExpr( ep )		/* does the entire tree */
	EXPR_PTR	ep;
{
long	dloc;
EXPR	temp;

	if( dm_Debug )
	{
		printf("dm_PutExpr(): <");
		if( ep )
			print_expr( ep );
		else
			printf("NULL");
		printf(">\n");
	}
	
	CheckInit("dm_PutExpr(): ERROR: not initialized\n");
	if( !ep || ep->magic != EXPR_MAGIC )
		return NIL;

	dloc = FaAlloc( Fa, sizeof(EXPR) );
	bcopy( ep, &temp, sizeof(EXPR) );

	/* convert core pointers to disk pointers */
	if( temp.left )
	{
		temp.left = (char *) dm_PutThing( temp.left );
	}
	else
		temp.left = (char *) NIL;

	if( temp.right )
	{
		temp.right = (char *) dm_PutThing( temp.right );
	}
	else
		temp.right = (char *) NIL;

	FaPut( Fa, dloc, &temp, sizeof(EXPR) );
	return dloc;
}

EXPR_PTR
dm_GetExpr( dloc )
	long dloc;
{
EXPR		temp;
EXPR_PTR	ep;
char *calloc();

	CheckInit("dm_GetExpr(): ERROR: not initialized\n");
	if( dm_GetMagic( dloc ) != EXPR_MAGIC )
		return NULL;
	
	FaGet( Fa, dloc, &temp, sizeof(EXPR) );

	if( temp.left == (char *) NIL )
		temp.left = NULL;
	else
		temp.left = dm_GetThing( (long) temp.left );

	if( temp.right == (char *) NIL )
		temp.right = NULL;
	else
		temp.right = dm_GetThing( (long) temp.right );

	ep = (EXPR_PTR) calloc(1,sizeof(EXPR));
	ep->magic = EXPR_MAGIC;
	bcopy( &temp, ep, sizeof(EXPR) );

	return ep;
}

int
dm_FreeExpr( dloc )
	long dloc;
{
EXPR	temp;

	CheckInit("dm_FreeExpr(): ERROR: not initialized\n");
	if( dm_GetMagic( dloc ) != EXPR_MAGIC )
		return -1;

	FaGet( Fa, dloc, &temp, sizeof(EXPR) );

	if( temp.left != (char *) NIL )
		dm_FreeThing( (long) temp.left );
	if( temp.right != (char *) NIL )
		dm_FreeThing( (long) temp.right );

	FaFree( Fa, dloc, sizeof(EXPR) );
	return 0;
}

/* --------- Fcall functions --------------- */

long
dm_PutFcall( fcp )
	FCALL_PTR	fcp;
{
long	dloc;
FCALL	temp;
int	i;

	if( dm_Debug )
	{
		printf("dm_PutFcall(): <");
		if( fcp )
			print_fcall( fcp );
		else
			printf("NULL");
		printf(">\n");
	}
	
	CheckInit("dm_PutFcall(): ERROR: not initialized\n");
	if( !fcp || (fcp->magic != FCALL_MAGIC) )
		return NIL;

	dloc = FaAlloc( Fa, sizeof(FCALL) );
	bcopy( fcp, &temp, sizeof(FCALL) );

	for( i=0; i<temp.nparms; i++ )
		if( temp.parms[i] )
		{
			temp.parms[i] = (char *) dm_PutThing( temp.parms[i] );
		}

	temp.func = (CODE_PTR) MemLookUpAssoc( CD_tab, (long) temp.func );
	if( !temp.func )
	{
		printf("dm_PutFcall(): ERROR: can't find CODE_PTR in MemAssocTable\n");
		temp.func = (CODE_PTR) NIL;
	}

	FaPut( Fa, dloc, &temp, sizeof(FCALL) );
	return dloc;
}

FCALL_PTR
dm_GetFcall( dloc )
	long dloc;
{
FCALL		temp;
int		i;
FCALL_PTR	fcp;
char *calloc();

	CheckInit("dm_GetFcall(): ERROR: not initialized\n");
	if( dm_GetMagic( dloc ) != FCALL_MAGIC )
		return NULL;

	FaGet( Fa, dloc, &temp, sizeof(FCALL) );

	for( i=0; i<temp.nparms; i++ )
		temp.parms[i] = (char *) dm_GetThing( (long) temp.parms[i] );

	temp.func = (CODE_PTR) MemLookUpAssoc( DC_tab, (long) temp.func );
	if( !temp.func )
	{
		printf("dm_GetFcall(): ERROR: can't find disk ptr in MemAssocTable\n");
		temp.func = NULL;
	}

	fcp = (FCALL_PTR) calloc( 1, sizeof(FCALL));
	bcopy( &temp, fcp, sizeof(FCALL) );
	fcp->magic = FCALL_MAGIC;

	return fcp;
}

int
dm_FreeFcall( dloc )
	long dloc;
{
FCALL		temp;
int		i;

	CheckInit("dm_FreeFcall(): ERROR: not initialized\n");
	if( dm_GetMagic( dloc ) != FCALL_MAGIC )
		return -1;

	FaGet( Fa, dloc, &temp, sizeof(FCALL) );
	for( i=0; i<temp.nparms; i++ )
		dm_FreeThing( (long) temp.parms[i] );

	FaFree( Fa, dloc, sizeof(FCALL) );
	return 0;
}

/* ------------- CodeList functions ------------ */

long
dm_PutCodeList( cp )
	CODE_PTR	cp;
{
long 	dloc, tloc;
int	i;
CODE	temp;
unsigned long instr[MAXSTR];

	if( dm_Debug )
		printf("dm_PutCodeList(): '%s'\n",(cp?cp->name:"NULL"));
	
	CheckInit("dm_PutCodeList(): ERROR: not initialized\n");
	if( !cp )
		return NIL;

	dloc = FaAlloc( Fa, sizeof(CODE) );
	bcopy( cp, &temp, sizeof(CODE) );
	if( cp->type != CFUNC_CODESEG )
	{
		bcopy( cp->code, instr, MAXSTR );
		temp.code = instr;
	}

	/* make sure funcs are registered before any fcalls */

	MemMakeAssoc( CD_tab, (long) cp, dloc );
	MemMakeAssoc( DC_tab, dloc, (long) cp );

	temp.name = (char *) dm_PutString( temp.name );
	if( temp.type != CFUNC_CODESEG )
	{
		temp.varlist = (VAR_PTR) dm_PutVarList( temp.varlist );
		for( i=0; i<temp.nparms; i++ )		/* secure the parm ptrs */
		{
			temp.parms[i] = (VAR_PTR) MemLookUpAssoc( CD_tab, (long)temp.parms[i] );
			if( !temp.parms[i] )
			{
				printf("dm_PutCodeList(): ERROR: cannot find parm ptrs in MemAssocTable!\n");
				temp.parms[i] = (VAR_PTR) NIL;
			}
		}
		for( i=0; i<temp.ninstr; i++ )
			if( temp.code[i] > 500 )	/* assume it's a pointer */
			{
				temp.code[i] = dm_PutThing( (char *) temp.code[i] );
			}
		tloc = FaAlloc( Fa, MAXSTR*sizeof(unsigned long) );
		FaPut( Fa, tloc, temp.code, MAXSTR*sizeof(unsigned long) );
		temp.code = (unsigned long *) tloc;
	}
	else
	{
		for( i=0; i<temp.nparms; i++ )
			temp.parms[i] = (VAR_PTR) dm_PutVarList( temp.parms[i] );
	}


	temp.next = (CODE_PTR) dm_PutCodeList( temp.next );

	FaPut( Fa, dloc, &temp, sizeof(CODE) );

	return dloc;
}

CODE_PTR
dm_GetCodeList( dloc )
	long dloc;
{
CODE		temp;
CODE_PTR	cp;
long		tloc;
int		i;
char *calloc();

	CheckInit("dm_GetCodeList(): ERROR: not initialized\n");
	if( dloc == NIL || dloc == NULL )
		return NULL;

	FaGet( Fa, dloc, &temp, sizeof(CODE) );

	temp.name = dm_GetString( (long) temp.name );
	if( temp.type == CFUNC_CODESEG )
	{
		/* just for kicks, see if it exists in current code-space */
		if( cprog_lookup( C_ht, temp.name ) == NULL )
		{
			printf("dm_GetCodeList(): WARNING: C-function '%s' ",temp.name);
			printf("does not exist in current code-space!\n");
		}
		for( i=0; i<temp.nparms; i++ )
			temp.parms[i] = dm_GetVarList( (long)temp.parms[i] );
	}
	else
	{
		temp.varlist = dm_GetVarList( (long) temp.varlist );
		for( i=0; i<temp.nparms; i++ )		/* secure the parms */
		{
			temp.parms[i] = (VAR_PTR)MemLookUpAssoc(DC_tab,(long)temp.parms[i]);
			if( !temp.parms[i] )
			{
				printf("dm_GetCodeList(): ERROR: cannot find parm ptrs in MemAssocTable!\n");
				temp.parms[i] = NULL;
			}
		}

		tloc = (long) temp.code;
		temp.code = (unsigned long *) calloc(1,		
			MAXSTR*sizeof(unsigned long) );
		FaGet( Fa, tloc, temp.code, 
			MAXSTR*sizeof(unsigned long) );

		/* note: disk ptrs should all be greater than 1024, because we
			FaAlloc'ed a block of that size during initialization of the file */

		for( i=0; i<temp.ninstr; i++ )
			if( temp.code[i] > 500 )	/* assume it's a disk ptr */
				temp.code[i] = (long) dm_GetThing( temp.code[i] );
	}

	cp = (CODE_PTR) calloc(1,sizeof(CODE));

	MemMakeAssoc( DC_tab, dloc, (long) cp );
	MemMakeAssoc( CD_tab, (long) cp, dloc );

	temp.next = dm_GetCodeList( (long) temp.next );

	bcopy( &temp, cp, sizeof(CODE) );
	return cp;
}

int
dm_FreeCodeList( dloc )
	long dloc;
{
CODE		temp;
int		i;
MemId		core;

	CheckInit("dm_FreeCodeList(): ERROR: not initialized\n");
	if( dloc == NIL || dloc == NULL )
		return -1;

	FaGet( Fa, dloc, &temp, sizeof(CODE) );

	dm_FreeString( (long) temp.name );
	dm_FreeVarList( (long) temp.varlist );
	for( i=0; i<temp.ninstr; i++ )
		if( temp.code[i] > 500 )
			dm_FreeThing( temp.code[i] );

	if( temp.type == CFUNC_CODESEG )
	{
		for( i=0; i<temp.nparms; i++ )
			dm_FreeVarList( (long) temp.parms[i] );
	}
	else
	{
		dm_FreeVarList( (long) temp.varlist );
		FaFree( (long) temp.code, MAXSTR*sizeof(unsigned long) );	
	}

	core = MemLookUpAssoc( DC_tab, dloc );
	if( core )
	{
		MemDeleteAssoc( DC_tab, dloc );
		MemDeleteAssoc( CD_tab, core );
	}

	dm_FreeCodeList( (long) temp.next );

	FaFree( Fa, dloc, sizeof(CODE) );
	return 0;
}

/* ------- ObjList functions -------- */

long
dm_PutObjList( op )
	OBJ_PTR	op;
{
long 	dloc;
OBJ	temp;

	if( dm_Debug )
		printf("dm_PutObjList(): '%s'\n",(op?op->name:"NULL"));

	CheckInit("dm_PutObjList(): ERROR: not initialized\n");
	if( !op )
		return NIL;

	dloc = FaAlloc( Fa, sizeof(OBJ) );
	bcopy( op, &temp, sizeof(OBJ) );

	temp.name = (char *) dm_PutString( temp.name );
	temp.common_vars = (VAR_PTR) dm_PutVarList( temp.common_vars );
	temp.codelist = (CODE_PTR) dm_PutCodeList( temp.codelist );
	temp.binding = NULL;	/* hmm ...... */

	temp.next = (OBJ_PTR) dm_PutObjList( temp.next );

	FaPut( Fa, dloc, &temp, sizeof(OBJ) );
	return dloc;
}

OBJ_PTR
dm_GetObjList( dloc )
	long	dloc;
{
OBJ	temp;
OBJ_PTR	op;
char *calloc();

	CheckInit("dm_GetObjList(): ERROR: not initialized\n");
	if( dloc == NULL || dloc == NIL )
		return NULL;

	FaGet( Fa, dloc, &temp, sizeof(OBJ) );

	temp.name = dm_GetString( (long) temp.name );
	if( dm_Debug )
		printf("dm_GetObjList(): '%s'\n",temp.name?temp.name:"NULL");
	temp.common_vars = dm_GetVarList( (long) temp.common_vars );
	temp.codelist = dm_GetCodeList( (long) temp.codelist );

	temp.next = dm_GetObjList( (long) temp.next );

	op = (OBJ_PTR) calloc( 1, sizeof(OBJ) );
	bcopy( &temp, op, sizeof(OBJ) );

	/* make a new wbinding for each object as it gets pulled in */
	op->binding = newbinding( op );

	return op;
}

int
dm_FreeObjList( dloc )
	long dloc;
{
OBJ	temp;

	CheckInit("dm_FreeObjList(): ERROR: not initialized\n");
	if( dloc == NULL || dloc == NIL )
		return -1;

	FaGet( Fa, dloc, &temp, sizeof(OBJ) );

	dm_FreeString( (long) temp.name );
	dm_FreeVarList( (long) temp.common_vars );
	dm_FreeCodeList( (long) temp.codelist );
	dm_FreeObjList( (long) temp.next );

	FaFree( Fa, dloc, sizeof(OBJ) );
	return 0;
}

/* ---------- EnvList functions ------- */

long
dm_PutEnvList( ep )
	ENV_PTR	ep;
{
ENVIRONMENT	temp;
long	dloc;

	if( dm_Debug )
		printf("dm_PutEnvList(): '%s'\n",(ep?ep->name:"NULL"));

	CheckInit("dm_PutEnvList(): ERROR: not initialized\n");
	if( !ep )
		return NIL;

	dloc = FaAlloc( Fa, sizeof(ENVIRONMENT) );
	bcopy( ep, &temp, sizeof(ENVIRONMENT) );

	temp.name = (char *) dm_PutString( temp.name );
	temp.constants = (VAR_PTR) dm_PutVarList( temp.constants );
	temp.global_vars = (VAR_PTR) dm_PutVarList( temp.global_vars );
	temp.global_code = (CODE_PTR) dm_PutCodeList( temp.global_code );
	temp.objlist = (OBJ_PTR) dm_PutObjList( temp.objlist );
	temp.obj_ht = (HashTablePtr) CreateObjDict( (long) temp.objlist );
	temp.wb_table = NULL;	/* hmmm ...... */
	temp.next = (ENV_PTR) dm_PutEnvList( temp.next );

	FaPut( Fa, dloc, &temp, sizeof(ENVIRONMENT) );
	return dloc;
}

ENV_PTR
dm_GetEnvList( dloc )
	long	dloc;
{
ENVIRONMENT	temp;
ENV_PTR	ep;
char *calloc();

	if( dm_Debug )
		printf("dm_GetEnvList()\n");

	CheckInit("dm_GetEnvList(): ERROR: not initialized\n");
	if( dloc == NIL || dloc == NIL )
		return NULL;

	FaGet( Fa, dloc, &temp, sizeof(ENVIRONMENT) );
	
	temp.name = dm_GetString( (long) temp.name );
	temp.constants = dm_GetVarList( (long) temp.constants );
	temp.global_vars = dm_GetVarList( (long) temp.global_vars );
	temp.global_code = dm_GetCodeList( (long) temp.global_code );
	temp.objlist = dm_GetObjList( (long) temp.objlist );
	temp.obj_ht = CreateObjHT( temp.objlist );
	temp.wb_table = NULL;	/* hmmm ...... */
	temp.next = dm_GetEnvList( (long) temp.next );	

	ep = (ENV_PTR) calloc(1,sizeof(ENVIRONMENT));
	bcopy( &temp, ep, sizeof(ENVIRONMENT) );

	return ep;
}

int
dm_FreeEnvList( dloc )
	long	dloc;
{
ENVIRONMENT	temp;

	CheckInit("dm_FreeEnvList(): ERROR: not initialized\n");
	if( dloc == NIL || dloc == NIL )
		return -1;

	FaGet( Fa, dloc, &temp, sizeof(ENVIRONMENT) );
	
	dm_FreeString( (long) temp.name );
	dm_FreeVarList( (long) temp.constants );
	dm_FreeVarList( (long) temp.global_vars );
	dm_FreeCodeList( (long) temp.global_code );
	dm_FreeObjList( (long) temp.objlist );
	DestroyObjDict( (long) temp.obj_ht );
	dm_FreeEnvList( (long) temp.next );

	return 0;
}

/* --------- everything funcs ------------ */

int
dm_PutEveryThing()
{
	if( dm_Debug )
		printf("dm_PutEveryThing()\n");

	CheckInit("dm_PutEveryThing(): ERROR: not initialized\n");
	if( !envlist )
	{
		printf("dm_PutEveryThing(): ERROR: envlist is empty\n");
		return -1;
	}
	dm_hdr.Cdeclarations = dm_PutCdecList( C_declist );
	if( dm_Debug )
		printf("dm_PutEveryThing(): dm_hdr.Cdeclarations is %ld\n",dm_hdr.Cdeclarations);

	dm_hdr.EnvHead = dm_PutEnvList( envlist );
	if( dm_Debug )
		printf("dm_PutEveryThing(): dm_hdr.EnvHead is %ld\n",dm_hdr.EnvHead);

	FaPut( Fa, (long) FAHDRZ, &dm_hdr, sizeof(DM_HDR) );
	return 0;
}

int
dm_GetEveryThing()
{
C_DCL_PTR	clist, tcp, next, merge_clist;
ENV_PTR		elist, merge_elist;

	if( dm_Debug )
		printf("dm_GetEveryThing()\n");

	CheckInit("dm_GetEveryThing(): ERROR: not initialized\n");

	clist = dm_GetCdecList( dm_hdr.Cdeclarations );
	if( dm_Debug )
		printf("dm_GetEveryThing(): clist is at %lx\n",clist);

	if( !C_declist )
	{
		C_declist = clist;
		merge_clist = NULL;
	}
	else
		merge_clist = clist;

	elist = dm_GetEnvList( dm_hdr.EnvHead );
	if( dm_Debug )
		printf("dm_GetEveryThing(): new elist is at %lx\n",elist);

	if( !envlist )
	{
		envlist = elist;
		merge_elist = NULL;
	}
	else
		merge_elist = elist;

	ev_merge_EveryThing( merge_clist, merge_elist );

	return 0;
}

int
dm_FreeEveryThing()
{
	CheckInit("dm_FreeEveryThing()\n");
	FaGet( Fa, (long) FAHDRZ, &dm_hdr, sizeof(DM_HDR) );
	dm_FreeCdecList( dm_hdr.Cdeclarations );
	dm_FreeEnvList( dm_hdr.EnvHead );
	dm_hdr.Cdeclarations = NIL;
	dm_hdr.EnvHead = NIL;
	FaPut( Fa, (long) FAHDRZ, &dm_hdr, sizeof(DM_HDR) );
	return 0;
}

/* -------- extra hash and dictionary funcs ---------- */

long
CreateObjDict( dloc )
	long	dloc;	/* disk address of head of objlist */
{
long	root;
long	loc;
OBJ	temp;
char *	s;

	if( !dloc || dloc == NIL )
		return NIL;

	root = DcEmpty();

	for( loc = dloc; loc != NIL; loc = (long) temp.next )
	{
		FaGet( Fa, loc, &temp, sizeof(OBJ) );
		s = dm_GetString( (long) temp.name );
		if( s && strlen(s) )
			DcAdd( &root, s, loc );
		free( (char *) s );
	}
	return root;
}

static long	troot;

static int
doNothing( dloc )
	long dloc;
{
	return 0;
}

static int
FreeDictLeaf( dloc )
	long	dloc;	/* disk address of leaf node of dict about to be freed */
{
char *s;

	s = dm_GetString( dloc );	/* "name" is very first field in OBJ */
	DcDelete( &troot, doNothing, s );
	free( (char *) s );
	return 1;	/* required by DcVisitAll() */
}

int
DestroyObjDict( dloc )
	long	dloc;	/* disk address of root of obj dict */
{
	if( dloc == NIL || dloc == NULL )
		return -1;
	
	troot = dloc;
	DcVisitAll( &troot, FreeDictLeaf ); 
	return 0;
}

HashTablePtr
CreateObjHT( objlist )
	OBJ_PTR	objlist;
{
OBJ_PTR	op;
HashTablePtr	htp;
HashNodePtr	hnp;

	if( !objlist )
		return NULL;

	htp = hash_create( "Objects", 256 );
	for( op=objlist; op; op=op->next )
	{
		hnp = hash_install( htp, op->name, NULL, 0 );
		hnp->ptr = (char *) op;
	}
	
	return htp;
}