#include "Scian.h"
#include "ScianTypes.h"
#include "ScianIDs.h"
#include "ScianLists.h"
#include "ScianColors.h"
#include "ScianErrors.h"
#include "ScianNames.h"
#include "ScianGarbageMan.h"
#include "ScianMethods.h"
#include "ScianArrays.h"
#include "ScianTimers.h"
#include "ScianPictures.h"
#include "ScianWindows.h"
#include "ScianObjWindows.h"
#include "ScianVisWindows.h"
#include "ScianDialogs.h"
#include "ScianComplexControls.h"
#include "ScianDatasets.h"
#include "ScianVisObjects.h"
#include "ScianScripts.h"
#include "ScianSockets.h"
#include "ScianNetObjects.h"

/*TEMPORARY*/
Bool	Equal(ObjPtr obj1, ObjPtr obj2);

char *whatsMyName = "SciAn";

long int createdObjects = 0;

unsigned long anotherDamnReferenceCount = 0;

/* ComparePtrs returns true iff two pointers address the same location */
#define ComparePtrs(obj1,obj2) ((void *) (obj1) == (void *) (obj2))

/* AssignPtr assigns one pointer to another regardless of types pointed to */
#define AssignPtr(p1,p2) ((void *) (p1) = (void *) (p2))

#define DELSTAGE0 0
#define DELSTAGE1 1
#define DELSTAGE2 2

ObjPtr objClass = 0;
ObjPtr stringClass;
ObjPtr ObjTrue;
ObjPtr ObjFalse = NULLOBJ;

long globalThingCount=0;
long globalRefCount = 0;

/**-- Statistics stuff */

#ifndef STATSFILENAME
#define STATSFILENAME "scianStatistics"
#endif

FILE *statsFile = 0;

struct {
	long getvar;
	long setvar;
	long changevar;
} statsArray[MAXIDNUM];

int trackStatistics = 0;

void PrintStatisticsTree(node)
NameNodePtr node;
{
    if (!node) return;
    PrintStatisticsTree(node->left);
    if (statsArray[node->id].getvar || statsArray[node->id].setvar ||
	statsArray[node->id].changevar)
    {
	fprintf(statsFile, "%-8ld GetVar, %-8ld SetVar, %-8ld ChangeVar %s\n",
	    statsArray[node->id].getvar, statsArray[node->id].setvar,
	    statsArray[node->id].changevar, GetInternalString(node->id));
    }
    PrintStatisticsTree(node->right);
}

int iteration = 0;

void PrintStatistics()
{
    fprintf(statsFile, "#### PrintStatistics iteration %d\n", iteration++);
    PrintStatisticsTree(IDsTree);
}

void ClearStatistics()
{
    int i;

    for (i = 0; i < MAXIDNUM; ++i)
    {
	statsArray[i].getvar = 0;
	statsArray[i].setvar = 0;
    }
}

void TurnOnStatistics()
{
    if (!statsFile)
    {
	statsFile = fopen (STATSFILENAME, "w");
	if (!statsFile)
	{
	    Error("TurnOnStatistics Internal Error", OPENFILEERROR, STATSFILENAME);
	    statsFile = stderr;
	}
    }
    trackStatistics = 1;
}

void TurnOffStatistics()
{
    trackStatistics = 0;
}

/**-- miscellaneous junk */

Bool IsTrue(obj)
ObjPtr obj;
{
    return obj && IsInt(obj) && GetInt(obj);
}

ObjPtr SetObjValue(obj, value)
ObjPtr obj, value;
{
    ObjPtr oldvalue;
    ObjPtr retVal;

    oldvalue = GetVar(obj, VALUE); /* Note: NOT GetValue */
    SetVar(obj, VALUE, value);
    if(!Eql(value, oldvalue))
    {
	ChangedValue(obj);
	retVal = ObjTrue;
    }
    else
    {
	retVal = ObjFalse;
    }

    ImInvalid(obj);
    if (logging) LogControl(obj);

    return retVal;
}

ObjPtr GetObjValue(obj)
ObjPtr obj;
{
    return GetVar(obj, VALUE);
}

ObjPtr        NewObject(class, extra)
ObjPtr        class;
unsigned long extra;
/* NewObject:	creates a new object of class class. if <extra> is non-
                zero, <extra> bytes are tacked onto the end of the object,
                for some unknown use. The vars list is nil, the flags have
                only the Object bit set. returns:pointer to the new object */
{
    ObjPtr	newThing;

    if (!(newThing = (ObjPtr) malloc(sizeof(Obj) + extra) ))
    {
	OMErr();
	return (ObjPtr) NIL;
    }
    newThing -> flags = 0;
    SETOBJTYPE(newThing -> flags, PLAINOBJECT);
    /* newThing->refCount = 0; */
    if (class)
    {
	newThing->class = class;
    }
    else
    {
	newThing->class = objClass;
    }
    newThing->vars = (VarsPtr) NIL;
    newThing->methods = (MethodPtr) NIL;
    newThing->depends = (DependPtr) NIL;
    IncGlobalThingCount();

    /* newThing->rNext = NULLOBJ; */
    newThing->garbageFlag = DELSTAGE0;
    AddToGlobalList(newThing);
    ++createdObjects;
    return newThing;
}

ObjPtr	ClassOf(object)
ObjPtr	object;
{
    return object->class;
}

VarsPtr	NewVarsNode(name,value)
NameTyp	name;
ObjPtr	value;
/* NewVarsNode:    creates a new node for the internal vars list (binary tree)
	of an object. Sets ->name to name, ->value to value, tree
	pointers to NIL, chCount to something. Returns pointer to new node. */
{
    VarsPtr    theVar;

    if (!( theVar = (VarsPtr) malloc(sizeof(Vars)) ))
    {
	OMErr();
	return (VarsPtr) NIL;
    }
    theVar->name = name;
    theVar->value = value;
    theVar->left = (struct VarsNode *) NIL;
    theVar->right = (struct VarsNode *) NIL;
    theVar->chCount = ++anotherDamnReferenceCount;

    theVar->process = NULLOBJ;
    theVar->remoteChCount = 0;
    theVar->remoteNetID = 0;


    if (anotherDamnReferenceCount == 0xFFFFFFFFL)
    {
	ReportError("NewVarsNode", "Eric is a liar!");
    }
    return theVar;
}


