inline char *
Memcpy(char *dst, char *src, size_t length)
{
  if (dst == NULL) {
    dst = (char *) ckalloc(length);
  }
  memcpy(dst, src, length);
  return dst;
}

inline void     stateInitialiseHash(Tcl_HashTable *);
inline Tcl_Obj *stateBless(Tcl_Obj *, Tcl_HashTable *);
inline Tcl_Obj *stateGet(Tcl_Interp *, Tcl_Obj *);
inline void     stateInvalidate(Tcl_HashTable *);

/* Blessed (semi-auto cleaned) simulator state references */
 
static int  stateSet(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void statePrint(Tcl_Obj *objPtr);
static void stateDup(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr);
static void stateFree(Tcl_Obj *objPtr);
static struct Tcl_ObjType stateType = {
   "Cleaned Reference",
   stateFree, stateDup, statePrint, stateSet
};
 
static int
stateSet(
      Tcl_Interp *interp,
      Tcl_Obj *objPtr)
{
   if (interp) {
     Tcl_AppendResult(interp, "cannot (re)build object of type \"",
                      stateType.name, "\"", NULL);
   }
   return TCL_ERROR;
}
 
static void
statePrint(
      Tcl_Obj *objPtr)
{
   Tcl_Obj *contents = objPtr->internalRep.twoPtrValue.ptr1;
   char *bytes = Tcl_GetStringFromObj(contents, &objPtr->length);
 
   objPtr->bytes = Memcpy(NULL, bytes, objPtr->length+1);
}
 
static void
stateDup(
     Tcl_Obj *srcPtr,
     Tcl_Obj *dupPtr)
{
   Tcl_Obj *contents = srcPtr->internalRep.twoPtrValue.ptr1;
   Tcl_HashTable *hash = srcPtr->internalRep.twoPtrValue.ptr2;
   Tcl_HashEntry *hent;
   int isNew;
 
   dupPtr->internalRep.twoPtrValue.ptr1 = contents;
   dupPtr->internalRep.twoPtrValue.ptr2 = hash;
   dupPtr->typePtr = &stateType;
   Tcl_IncrRefCount(contents);
   hent = Tcl_CreateHashEntry(hash, (char *)dupPtr, &isNew);
   if (hent) {
     Tcl_SetHashValue(hent, dupPtr);
   }
}
 
static void
stateFree(
      Tcl_Obj *objPtr)
{
   Tcl_Obj *contents =   objPtr->internalRep.twoPtrValue.ptr1;
   Tcl_HashTable *hash = objPtr->internalRep.twoPtrValue.ptr2;
   Tcl_HashEntry *hent;
 
   Tcl_DecrRefCount(contents);
   hent = Tcl_FindHashEntry(hash, (char *)objPtr);
   if (hent) {
     Tcl_DeleteHashEntry(hent);
   }
}
 
/* Invalidate all state-reference objects referred to in the given
 * hash table, nuking the hash at the same time. */
inline void
stateInvalidate(
      Tcl_HashTable *hash)
{
   Tcl_HashSearch hsearch;
   Tcl_HashEntry *hent;
 
   hent = Tcl_FirstHashEntry(hash, &hsearch);
   for (; hent ; hent=Tcl_NextHashEntry(&hsearch)) {
     Tcl_Obj *objPtr = Tcl_GetHashValue(hent);
     Tcl_Obj *contents = objPtr->internalRep.twoPtrValue.ptr1;
 
     if (!objPtr->bytes) {
       /* Make sure that there is still something there for users to see */
       statePrint(objPtr);
     }
 
     /* Delete the contents - this is the crucial bit */
     Tcl_DecrRefCount(contents);
 
     /* Mark the object as untyped */
     objPtr->typePtr = NULL;
   }
   Tcl_DeleteHashTable(hash);
}
 
/* Given a state object (AKA a complex list thingy) make it into a
 * blessed state-reference which ensures that it will be invalidated
 * at the correct time. */
inline Tcl_Obj *
stateBless(
      Tcl_Obj *stateObject,
      Tcl_HashTable *hash)
{
   Tcl_Obj *newObj = Tcl_NewObj();
   Tcl_HashEntry *hent;
   int isNew;
 
   /* Get rid of anything present by default in new objects */
   if (newObj->bytes) {
     Tcl_InvalidateStringRep(newObj);
   }
 
   /* Make the internal representation */
   newObj->typePtr = &stateType;
   newObj->internalRep.twoPtrValue.ptr1 = stateObject;
   Tcl_IncrRefCount(stateObject);
   newObj->internalRep.twoPtrValue.ptr2 = hash;
 
   /* Store a reference to the object in the hash */
   hent = Tcl_CreateHashEntry(hash, (char *)newObj, &isNew);
   if (hent) {
     Tcl_SetHashValue(hent, newObj);
   }
 
   return newObj;
}
 
/* Set up the state-reference hash table */
inline void
stateInitialiseHash(
      Tcl_HashTable *hash)
{
   Tcl_InitHashTable(hash, TCL_ONE_WORD_KEYS);
}
 
/* Get a state reference, but only if it is blessed.  Error otherwise */
inline Tcl_Obj *
stateGet(
      Tcl_Interp *interp,
      Tcl_Obj *objPtr)
{
   if (objPtr->typePtr != &stateType &&
       Tcl_ConvertToType(interp, objPtr, &stateType) != TCL_OK) {
     return NULL;
   }
   return objPtr->internalRep.twoPtrValue.ptr1;
}