Purpose: To begin to cover the topic of how to pass C, C++, or other language 'pointers' around in Tcl.
In general, Tcl doesn't expose pointers to the user. Instead, the model that Tcl uses is that of a handle. A handle is a synthetic string value, generated in some manner by Tcl, and which is used to represent the actual pointer.
One example of such a pointer in Tcl is the value returned by the Tcl open command. The string returned begins with the value "file" followed by a number. Tcl maps this string internally to an open file pointer when it is time for the interpreter to do some file I/O against that particular file.
So, how could you go about creating a similar mapping? One easy way would be to use the Extended Tcl (aka TclX) Tcl_HandleAlloc family of functions, designed to create, manipulate, and free such handles.
If however, you are unable or uninterested in making use of this code, you would need to implement similar functionality. The functionality, written likely in the language in which the pointers are being created, would need to:
Other functions may be necessary, depending on your application and the design of your table.
LV March 27, 2003
A recent set of emails I was in covered the question of whether there was a simple interface to memcpy that the developer could use. After some digging, the context turned out to be that the developer had some handles to large data, and wanted a fast way to copy the data from a src handle to a dest handle. They just were looking at creating a memcpy type command for tcl.
KBK (7 December 2000) -
My dissenting view is that the 'object-oriented' noun verb syntax is almost always preferable. The idea here is to use the Tcl command table to hold your handles. This is the way that Tk widgets work. John once told me (in a Vietnamese restaurant, if I remember correctly) that if he had it to do over again, he'd have done the Tcl commands that work on channels this way.
You need the following:
(1) A Tcl command that creates the structure in question, or at least adds it to the Tcl namespace. This command winds up being invoked with something like foo create bar. Internally, it does:
struct foo *grill;
/* ... whatever is needed to make a 'struct foo' */
Tcl_Command token
= Tcl_CreateObjCommand( interp,
Tcl_GetStringFromObj( objv[ 2 ], NULL ),
Foo_ObjCommand,
(ClientData) grill,
Foo_DeleteCommand );
/* See section (4) below for what happens with 'token' */
Tcl_SetObjResult( interp, objv[ 2 ] );
return TCL_OK;(2) A Tcl command that manipulates the structure in question. It looks like
static int
Foo_ObjCommand( ClientData clientData, /* Opaque pointer to 'foo' */
Tcl_Interp* interp, /* Tcl interpreter */
int objc, /* Parameter count */
Tcl_Obj *CONST *objv ) /* Parameter vector */
{
/* Recover the pointer to the structure */
struct foo* bar = (struct foo*) clientData;
if ( objv < 2 ) {
Tcl_WrongNumArgs( interp, 1, objv, "command args..." );
return TCL_ERROR;
}
/* The next step is usually to interpret objv[ 1 ] by means */
/* of Tcl_GetIndexFromObj. This allows a syntax like */
/* 'bar set keyword ?value?' */
/* 'bar configure -keyword value...' */
/* or whatever you like. */
/* And eventually... */
return TCL_OK;
}(3) A Tcl destructor. It looks like:
static int
Foo_DeleteCommand( ClientData clientData ) /* Opaque pointer to 'foo' */
{
struct foo* bar = (struct foo*) clientData;
/* ... Whatever is needed to clean up a foo ... */
ckfree( bar );
}(4) If you need to be able to delete the object from C as well as from Tcl, then you need to get rid of its command, including tracking things like 'interp alias' and 'rename'. Fortunately, Tcl gives you the ability to do this. What you need to do is to stash somewhere an association between the (struct foo*) and the Tcl_Command token that was returned from the Tcl_CreateCommand. It's a common practice to do this by stashing the command info in the structure itself. When you delete the structure from C, you use Tcl_DeleteCommandFromToken to get rid of the command that refers to it.
(5) It's possible to pass these commands around as parameters to other commands. You accept the command name as a parameter, and do something like the following to typecheck it:
Tcl_CmdInfo info;
char* fooName = Tcl_GetStringFromObj( objv[ k ] );
struct foo* otherFoo;
if (! Tcl_GetCommandInfo( interp, fooName, &info ) ) {
Tcl_AppendStringsToObj( Tcl_GetObjResult( interp ),
fooName,
" not found",
(char*) NULL );
return TCL_ERROR;
}
if ( info.objProc != Foo_ObjCommand ) {
Tcl_AppendStringsToObj( Tcl_GetObjResult( interp ),
fooName,
" is not a foo",
(char*) NULL );
return TCL_ERROR;
}
otherFoo = (struct foo*) info.clientData;(6) If the 'foo' structure embeds other pointers, the problem of representing them in Tcl arises. I've had considerable success by using a syntax like:
foo with fieldName commandName ?fieldName commandName...? {
# ... script
}What this does is install an object command for each of the named fields of 'foo' using the command name specified on the command line. It then evaluates the script, which can use these object commands to manipulate the targets of the pointers. Finally, after evaluating the script, it deletes the object commands that it just temporarily installed. An example: I have a 'Message' object that contains 'evt', a pointer to an 'Event' object, one of whose fields is 'id'. I can say:
myMessage with evt myEvent {
puts "the event id is [myEvent set id]"
}
# ... at this point, the myEvent command has been deleted again.You can make this as recursive as you like.
APN The code below is not safe if used from interps in multiple threads. The globals need to made interp- or thread-specific variables.
From: "Donal K. Fellows" <[email protected]> Date: Tue, 23 Jan 2001 11:39:07 +0000 Subject: Re: TCL to C extension Message-ID: <[email protected]>
Scott Pitcher wrote:
> When I need to pass a complex type between C and TCL, I tend to use an > opaque handle. This can be as simple as a unique integer that references > a C structure (for example). If you really need to pass complex types > back and forward, you should probably use a TCL list. You could pass a > reference to the list object to the C function. This gets a little > complex though, and you would probably need to consider the application > in mind before trying it.
In fact, it is very easy to perform management of opaque handles using Tcl's C library. Here's some code (altered from original news posting - DKF) to dress up the whole process:
/*
* A few words on the objects managed through this scheme.
* The internalRep uses a two-word value, consisting of the pointer
* being passed about, and an "epoch counter" value which is used
* to allow safe bypassing of a hashtable lookup.
*
* The ObjType for the objects being managed should be declared as:
*
* Tcl_ObjType foobartype = {
* "foobar",
* NULL, DupPointerObj, UpdatePointerObj, SetPointerObjType
* };
*
* This is because you need to supply a type name, duplication and
* update are best performed as described below, and setting the type
* requires access to the type being set from (though in this last
* case you can write your own type-specific code that calls
* GetPointerForObj to do the work; it isn't possible to make that
* generic though..)
*
* You should keep type names fairly short - no more than around 200
* characters - and shorter ones are better for lookup performance...
*/
#include <tcl.h>
struct PointerAssoc {
Tcl_Obj *obj;
void *ptr;
};
static int epochCounter = 0; /* counts deletion events */
static int allocatedFlag = 0; /* says whether an allocation has
* happened
* since the last deletion, so several
* consecutive deletions can only cause a
* single stepping of the epoch - matters
* in very long-lived applications */
#define TEMPBUFSIZE 256 /* usually enough space! */
void
DupPointerObj(
Tcl_Obj *srcObj,
Tcl_Obj *dupObj)
{
dupObj->typePtr = srcObj->typePtr;
dupObj->internalRep = srcObj->internalRep;
}
void
UpdatePointerObj(
Tcl_Obj *objPtr)
{
char buf[TEMPBUFSIZE];
sprintf(buf, "%s%p", objPtr->typePtr->name,
objPtr->internalRep.twoPtrValue.ptr1);
objPtr->length = strlen(buf);
objPtr->bytes = ckalloc(objPtr->length+1);
memcpy(objPtr->bytes, buf, objPtr->length+1);
}
int
SetPointerObjType(
Tcl_Interp *interp,
Tcl_Obj *objPtr)
{
Tcl_AppendResult(interp, "operation not supported", NULL);
return TCL_ERROR;
}
Tcl_Obj *
GetObjForPointer(
Tcl_HashTable *tablePtr,
Tcl_ObjType *typePtr,
void *pointer)
{
char buf[TEMPBUFSIZE];
struct PointerAssoc *assoc;
Tcl_HashEntry *hent;
Tcl_Obj *obj;
int isNew;
sprintf(buf, "%s%p", typePtr->name, pointer);
hent = Tcl_CreateHashEntry(tablePtr, buf, &isNew);
if (!isNew) {
assoc = Tcl_GetHashValue(hent);
return assoc->obj;
}
obj = Tcl_NewStringObj(buf, -1);
obj->typePtr = typePtr;
obj->internalRep.twoPtrValue.ptr1 = pointer;
obj->internalRep.twoPtrValue.ptr2 = INT2PTR(epochCounter);
Tcl_IncrRefCount(obj);
assoc = (struct PointerAssoc *) ckalloc(sizeof(struct PointerAssoc));
assoc->obj = obj;
assoc->ptr = pointer;
Tcl_SetHashValue(hent, assoc);
allocatedFlag = 1;
return obj;
}
int
GetPointerForObj(
Tcl_Interp *interp,
Tcl_HashTable *tablePtr,
Tcl_ObjType *typePtr,
Tcl_Obj *objPtr,
void **pointerPtr)
{
char *name;
Tcl_HashEntry *hent;
if (objPtr->typePtr == typePtr &&
PTR2INT(objPtr->internalRep.twoPtrValue.ptr2) == epochCounter) {
*pointerPtr = objPtr->internalRep.twoPtrValue.ptr1;
return TCL_OK;
}
name = Tcl_GetStringFromObj(objPtr, NULL);
hent = Tcl_FindHashEntry(tablePtr, name);
if (hent == NULL) {
Tcl_AppendResult(interp, "unknown ", typePtr->name,
" \"", name, "\"", NULL);
return TCL_ERROR;
}
if (objPtr->typePtr == typePtr) {
*pointerPtr = objPtr->internalRep.twoPtrValue.ptr1;
} else {
struct PointerAssoc *assoc = Tcl_GetHashValue(hent);
*pointerPtr = assoc->ptr;
if (objPtr->typePtr != NULL &&
objPtr->typePtr->freeIntRepProc != NULL) {
objPtr->typePtr->freeIntRepProc(objPtr);
}
objPtr->typePtr = typePtr;
objPtr->internalRep.twoPtrValue.ptr1 = assoc->ptr;
}
objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(epochCounter);
allocatedFlag = 1;
return TCL_OK;
}
int /* non-zero if anything released */
ReleasePointerObj(
Tcl_HashTable *tablePtr,
Tcl_ObjType *typePtr,
void *pointer)
{
char buf[TEMPBUFSIZE];
struct PointerAssoc *assoc;
Tcl_HashEntry *hent;
sprintf(buf, "%s%p", typePtr->name, pointer);
hent = Tcl_FindHashEntry(tablePtr, buf);
if (hent == NULL) return 0;
assoc = Tcl_GetHashValue(hent);
Tcl_DecrRefCount(assoc->obj);
ckfree(assoc);
Tcl_DeleteHashEntry(hent);
if (allocatedFlag) epochCounter++;
allocatedFlag = 0;
return 1;
}
void
ReleaseAllPointerObjs(
Tcl_HashTable *tablePtr)
{
Tcl_HashEntry *hent;
Tcl_HashSearch search;
struct PointerAssoc *assoc;
hent = Tcl_FirstHashEntry(tablePtr, &search);
if (hent != NULL) {
if (allocatedFlag) epochCounter++;
allocatedFlag = 0;
}
while (hent != NULL) {
assoc = Tcl_GetHashValue(hent);
Tcl_DecrRefCount(assoc->obj);
ckfree(assoc);
Tcl_DeleteHashEntry(hent);
hent = Tcl_NextHashEntry(&search);
}
}