#ifdef PROTO
VarsPtr ResetVarsNode(VarsPtr vptr, ObjPtr value)
#else
VarsPtr ResetVarsNode(vptr, value)
VarsPtr vptr;
ObjPtr value;
#endif
/* Changes the value of a var. Resets value-associated things (changecount, remote
 * stuff) but leaves the var tree connectivity stuff (left, right pointers) alone.
 */
{
    vptr -> value = value;
    vptr -> chCount = ++anotherDamnReferenceCount;
    if (anotherDamnReferenceCount == 0xFFFFFFFFL)
    {
	ReportError("ResetVarsNode", "Eric is a liar!");
    }
    
    vptr -> remoteNetID = 0;
    vptr -> remoteChCount = 0;
    vptr -> process = NULLOBJ;

}

VarsPtr GetVarNode(obj, var)
ObjPtr obj;
NameTyp var;
/* GetVarNode: instead of returning the value of <var> in <obj>, this returns
 * a pointer to the var node. So, disregarding weirdnesses like Distributed
 * Objects, "foo = GetVarNode(obj, var); bar = foo -> value;" is equivalent
 * to "bar = GetVar(obj, var);" . Really!!
 */
{
    VarsPtr tester;

    while (obj)
    {
	tester = obj -> vars;
	while (tester)
	{
	    if (var == tester->name)
	    {
		/* found it */
		return tester;
	    }
	    else
	    {
		if (var > tester->name)
		{
		    tester = tester -> right;
		}
		else /* var < tester -> name */
		{
		    tester = tester -> left;
		}
	    }
	}
	/* not found, traverse up class hierarchy */
	obj = obj -> class;
    }

    /* not found */
    return (VarsPtr) 0;
}

/* returns true if obj1/var1 'older' than obj2/var2 (i.e. chCt 1 < chCt 2) */
Bool CompareVarChangeCounts(obj1, var1, obj2, var2)
ObjPtr obj1, obj2;
NameTyp var1, var2;
/* NOTE: obj1/var1 dependent on obj2/var2 */
{
    unsigned long chCount1, chCount2;
    VarsPtr vnode1, vnode2;

    vnode1 = GetVarNode(obj1, var1);
    vnode2 = GetVarNode(obj2, var2);

    if (!vnode1)
    {
	return true;
    }

    if (!vnode2)
    {
	return false;
    }

    if (vnode1 -> remoteNetID && vnode2 -> remoteNetID)
    {
	if ((vnode1 -> remoteNetID == NETSTUBFLAG) || (vnode2 -> remoteNetID == NETSTUBFLAG))
	{
	    return false;
	}
	return vnode1 -> remoteChCount < vnode2 -> remoteChCount;
    }
    else
    {
	return vnode1 -> chCount < vnode2 -> chCount;
    }
}

unsigned long GetVarChangeCount(object, varname)
ObjPtr object;
NameTyp varname;
{
    VarsPtr tester;

    if (!object)
    {
	return 0;
    }

    tester = object->vars;
    while (tester)
    {
	if (varname == tester->name)
	{
	    /* found it */
#ifdef SOCKETS
	    if (tester->remoteNetID && !ThisWouldBeAReallyBadThing(varname))
	    {
		ObjPtr remote;

		if (tester -> remoteNetID == NETSTUBFLAG)
		{
#if 0
fprintf(stderr, "SendGetVarMessage from GetVarChangeCount (Netid == NETSTUBFLAG)\n");
		    /* has never been retrieved yet */
		    SendGetVarMessage(object, varname);
		    WaitForNetObjectVar(object, tester);
		    return tester->remoteChCount;
#else
		    return anotherDamnReferenceCount + 1;
#endif
		}

		remote = FindRemoteObject(tester -> process, tester -> remoteNetID, false);
		if (remote)
		{
		    return tester -> remoteChCount;
		}
		else
		{
		    /* not sure if correct, but it seems to work */
		    return anotherDamnReferenceCount + 1;
		}
	    }
#endif
	    return tester->chCount;
	}
	else
	{
	    if (varname > tester->name)
	    {
		tester = tester -> right;
	    }
	    else /* varname < tester -> name */
	    {
		tester = tester -> left;
	    }
	}
    }
    /* wasn't found, try the class of the object */
    return GetVarChangeCount(object->class, varname);
}

ObjPtr		SetVar(object,varname,value)
ObjPtr		object;
ObjPtr		value;
NameTyp		varname;
/* SetVar: Associates varname with value in object object. If an 
 * association of varname existed previously, SetVar updates it.
 * If not, SetVar creates a new one in the object's var list
 * SIDE EFFECT: SetVar always updates anotherDamnReferenceCount
 *
 * Modified 10-15-91 John Murray
 *     Returns the value which the variable was set to, or ObjFalse
 */
{
    VarsPtr	tester;
    int		notfound;

    if (trackStatistics)
    {
	++statsArray[varname].setvar;
    }

    if (!object)
    {
	return ObjFalse;
    }

/* #ifndef RELEASE */
    if ( (!SanityCheckObject(object)) || (!SanityCheckObject(value)))
    {
	return ObjFalse;
    }
/* #endif */

    /* search for variable in object->vars */
    notfound = true;
    tester = object->vars;
    if ( ! object->vars)
    {
	object->vars = NewVarsNode(varname,value); /* add first node */
	return value;
    }
    while(notfound)
    {
	/* shouldn't find the net stub down in the tree. (bad thing if we do) */
	if (varname == tester->name)
	{

#ifdef SOCKETS
	    /* if the object and old value are published, notify about update */
	    if (/*IsPublished(tester -> value) && */IsPublished(object))
	    {
#ifdef DEBUG
fprintf(stderr, "sending update notice for var %s\n",
    GetInternalString(tester -> name));
#endif
		SendVarUpdateNotice(object, tester -> name);
	    }
#endif

	    notfound = false;
	    ResetVarsNode(tester, value);
	}
	else if (varname > tester->name)
	{
	    if (tester->right)
		tester = tester->right;
	    else                /* add node right */
	    {
		tester->right = NewVarsNode(varname,value);
		notfound = false;
	    }
	}
	else                /* varname < tester->name */
	{
	    if (tester->left)
		tester = tester->left;
	    else                /* add node left */
	    {
		tester->left = NewVarsNode(varname,value);
		notfound = false;
	    }
	}
    }
    return value;
}

