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] ---- !!!!!! %| [Category Discussion] |% !!!!!!