Version 1 of Blessed Tcl_Obj Values

Updated 2008-06-24 19:13:44 by LV

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 _ANSI_ARGS_((char *dst, char *src, size_t length));
 /* Note that I allocate when dst==NULL.  Easier that way... */

 INLINE VOID     stateInitialiseHash _ANSI_ARGS_((Tcl_HashTable *));
 INLINE Tcl_Obj *stateBless          _ANSI_ARGS_((Tcl_Obj *, Tcl_HashTable *));
 INLINE Tcl_Obj *stateGet            _ANSI_ARGS_((Tcl_Interp *, Tcl_Obj *));
 INLINE VOID     stateInvalidate     _ANSI_ARGS_((Tcl_HashTable *));

 /* Blessed (semi-auto cleaned) simulator state references */

 LOCAL int  stateSet   _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr));
 LOCAL VOID statePrint _ANSI_ARGS_((Tcl_Obj *objPtr));
 LOCAL VOID stateDup   _ANSI_ARGS_((Tcl_Obj *srcPtr, Tcl_Obj *dupPtr));
 LOCAL VOID stateFree  _ANSI_ARGS_((Tcl_Obj *objPtr));
 static struct Tcl_ObjType stateType = {
   "Cleaned Reference",
   stateFree, stateDup, statePrint, stateSet
 };

 LOCAL int
 stateSet(interp, objPtr)
      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(objPtr)
      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(srcPtr, dupPtr)
     Tcl_Obj *srcPtr, *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(objPtr)
      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(hash)
      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(stateObject, hash)
      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(hash)
      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(interp, objPtr)
      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


!!!!!!!

Category Discussion