Bool		ChangeVar(object,varname,value)
ObjPtr		object;
ObjPtr		value;
NameTyp		varname;
/* ChangeVar:	Associates varname with value in object object. If an 
		association of varname existed previously, ChangeVar updates it.
		If not, ChangeVar creates a new one in the object's var list 
		IF AND ONLY IF the old and new values are not Equal(). 
		SIDE EFFECT: may or may not change anotherDamnReferenceCount */
{
    VarsPtr	tester;
    int		notfound = true;
    Bool	retVal;

    if (!object)
    {
	return false;
    }

#if 0
    if (IsNetwork(object))
    {
	fprintf(stderr, "ChangeVar on Network object\n");
	return false;
    }
#endif

    if (IsRemote(object))
    {
	fprintf(stderr, "ChangeVar on Remote object... NOT!\n");
	return false;
    }

    /* search for variable in object->vars */
    if ( ! object->vars)
    {
	/* add first node */
	object->vars = NewVarsNode(varname,value);
	if (Equal(GetVar(ClassOf(object), varname), value))
	{
	    --anotherDamnReferenceCount;
	    object->vars->chCount = GetVarChangeCount(ClassOf(object), varname);
	    retVal = false;
	}
	else
	{
	    retVal = true;
	}
	return retVal;
    }

    tester = object->vars;
    while(notfound)
    {
	if (varname == tester->name)
	{

if (tester -> remoteNetID)
    fprintf(stderr, "WARNING! ChangeVar superseding remote value (netid %ld) of %s\n", tester -> remoteNetID, IDName(varname));

#if 0
	    if (IsNetwork(tester->value))
	    {
		fprintf(stderr, "ChangeVar: value of var is Network object\n");
		return false;
	    }
#endif

	    if (IsRemote(tester -> value))
	    {
		fprintf(stderr, "ChangeVar value of variable is Remote\n");
		return false;
	    }

	    if (Equal(GetVar(object, varname), value))
	    {
		tester->value = value;
		retVal = false;
	    }
	    else
	    {
		ResetVarsNode(tester, value);
		retVal = true;
	    }
	    notfound = false;
	}
	else if (varname > tester->name)
	{
	    if (tester->right)
		tester = tester->right;
	    else                /* add node right */
	    {
                tester->right = NewVarsNode(varname,value);
		if (Equal(GetVar(ClassOf(object), varname), value))
		{
		    /* trust me, I know what I'm doing... */
		    --anotherDamnReferenceCount;
		    tester->right->chCount = GetVarChangeCount(ClassOf(object), varname);
		    retVal = false;
		}
		else
		{
		    retVal = true;
		}
		notfound = false;
	    }
	}
	else                /* varname < tester->name */
	{
	    if (tester->left)
		tester = tester->left;
	    else                /* add node left */
	    {
                tester->left = NewVarsNode(varname,value);
		if (Equal(GetVar(ClassOf(object), varname), value))
		{
		    /* trust me, I know what I'm doing... */
		    --anotherDamnReferenceCount;
		    tester->left->chCount = GetVarChangeCount(ClassOf(object), varname);
		    retVal = false;
		}
		else
		{
		    retVal = true;
		}
		notfound = false;
	    }
	}
    }
    return retVal;
}

void	CloneVarTreeInternal(obj, tree)
ObjPtr	obj;
VarsPtr	tree;
{
    if (tree)
    {
	if (tree -> remoteNetID)
	{
	    VarsPtr vptr;

	    SetVar(obj, tree->name, NULLOBJ); /* can't SetVar to the value, might be bad */
	    vptr = GetVarNode(obj, tree->name);
	    vptr -> process = tree -> process;
	    vptr -> remoteNetID = tree -> remoteNetID;
	    vptr -> remoteChCount = tree -> remoteChCount;
	    vptr -> value = tree -> value;
	}
	else
	{
	    SetVar(obj, tree->name, tree->value);
	}

	CloneVarTreeInternal(obj, tree->left);
	CloneVarTreeInternal(obj, tree->right);
    }
}

void	CloneVars(target, src)
ObjPtr	target, src;
{
    CloneVarTreeInternal(target, src->vars);
}

#ifdef SOCKETS
ObjPtr gviRetVal; /* I'm paranoid (not needed for non-sockets, returns &(t->v)*/
#endif

ObjPtr    *GetVarInternal(object,varname)
ObjPtr        object;
NameTyp       varname;
/* GetVarInternal: returns the value with which a varname is associated within
	object. Returns NIL if no association was found in object */
/* NOTE: Currently there is no mechanism for undefining a name other than
	defining it to be NIL. This means there is no way to redefine a name
	back to a class definition when it has been defined locally. */
/* June 16, 1992 Changed to return the pointer to the vars node
	instead of the pointer to the value of the vars node. (Note that
	returning a NIL varsptr implies no existing definition, while returning
	a valid varsptr whose value is NIL implies an existing definition
	of NIL) Also made non-recursive. Class traversal moved to GetVar. */
/* Sept 30, 1992 Changed to return a handle (pointer to ObjPtr) instead of VarsPtr*/ 
{
    VarsPtr    tester;

    if (!object)
    {
	return (ObjPtr *) 0;
    }

    /* search for variable in object->vars */
    tester = object->vars;
    while(tester)
    {
	if (tester->name == varname)
	{
#ifdef SOCKETS
	    if (tester -> remoteNetID)
	    {
		if (tester -> remoteNetID == NETSTUBFLAG)
		{
		    /*never been retrieved yet */
#ifdef DEBUG
fprintf(stderr, "SendGetVarMessage from GetVarInternal\n");
#endif
		    SendGetVarMessage(object, varname);
		    WaitForNetObjectVar(object, tester);
		    tester = GetVarNode(object, varname);
#ifdef PARANOID
		    if (tester -> remoteNetID == NETSTUBFLAG)
		    {
			ReportError("GetVarInternal", "internal error (probably network timeout)");
		    }
#endif
		    gviRetVal = FindRemoteObject(tester -> process, tester -> remoteNetID, false);
		    if (gviRetVal && !tester -> value)
		    {
			tester -> value = gviRetVal;
		    }
		    return &gviRetVal;
		}

		else if (!tester -> value)
		{
		    /* netid != 0 and netid != NETSTUBFLAG, so we must have a copy of it.. */
		    gviRetVal = FindRemoteObject(tester -> process, tester -> remoteNetID, true);
		    return &gviRetVal;
		}
		else
		{
		    if (IsDefunct(tester -> value))
		    {
fprintf(stderr, "re-getting defunct object\n");
			SendGetVarMessage(object, varname);
			WaitForNetObjectVar(object, tester);
			tester = GetVarNode(object, varname);
#ifdef PARANOID
			if (IsDefunct(tester -> value))
			{
			    ReportError("GetVarInternal", "internal error (timed out waiting for defunct obj)");
			}
#endif
			gviRetVal = FindRemoteObject(tester -> process, tester -> remoteNetID, false);
			if (gviRetVal)
			{
			    tester -> value = gviRetVal;
			}
			return &gviRetVal;
		    }
		    else
		    {
			return &(tester -> value);
		    }
		}
	    }
#endif
	    return &(tester -> value);
	}
	else if (varname > tester->name)
	    tester = tester->right;
	else                /* varname < tester->name */
	    tester = tester->left;
    }
    /* var wasn't found */
    return (ObjPtr *) 0;
}

