/*
* Tcl Handles --
*
* Handles in Tcl are commonly used as a small string that represents
* a larger set of data in a program. Tcl uses these for things like
* file handles, sockets and the like. Tk uses them for fonts, images
* and even widgets.
*
* Handles allow an extension to return a small string to the caller
* that is usually held in a variable for later use. File handles
* at the Tcl level look like 'file1'. All the caller need care about
* is that little string to get to their handle. Internally, that little
* 'file1' handle points to a much larger set of data.
*
* The standard method for handles in C extensions is to create a struct
* that defines the data for your handle that also contains some very
* basic information about the handle's origins and locations. When we
* create a new handle, we also store the string representation in a
* Tcl hash table so that we can look it up later if we're given just the
* handle string.
*
* Let's assume we are creating an extension called Foo. The main
* component in our extension that uses handles are Bars, and we are
* storing data from an external source (another library, perhaps).
* So, we need to create handler functions for Foo to create and use
* handles for Bars.
*
*/
/* Define a simple macro for getting our handles and returning
* an error if we don't find one. Foo_GetBar will set the error
* result in Tcl for us if we fail to find the handle.
*/
#define GETBAR( obj, ptr ) \
if( (ptr = Foo_GetBar( interp, obj )) == NULL ) return TCL_ERROR;
/* Define a new Tcl object type that we will use for our handles.
* We define our own object type because we want to store pointers
* to our information within it. This way, if our object shimmers
* to another object type (like a string or int), we will be able
* to recognize it and shimmer back.
*/
static Tcl_ObjType Foo_BarType = {
"foobar",
NULL,
NULL,
NULL,
NULL
};
/* Initialize two variables that we'll use to keep track of our
* handle counts. We increment the count variable everytime we
* create a new handle, so that we never re-use a handle name.
*
* The epoch variable is incremented anytime a handle is deleted.
* We increment the epoch because our handle can end up with many
* relationships that we don't keep track of. For example:
*
* set bar [create bar handle]
* set myBar $bar
*
* We now have two variables that point to our object. The problem
* occurs when we do this:
*
* delete bar $bar
*
* Now, myBar points to an object that still thinks it is a Bar handle,
* but we deleted the struct when we deleted the $bar handle. By tracking
* the epoch, we can tell that something has been deleted, and our data may
* no longer be valid. So, we're forced to go check the hash table for our
* data. If we don't find it, our handle was deleted, and we return with
* an error.
*
* All this basically means that you don't have to keep track of what people
* are doing with your handles. The code will simply take care of cleaning
* up useless objects as handles are deleted.
*/
static int barCount = 0;
static int barEpoch = 0;
/* Create our Tcl hash table to store our handle look-ups.
* We keep track of all of our handles in a hash table so that
* we can always go back to something and look up our data should
* we lose the pointer to our struct.
*/
static Tcl_HashTable bars;
/* Now, we want to define a struct that will hold our data. The first
* three fields are Tcl-related and make it really easy for us to circle
* back and find our related pieces.
*/
typedef struct Foo_Bar {
Tcl_Interp *interp; /* The Tcl interpreter where we were created. */
Tcl_Obj *objPtr; /* The object that contains our string rep. */
Tcl_HashEntry *hashPtr; /* The pointer to our entry in the hash table. */
Bar *bar; /* Our native data. */
} Foo_Bar;
/*
*----------------------------------------------------------------------
* Foo_NewBar --
*
* Create a new Bar object.
*
* Results:
* Returns a pointer to the new object or NULL if an error occurred.
*
* Side effects:
* Allocates enough memory to hold our structure and stores
* the new object in a hash table.
*
*----------------------------------------------------------------------
*/
static Foo_Bar *
Foo_NewBar( Tcl_Interp *interp, Bar *bar )
{
int new;
char handleName[16 + TCL_INTEGER_SPACE];
Tcl_Obj *handleObj;
Tcl_HashEntry *entryPtr;
Foo_Bar *barStruct;
/* Allocate enough memory for our struct. */
barStruct = (Foo_Bar *)ckalloc( sizeof(Foo_Bar) );
/* Create our handle string. */
sprintf( handleName, "bar%d", barCount++ );
/* Create our Tcl object and store pointers to our
information in the internalRep.
*/
handleObj = Tcl_NewStringObj( handleName, -1 );
handleObj->typePtr = &Foo_BarType;
handleObj->internalRep.twoPtrValue.ptr1 = barStruct;
handleObj->internalRep.twoPtrValue.ptr2 = (void *)barEpoch;
/* Setup our structure. */
barStruct->interp = interp;
barStruct->objPtr = handleObj;
barStruct->bar = bar;
/* Store our information in the hash table. */
entryPtr = Tcl_CreateHashEntry( &bars, handleName, &new );
Tcl_SetHashValue( entryPtr, barStruct );
/* Store a pointer to our hash entry. */
barStruct->hashPtr = entryPtr;
/* Set the Tcl object result so that our caller can just return
the new handle as the Tcl result.
*/
Tcl_SetObjResult( interp, handleObj );
/* Return a pointer to the new struct. */
return barStruct;
}
/*
*----------------------------------------------------------------------
* Foo_GetBar --
*
* Get a pointer to a Foo_Bar object.
*
* Results:
* Returns a pointer to the object.
*
* Side effects:
* None
*
*----------------------------------------------------------------------
*/
static Foo_Bar *
Foo_GetBar( Tcl_Interp *interp, Tcl_Obj *objPtr )
{
/* Check to see if this object is our type and has the
same epoch as the current epoch. If either of these
is false, we need to go out to the hash table to find
our data.
*/
if( objPtr->typePtr != &Foo_BarType
|| (int)objPtr->internalRep.twoPtrValue.ptr2 != barEpoch ) {
char *name;
Foo_Bar *bar;
Tcl_HashEntry *entryPtr;
name = Tcl_GetString( objPtr );
entryPtr = Tcl_FindHashEntry( &bars, name );
if( !entryPtr ) {
if( interp ) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid bar \"%s\"",
name));
}
return NULL;
}
if (objPtr->typePtr != &Foo_BarType
&& obj->typePtr && obj->typePtr->freeIntRepProc) {
obj->typePtr->freeIntRepProc (obj);
}
bar = Tcl_GetHashValue( entryPtr );
objPtr->typePtr = &Foo_BarType;
objPtr->internalRep.twoPtrValue.ptr1 = bar;
objPtr->internalRep.twoPtrValue.ptr2 = (void *)barEpoch;
}
return (Foo_Bar *)objPtr->internalRep.twoPtrValue.ptr1;
}
/*
*----------------------------------------------------------------------
* Foo_FreeBar --
*
* Free a Foo_Bar object and all of its related pieces.
*
* Results:
* Returns TCL_OK on success or TCL_ERROR on failure.
*
* Side effects:
* Frees all the memory associated with the object as well
* as delete the entry from the hash table.
*
*----------------------------------------------------------------------
*/
int
Foo_FreeBar( Tcl_Interp *interp, Foo_Bar *bar )
{
/* Free up the native data. */
FreeBarFunction( bar->bar );
/* Delete our entry from the hash table. */
Tcl_DeleteHashEntry( bar->hashPtr );
/* Free the memory we allocated for the struct. */
ckfree( (char *)bar );
/* Increment the epoch. */
barEpoch++;
return TCL_OK;
}
/*
*----------------------------------------------------------------------
* Foo_Init --
*
* Initialize the Foo extension.
*
* Results:
* Returns TCL_OK on success or TCL_ERROR on failure.
*
* Side effects:
* None
*
*----------------------------------------------------------------------
*/
static int
Foo_Init( Tcl_Interp *interp )
{
/* Initialize our hash table. */
Tcl_InitHashTable( &bars, TCL_STRING_KEYS );
/* The rest of the initialization for our extension would go here. */
}Notice that the Foo_BarType record uses NULL for all the methods. There's no freeIntRepProc, since freeing the internal rep is a no-op -- deleting a Tcl_Obj * that points to a Bar doesn't delete the Bar, only the reference to the Bar. There's no updateStringProc because every object of this type always has a string rep. There's no setFromAnyProc because we never call Tcl_ConvertToType with typePtr = Foo_BarType -- and nobody else can either, since Foo_BarType is static and we never register it with Tcl_RegisterObjType. And there's no dupIntRepProc because Tcl's default implementation (a bitwise copy of objPtr->internalRep) does the right thing for this object type.So the only thing the Foo_BarType record is used for is to identify whether or not a Tcl_Obj * is one of "our" Tcl_Objs.
George Peter Staplin May 18, 2005 - I suggest that you check the result of new when creating the hash entry, because integer overflow could occur and result in clobbering an existing object. A better behavior is to repeat the key/handle creation (with an increment of barCount) until new is true. The barCount overflow would be an issue in applications that create many handles, or run for long periods of time.Thanks for sharing this code. I found it useful. :)
Q: What the heck is this epoch stuff and do I really need it?A: Primarily a mechanism for keeping track of whether cached data is still valid, or might need to be looked up again. You can do without it if you in Foo_GetBar always take the long route (calling Tcl_FindHashEntry etc.).Thank you. I will do without it because I simply can't grok all this. Does anyone have a simple example that uses handle0, handle1, and has a structure that keeps track of application specific pointers?
George Peter Staplin 2007.09.21 I believe this code has a leak. I originally used it as an example. I found that this pattern was needed to fully eliminate leaks:
(void)Tcl_GetString (obj);
if (obj->typePtr && obj->typePtr->freeIntRepProc) {
obj->typePtr->freeIntRepProc (obj);
}
/* Now you can safely replace the Tcl_ObjType pointer */nodk 2013-08-24: where exactly does this patch apply? I can't figure this out.2007-09-21 VI Adding another field and a subtype table will allow for storing void * pointers with a subtype. On the extract the subtype can be checked before converting back. See the tcl plugin in pidgin (tcl_ref.c) for an idea of what I'm talking about
RLE (2013-08-24): See Handles as commands
for an alternate method of tracking handles.