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] |% !!!!!!