ObjPtr GetVar(object,varname)
ObjPtr        object;
NameTyp        varname;
/* Searches for a variable in an object. Searches up the class hierarchy if
 * no variable value was found.
 */
{
    ObjPtr *handle;

    if (!object)
    {
	return NULLOBJ;
    }

    if (trackStatistics)
    {
	++statsArray[varname].getvar;
    }

    /* search for var, if necessary up the obj's class hierarchy until found */
    while (! (handle = GetVarInternal(object, varname)))
    {
	if (!object->class)
	    break;
	object = object->class;
    }

    if (handle)
	return *handle;
    else
	return NULLOBJ;
}

ObjPtr	Get1Var(object, varname)
ObjPtr        object;
NameTyp        varname;
/* Get1Var:    returns the value with which a varname is associated within
	object, [ not the object's class ]. Returns NIL if no
	association was found in object*/
/* NOTE: Currently there is no mechanism for undefining a name other than
	defining it to be NIL. This means there is no way to redefine a name
	back to a class definition when it has been defined locally. */
{
    ObjPtr *handle;

    if (!object)
    {
	return NULLOBJ;
    }

    if (trackStatistics)
    {
	++statsArray[varname].getvar;
    }

    /* search for var. This time, don't search the class hierarchy */

    handle = GetVarInternal(object, varname);
    if (handle)
	return *handle;
    else
	return NULLOBJ;
}

/**-- miscellaneous debug-type print routines */

void	PrintThing(thingp)
ObjPtr	thingp;
{
    int	k;

    if (!thingp)
    {
	printf("Nil thing.\n");
	return;
    }
    printf("Non-nil thing. thingp=0x%lx, ->flags=0x%lx\n",
		thingp, thingp->flags);
    switch(OBJTYPE(thingp->flags))
    {
	case ISOBJECT:
	    printf("object.\n");
	    PrintObject((ObjPtr) thingp);
	    PrintVarTree((ObjPtr) thingp);
	    break;
	case REALARRAY:
	    printf("RealArray. RANK = %d, DIMS=", RANK(thingp));
	    for (k = 0; k < RANK(thingp); ++k)
		printf(k == 0 ? "%ld" : ", %ld", DIMS(thingp)[k]);
	    printf(".\n");
	    /* PrintArray((ArrayPtr) thingp); */
	    break;
	case STRING:
	    printf("String.\n");
	    PrintString(thingp);
	    break;
	case INTEGER:
	    printf("Int.\n");
	    PrintInt(thingp);
	    break;
	case REAL:
	    printf("Real.\n");
	    PrintReal(thingp);
	    break;
	case LIST:
	    printf("List. Don't know how to print it.\n");
	    break;
	case PALETTE:
	    printf("Palette. Don't know how to print it.\n");
	    break;
	case MATRIX:
	    printf("Matrix. Don't know how to print it.\n");
	    break;
	default:
	    break;
    }
}

void	PrintObject(object)
ObjPtr	object;
/* PrintObject:    print out in hex the object's address, the object's flags,
	var tree ptr, class ptr, and in decimal, its name. */
{
    printf("&struct = 0x%lx\t",(long) object);
    if (object)
    {
	printf("o->flags = 0x%lx\t",object->flags);
	printf("o->class = 0x%lx\t",(long) object->class);
	printf("o->vars = 0x%lx\t",(long) object->vars);
	printf("o->methods = 0x%lx\n",(long) object->methods);
    }
    else
	printf("not object.\n");
}

void    PrintVarNodes(vp, indent)
VarsPtr    vp;
int        indent;
/* PrintVarNodes:    Internal. Print a var node's varname, and the
	associated value (ptr), and print its children, recursively*/
{
    int i;

    if (!vp) return;
    PrintVarNodes(vp->left, indent);
    for(i=0; i<indent; ++i)
	putchar(' ');
    printf("id=%s, &value=0x%lx, ", GetInternalString(vp->name), (long)vp->value);
    if (vp->value)
	printf("value->flags = 0x%lx\n", vp->value->flags);
    else
	printf("(no flags)\n");
    PrintVarNodes(vp->right, indent);
}

void    PrintVarTree(object)
ObjPtr    object;
/* PrintVarTree:    Print all of the associations of variable names with
	values in an object. Does not print associations of object's
	class. */
{
    if (!object)
    {
	printf("  PrintVarTree: passed NIL object pointer!\n");
	return;
    }
    printf("  Printing vars for object %lx\n",object);
    PrintVarNodes(object->vars, 4);
    printf("  end of vars for object #%lx\n",object);
}

/**-- Thing deletion system. reference counts also maintained by SetVar */

/* defined in ScianTypes.h */
/* #define GetRefCount(thingp) ((thingp) ? (thingp) -> refCount : -1) */

#ifdef PROTO
long IncRefCount(ObjPtr thingp)
#else
long IncRefCount(thingp)
ObjPtr thingp;
#endif
{
    AddToReferenceList(thingp);
    return 0;
}

void	DecGlobalThingCount()
{
    --globalThingCount;
    if (globalThingCount < 0)
    {
	ReportError("DecGlobalThingCount", "globalThingCount negative!");
    }
}

void		DeleteVarNode(nodep)
VarsPtr		nodep;		/* pointer to node to delete */
/* DeleteVarNode:	frees space allocated to a var node and all its kids */
{
    if (!nodep) return;
    DeleteVarNode(nodep->left);
    DeleteVarNode(nodep->right);
    free(nodep);
}

