Version 4 of Blessed Tcl_Obj Values

Updated 2008-10-29 10:51:34 by dkf

A blessing mechanism that allows complex structs with raw pointers to be easily encoded into Tcl (I usually use lists) without the overhead of convering them all into opaque pointers. At its most useful when you want to examine part of the state too...


 /* Start with some defines and funcs that are actually elsewhere in my
  * code, and are carefully tuned to different compiler whims. However,
  * the gist of them is easy to comprehend...
  */
 #define INLINE inline
 #define LOCAL  static
 extern char *Memcpy(char *dst, char *src, size_t length);
 /* Note that I allocate when dst==NULL.  Easier that way... */

 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 */
 
 LOCAL int  stateSet(Tcl_Interp *interp, Tcl_Obj *objPtr);
 LOCAL void statePrint(Tcl_Obj *objPtr);
 LOCAL void stateDup(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr);
 LOCAL void stateFree(Tcl_Obj *objPtr);
 static struct Tcl_ObjType stateType = {
   "Cleaned Reference",
   stateFree, stateDup, statePrint, stateSet
 };
 
 LOCAL 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;
 }
 
 LOCAL 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);
 }
 
 LOCAL 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);
   }
 }
 
 LOCAL 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;
 }

 /* There is also a Tcl_RegisterObjType(&stateType); to be done sometime... */

Still to come; the explanation for all this!

DKF


tcl_obj