void		DeleteMethodNode(nodep)
MethodPtr	nodep;		/* pointer to node to delete */
/* DeleteMethodNode:	frees space allocated to a method node and its kids */
{
    if (!nodep) return;
    DeleteMethodNode(nodep->left);
    DeleteMethodNode(nodep->right);
    free(nodep);
}

int deleteCount=0;
int trivialDeleteCount=0;
int noDeleteCount=0;
int missedDeleteCount=0;

void		DeleteThing(thingp)
ObjPtr	thingp;
/* DeleteThing: an archaic routine whose function has been superseded.
 */

{
    RemoveFromReferenceList(thingp);
    return;
}

/**-- Methods routines */

FuncTyp		GetMethod(object,methname)
ObjPtr		object;
NameTyp		methname;
/* GetVar:	returns the value with which a methname is associated within
 * object, or objects class, recursively. Returns NIL if no
 * association was found in object or its classes.
 */
/* July 9, 1992 John R. Murray. GetMethod showed up at the top of the profile
 * report I just ran, so let's try to make it faster. Making it non-recursive.
 */
{
    ObjPtr thing;
    MethodPtr	tester;

    /* search for variable in object->methods */

    thing = object;
    while (thing)
    {
	tester = thing->methods;
	while(tester)
	{
	    if (tester->name == methname)
		return tester->method;
	    else if (methname > tester->name)
		tester = tester->right;
	    else                /* methname < tester->name */
		tester = tester->left;
	}

	/* didn't find it. Let's try its class */
	thing = ClassOf(thing);
    }
    /* didn't find method in object or object's classes (or object was 0) */
    return (FuncTyp) 0;
}

FuncTyp		Get1Method(object,methname)
ObjPtr		object;
NameTyp		methname;
/* GetVar:	returns the value with which a methname is associated within
		object, [ not the object's class ]. Returns NIL if no
		association was found in object */
{
    MethodPtr	tester;

    if (!object)
    {
	return (FuncTyp) 0;
    }

    /* search for variable in object->methods */
    tester = object->methods;
    while(tester)
    {
	if (tester->name == methname)
	    return tester->method;
	else if (methname > tester->name)
	    tester = tester->right;
	else                /* methname < tester->name */
	    tester = tester->left;
    }
    /* method wasn't found, so return "nil" */
    return (FuncTyp) 0;
}

MethodPtr	NewMethodsNode(name,method)
NameTyp		name;
FuncTyp		method;
/* NewVarsNode:    creates a new node for the internal vars list (binary tree)
	of an object. Sets ->name to name, ->method to method, tree
	pointers to NIL. Returns pointer to new node. */
{
    MethodPtr    theMethod;

    if (!( theMethod = (MethodPtr) malloc(sizeof(Method)) ))
    {
	OMErr();
	return (MethodPtr) NIL;
    }
    theMethod->name = name;
    theMethod->method = method;
    theMethod->left = (MethodPtr) NIL;
    theMethod->right = (MethodPtr) NIL;
    return theMethod;
}

Bool		SetMethod(object,methodname,value)
ObjPtr		object;
NameTyp		methodname;
FuncTyp		value;
/* SetMethod:	Associates methodname with function in object object. If an 
		association of methodname existed previously, SetMethod updates it.
		If not, SetMethod creates a new one in the object's var list */
{
    MethodPtr	tester;
    int		notfound;

    if (!object)
    {
	return false;
    }

    /* search for variable in object->methods */
    notfound = true;
    tester = object->methods;
    if ( ! object->methods)
    {
	object->methods = NewMethodsNode(methodname,value); /* add first node */
	notfound = false;
    }
    while(notfound)
    {
	if (methodname == tester->name)
	{
	    notfound = false;
	    tester->method = value;
	}
	else if (methodname > tester->name)
	{
	    if (tester->right)
		tester = tester->right;
	    else                /* add node right */
	    {
		tester->right = NewMethodsNode(methodname,value);
		notfound = false;
	    }
	}
	else                /* methodname < tester->name */
	{
	    if (tester->left)
		tester = tester->left;
	    else                /* add node left */
	    {
		tester->left = NewMethodsNode(methodname,value);
		notfound = false;
	    }
	}
    }
    return true;
}

/**-- Dependencies routines */

void AddDependency(dList, iVar, var)
DLPtr *dList;
NameTyp iVar, var;
{
    DLPtr newDep, *runner;

    runner = dList;
    while(*runner && (*runner) -> var < var && (*runner) -> indirectVar < iVar)
    {
	runner = &((*runner) -> next);
    }

    if (*runner && (*runner) -> var == var && (*runner) -> indirectVar == iVar)
    {
	/* already in list */
	return;
    }

    newDep = malloc(sizeof(struct DependListEl));
    newDep -> indirectVar = iVar;
    newDep -> var = var;
    newDep -> next = *runner;
    *runner = newDep;
}

DependPtr NewDependNode(var)
NameTyp var;
{
    DependPtr retVal;

    retVal = malloc(sizeof(Depend));
    if (!retVal)
    {
	OMErr();
	return retVal;
    }
    retVal -> var = var;
    retVal -> dependList = (DLPtr) 0;
    retVal -> left = (struct DependNode *) 0;
    retVal -> right = (struct DependNode *) 0;
    return retVal;
}

int CountNodes(dNode)
DependPtr dNode;
{
    if (!dNode)
	return 0;
    else
	return 1 + CountNodes(dNode -> left) + CountNodes(dNode -> right);
}

/* Pure brute force and ignorance */
int FindLongestBranches(dNode)
DependPtr dNode;
{
    int retVal, l, r;

    if (!dNode)
    {
	return 0;
    }

    if (dNode -> left || dNode -> right)
    {
	l = FindLongestBranches(dNode -> left);
	r = FindLongestBranches(dNode -> right);
	retVal = dNode -> longestBranch = 1 + (l > r ? l : r);
    }
    else
    {
	retVal = dNode -> longestBranch = 1;
    }
    return retVal;
}

Bool SetIndirectDependency(obj, var, dependObj, dependVar)
ObjPtr obj;
NameTyp var, dependObj, dependVar;
{
    DependPtr	tester;
    int		notfound;

    if (!obj)
    {
	return false;
    }

    /* search for variable in obj->depends */
    notfound = true;
    tester = obj->depends;
    if ( ! obj->depends)
    {
	obj->depends = NewDependNode(var); /* add first node */
	AddDependency(&(obj->depends->dependList), dependObj, dependVar);
	notfound = false;
    }
    while(notfound)
    {
	if (var == tester->var)
	{
	    notfound = false;
	    AddDependency(&(tester->dependList), dependObj, dependVar);
	}
	else if (var > tester->var)
	{
	    if (tester->right)
		tester = tester->right;
	    else                /* add node right */
	    {
		tester->right = NewDependNode(var);
		AddDependency(&(tester->right->dependList), dependObj, dependVar);
		notfound = false;
	    }
	}
	else                /* methodname < tester->name */
	{
	    if (tester->left)
		tester = tester->left;
	    else                /* add node left */
	    {
		tester->left = NewDependNode(var);
		AddDependency(&(tester->left->dependList), dependObj, dependVar);
		notfound = false;
	    }
	}
    }
#ifdef DEBUG
    fprintf(stderr, "# nodes %d, longest branch %d\n", CountNodes(obj->depends),
			FindLongestBranches(obj -> depends));
#endif
    return true;
}

Bool SetDependency(obj, var, dependVar)
ObjPtr obj;
NameTyp var, dependVar;
{
    return SetIndirectDependency(obj, var, 0, dependVar);
}

void GetDependencies(obj, var, callBack)
ObjPtr obj;
NameTyp var;
void (* callBack) (ObjPtr, NameTyp, NameTyp, NameTyp);
{
    ObjPtr classRunner;
    DependPtr tester;
    DLPtr runner;

    classRunner = obj;

    /* nothing happens if obj == nil; */
    while (classRunner)
    {
	tester = classRunner -> depends;
	while (tester && tester -> var != var)
	{
	    if (tester -> var > var)
	    {
		tester = tester -> left;
	    }
	    else
	    {
		tester = tester -> right;
	    }
	}
	if (tester)
	{

	    runner = tester -> dependList;
	    while (runner)
	    {
		if (callBack)
		{
		    (* callBack) (obj, var, runner->indirectVar, runner->var);
		}
		runner = runner -> next;
	    }
	}
	classRunner = classRunner -> class;
    }
}

void PrintDependencies(obj, var)
ObjPtr obj;
NameTyp var;
{
    DependPtr depends;
    DLPtr dList;

    if (!obj) return;

    depends = obj -> depends;
    while (depends && depends -> var != var)
    {
	if (depends -> var > var)
	    depends = depends -> left;
	else
	    depends = depends -> right;
    }

    if (!depends)
    {
	return;
    }

    dList = depends -> dependList;

    while (dList)
    {
	if (dList -> indirectVar)
	{
	    fprintf(stderr, "0x%x: var %s dependent on %s of %s\n", obj,
		IDName (var), IDName (dList->var), IDName (dList->indirectVar));
	}
	else
	{
	    fprintf(stderr, "0x%x: var %s dependent on var %s\n", obj,
		IDName (var), IDName (dList->var));
	}
	dList = dList -> next;
    }
    fprintf(stderr, "going up one class\n");
    PrintDependencies(obj->class, var);
    fprintf(stderr, "trying to call GetDependencies\n");
    GetDependencies(obj, var, 0);
}

void PrintAllDependencies(obj)
ObjPtr obj;
{
    int i;

    if (!obj)
    {
	return;
    }

    fprintf(stderr, "\nPrinting all dependencies for obj 0x%x\n", obj);

    for (i = 0; i < 500; ++i)
    {
	PrintDependencies(obj, i);
    }
    fprintf(stderr, "Done printing dependencies for obj 0x%x\n\n", obj);
}

void	CloneMethodTreeInternal(obj, tree)
ObjPtr		obj;
MethodPtr	tree;
{
    if (tree)
    {
	SetMethod(obj, tree->name, tree->method);
	CloneMethodTreeInternal(obj, tree->left);
	CloneMethodTreeInternal(obj, tree->right);
    }
}

void	CloneMethods(target, src)
ObjPtr	target, src;
{
    CloneMethodTreeInternal(target, src->methods);
}

/**-- BORK routines specific to type INTEGER */

ObjPtr	NewInt(intno)
/* NewInt:	create a new Thing of type Int. Allocates necessary space */
int	intno;
{
    IPtr ip;

    if (!(ip = (IPtr) NewObject(NULLOBJ, sizeof(IntThing) - sizeof(Obj))))
    {
	OMErr();
	return NULLOBJ;
    }
    ip->thing.flags = INTEGER; /* it's "Not" an object */

    ip->intpart = intno;
    return (ObjPtr) ip;
}

int GetInt (ip)
ObjPtr ip;
{
    if (!ip)
	return 0;
    if (!IsInt(ip))
    {
	if (IsReal(ip))
	    return ((RPtr) ip) -> realpart;
	else
	{
	    ReportError("GetInt", "non-numeric thing!");
	    return 0;
	}
    }
    return ((IPtr) ip) -> intpart;
}

void	SetInt (ip,intno)
/* SetInt:Sets the real number part of a Thing of type Int */
ObjPtr	ip;
int	intno;
{
    fprintf(stderr, "Don't use SetInt anymore, Bwana!\n");
    if (!ip)
    {
	ReportError("SetInt", "Null pointer!");
    }
    if (!IsInt(ip))
    {
	ReportError("SetInt", "Not an Int!");
    }
    ((IPtr) ip)->intpart = intno;
}

void	PrintInt(ip)
/* PrintInt: prints the contents of an int thing */
ObjPtr	ip;
{
    printf("&ip=%ld, intpart=%d\n",(long)ip,((IPtr)ip)->intpart);
}

/**-- routines specific to type Real */

/* NewReal: create a new Thing of type Real. Allocates necessary space. */
#ifdef PROTO
ObjPtr	NewReal(real realno)
#else
ObjPtr	NewReal(realno)
real	realno;
#endif
{
    RPtr	rp;

    if (!(rp = (RPtr) NewObject(NULLOBJ, sizeof(RealThing) - sizeof(Obj))))
    {
	OMErr();
	return NULLOBJ;
    }
    rp->thing.flags = REAL;
    /* fix the rest */
    rp->realpart = realno;
    return (ObjPtr) rp;
}

real GetReal(rp)
ObjPtr rp;
{
    if (!rp)
	return 0.0;
    if (!IsReal(rp))
    {
	if (IsInt(rp))
	    return ((IPtr) rp) -> intpart;
	else
	{
	    ReportError("GetReal", "non-numeric thing!");
	    return 0.0;
	}
    }
    return ((RPtr) rp) -> realpart;
}

/* SetReal:Sets the real number part of a Thing of type Real */
#ifdef PROTO
void	SetReal(ObjPtr rp, real realno)
#else
void	SetReal(rp,realno)
ObjPtr	rp;
real	realno;
#endif
{
    fprintf(stderr, "Don't use SetReal anymore, Bwana!\n");
    if (!rp)
    {
	ReportError("SetReal", "Null pointer!");
	return;
    }
    if (!IsReal(rp))
    {
	ReportError("SetReal", "Not a Real!");
	return;
    }
    ((RPtr) rp)->realpart = realno;
}

void	PrintReal(rp)
/* PrintReal: prints the contents of a real thing */
ObjPtr	rp;
{
	printf("&rp=%ld, realpart=%f\n",(long)rp,((RPtr)rp)->realpart);
}

ObjPtr	NewString(string)
/* NewString: makes space for and sets up new Thing of type StringThing
 * NOTE: some of the contents of this routine are copied in ConcatString!
 */
char	*string;
{
    SPtr	sp;

    if (!(sp = (SPtr) NewObject(stringClass, sizeof(StringThing) - sizeof(Obj))))
    {
	OMErr();
	return NULLOBJ;
    }
    sp->thing.flags = STRING;
    if (!(sp->stringPtr = malloc(strlen(string)+1) ))
    {
	OMErr();
	return NULLOBJ;
    }
    strcpy(sp->stringPtr,string);
    return (ObjPtr) sp;
}

ObjPtr	CleanupString(strObj)	/* CLEANUP method for string objects */
ObjPtr	strObj;
{
    if (!IsString(strObj))
    {
	ReportError("CleanupString", "got non-string object!");
	return ObjFalse;
    }

    if (! ((SPtr) strObj) -> stringPtr)
    {
	ReportError("CleanupString", "Tried to delete NIL");
	return ObjFalse;
    }

    free (((SPtr) strObj) -> stringPtr);
    return ObjTrue;
}

char *GetString(sp)
ObjPtr sp;
{
    if (!sp)
	return (char *) 0;
    if (!IsString(sp))
    {
	ReportError("GetString", "non-string thing!");
	return (char *) 0;
    }
    return ((SPtr) sp) -> stringPtr;
}

Bool	SetString(sp,string)
/* SetString: resets the string value of a Thing of type StringThing. Allo-
	cates the necessary space, and frees space occupied by the old value */
ObjPtr	sp;
char	*string;
{
    if (!sp)
    {
	return false;
    }
    if (!IsString(sp))
    {
	ReportError("SetString", "Not a STRING!");
    }
    free( ((SPtr)sp) -> stringPtr);
    if (!(((SPtr) sp) -> stringPtr = malloc(strlen(string)+1)))
    {
	OMErr();
	return false;
    }
    strcpy(((SPtr) sp) -> stringPtr,string);
}

ObjPtr ConcatStrings(str1, str2)
ObjPtr str1, str2;
{
    SPtr sp;
    long int len;

    if (!str1 && !str2)
    {
	return NULLOBJ;
    }

    if (!IsString(str1) || !IsString(str2))
    {
	ReportError("ConcatStrings", "Not a STRING!");
	return NULLOBJ;
    }

    if (!str1 || !((SPtr)str1)->stringPtr || !*((SPtr)str1)-> stringPtr)
    /* str1 == NULLOBJ or str1->stringPtr == NIL or first character == \0 */
    {
	return Clone(str2);
    }

    if (!str2 || !((SPtr)str2)->stringPtr || !*((SPtr)str2)-> stringPtr)
    /* str2 == NULLOBJ or str2->stringPtr == NIL or first character == \0 */
    {
	return Clone(str1);
    }

    len = strlen(((SPtr)str1)->stringPtr) + strlen(((SPtr)str2)->stringPtr);
    if (!(sp = (SPtr)NewObject(stringClass,sizeof(StringThing) - sizeof(Obj))))
    {
        OMErr();
        return NULLOBJ;
    }
    sp->thing.flags = STRING;
    if (!(sp->stringPtr = malloc(len+1) ))
    {
        OMErr();
        return NULLOBJ;
    }
    strcpy(sp->stringPtr,((SPtr)str1)->stringPtr);
    strcat(sp->stringPtr,((SPtr)str2)->stringPtr);
    return (ObjPtr) sp;
}

void	PrintString(sp)
/* PrintString: prints the contents of a string-thing */
ObjPtr	sp;
{
    if (!sp)
    {
	return;
    }
    else if (!(((SPtr) sp) -> stringPtr))
    {
	printf("PrintString: null pointer sp->stringPtr!\n");
    }
    else
    {
	printf("&sp=%ld, string=%s\n",(long)sp, ((SPtr) sp) -> stringPtr);
    }
}

#define THRESHOLD 10E-5

Bool	Eql(ObjPtr obj1, ObjPtr obj2)
{
    if (obj1 == NULLOBJ && obj2 == NULLOBJ)
    {
	return true;				/* two NULL ptrs are equal */
    }
    else if (obj1 == NULLOBJ || obj2 == NULLOBJ)
    {
	return false;			/* one NULL, one nonNULL are not */
    }
    else if (OBJTYPE(obj1->flags) != OBJTYPE(obj2->flags))
    {
	if (IsReal(obj1) && IsInt(obj2))
	{
	    int i; real r;

	    r = GetReal(obj1); i = GetInt(obj2);
	    if (abs(i - r) < abs(r * THRESHOLD))
		return true;
	    else
		return false;
	}
	else if (IsReal(obj2) && IsInt(obj1))
	{
	    int i; real r;

	    r = GetReal(obj2); i = GetInt(obj1);
	    if (abs(i - r) < abs(r * THRESHOLD))
		return true;
	    else
		return false;
	}
	else
	{
	    return false;	/* flags indicate incomparable things */
	}
    }
    else	/* now we have two non-null ptrs with identical type */
    {
	switch (OBJTYPE(obj1 -> flags))
	{
	    case REAL:
		return GetReal(obj1) == GetReal(obj2);
		break;
	    case INTEGER:
		return GetInt(obj1) == GetInt(obj2);
		break;
	    case STRING:
		{
		    char tempStr1[TEMPSTRSIZE], tempStr2[TEMPSTRSIZE];

		    strncpy(tempStr1, GetString(obj1), TEMPSTRSIZE);
		    strncpy(tempStr2, GetString(obj2), TEMPSTRSIZE);
		    return 0 == strcmp(tempStr1, tempStr2);
		}
		break;
	    case ISOBJECT:
	    case REALARRAY:
	    case LIST:
	    case PALETTE:
	    case MATRIX:
	    case WINDOW:
	    case PICTURE:
		return obj1 == obj2;
		break;
	    default:
		return obj1 == obj2; /* unknown type, but compare ptrs anyway */
		break;
	}
    }
}

Bool	Equal(ObjPtr obj1, ObjPtr obj2)
/* Equal: two things are defined to be Equal if and only if a) the pointers
	are the same, b) the things are of the same type, and are of
	(internal) type Integer, Real or String, and have the same values.
	(as of 6-19-91 this is functionally identical to Eql) */
{
    if (obj1 == NULLOBJ && obj2 == NULLOBJ)
    {
	return true;				/* two NULL ptrs are equal */
    }
    else if (obj1 == NULLOBJ || obj2 == NULLOBJ)
    {
	return false;			/* one NULL, one nonNULL are not */
    }
    else if (obj1->flags != obj2->flags)
    {
	if (obj1 -> flags == REAL && obj2 -> flags == INTEGER)
	{
	    int i; real r;

	    r = GetReal(obj1); i = GetInt(obj2);
	    if (abs(i - r) < abs(r * THRESHOLD))
		return true;
	    else
		return false;
	}
	else if (obj2 -> flags == REAL && obj1 -> flags == INTEGER)
	{
	    int i; real r;

	    r = GetReal(obj2); i = GetInt(obj1);
	    if (abs(i - r) < abs(r * THRESHOLD))
		return true;
	    else
		return false;
	}
	else
	{
	    return false;	/* if flags indicate incomparable things */
	}
    }
    else	/* now we have two non-null ptrs with identical flags */
    {
	switch (obj1 -> flags)
	{
	    case REAL:
		return GetReal(obj1) == GetReal(obj2);
		break;
	    case INTEGER:
		return GetInt(obj1) == GetInt(obj2);
		break;
	    case STRING:
		{
		    char tempStr1[TEMPSTRSIZE], tempStr2[TEMPSTRSIZE];

		    strncpy(tempStr1, GetString(obj1), TEMPSTRSIZE);
		    strncpy(tempStr2, GetString(obj2), TEMPSTRSIZE);
		    return 0 == strcmp(tempStr1, tempStr2);
		}
		break;
	    default:
		return obj1 == obj2; /* unknown type, but compare ptrs anyway */
		break;
	}
    }
}

ObjPtr	Clone(obj)
ObjPtr	obj;
{
    ObjPtr retVal = NULLOBJ;
    if (!obj)
    {
	return NULLOBJ;
    }
    switch(OBJTYPE(obj->flags))
    {
	case ISOBJECT:
	    retVal = NewObject(obj->class, 0);
	    break;
	case REALARRAY:
	    ReportError("Clone", "can't clone type REALARRAY!");
	    break;
	case STRING:
	    retVal = NewString( ((SPtr) obj) -> stringPtr);
	    retVal -> class = obj -> class;
	    break;
	case INTEGER:
	    retVal = NewInt(GetInt(obj));
	    retVal -> class = obj -> class;
	    break;
	case REAL:
	    retVal = NewReal(GetReal(obj));
	    retVal -> class = obj -> class;
	    break;
	case LIST:
	    ReportError("Clone", "can't clone type LIST!");
	    break;
	case PALETTE:
	    retVal = ClonePalette(obj);
	    retVal -> class = obj -> class;
	    break;
	case MATRIX:
	    ReportError("Clone", "can't clone type MATRIX!");
	    break;
	case WINDOW:
	    ReportError("Clone", "can't clone type WINDOW!");
	    break;
	case PICTURE:
	    ReportError("Clone", "can't clone type PICTURE!");
	    break;
	default:
	    ReportError("Clone", "unknown flag type!");
	    break;
    }
    if (retVal)
    {
	CloneVars(retVal, obj);
	CloneMethods(retVal, obj);
    }
    return retVal;
}

/* sets up objClass, the class to which all things belong */
void InitObjects()
{
#if 0
    /* note that NetworkStub and NetworkUpdated really have no class */
    NetworkStub = NewObject(0,0);
    NetworkStub -> flags = 0;	/* make sure nothing works on this thing. */
    AddToReferenceList(NetworkStub);
    NetworkUpdated = NewObject(0,0);
    NetworkUpdated -> flags = 0;
    AddToReferenceList(NetworkUpdated);
    NetworkWaiting = NewObject(0,0);
    NetworkWaiting -> flags = 0;
    AddToReferenceList(NetworkWaiting);
#endif

    objClass = NewObject(NULLOBJ, 0);
    AddToReferenceList(objClass);
    SetMethod(objClass, SETVAL, SetObjValue);
    SetMethod(objClass, GETVAL, GetObjValue);
    SetMethod(objClass, PICKUP, PickUpObject);

    ObjTrue = NewInt(1);
    AddToReferenceList(ObjTrue);

    stringClass = NewObject(NULLOBJ, 0);
    AddToReferenceList(stringClass);
    SetMethod(stringClass, CLEANUP, CleanupString);

    InitNetObjects();

    InitXYControls();
}

void KillObjects()
{
    KillXYControls();
    KillNetObjects();
    RemoveFromReferenceList(objClass);
    RemoveFromReferenceList(ObjTrue);
    TrashDay();
}

Bool SanityCheckObject(obj)
ObjPtr obj;
{
    Bool retVal = true;

    if (!obj) /* NULLOBJ is ok */
    {
	return true;
    }

    /* too bad there's no way to check for a segmentation fault. */
    if (OBJTYPE(obj->flags) < 0 || OBJTYPE(obj -> flags) > HIGHESTFLAG)
    {
	retVal = false;
	fprintf(stderr, "bad obj type %d\n", OBJTYPE(obj -> flags));
    }

    if (obj->flags & ~(OBJTYPEFLAGS | ISREMOTE | ISPUBLISHED | ISWAITING | ISREMOTEADVERTISED))
    {
	retVal = false;
	fprintf(stderr, "funny flags = 0x%lx\n", obj -> flags);
    }

    if (!retVal)
    {
	char str[100];

	sprintf(str, "Object failed Sanity Check! flags = %lx", obj->flags);
	ReportError("SanityCheckObject", str);
    }
    return retVal;
}
