Skip to content

Commit 4e5bc76

Browse files
committed
Add assoc data storage (thanks, Emiliano !)
1 parent d9e6a4f commit 4e5bc76

File tree

1 file changed

+109
-38
lines changed

1 file changed

+109
-38
lines changed

generic/tclsample.c

Lines changed: 109 additions & 38 deletions
Original file line numberDiff line numberDiff line change
@@ -28,33 +28,40 @@
2828
static const unsigned char itoa64f[] =
2929
"0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_,";
3030

31+
#define DIGESTSIZE 20
32+
3133
/*
32-
* Create struct with thread local data.
33-
* This mechanism is called "clientData" in Tcl.
34-
* We use two of them. One for the sha1 command which holds the context queue.
35-
* Another for the init command to store the command tolkens to delete them on
36-
* unload.
34+
* The procedure needs interpreter local state. This is called
35+
* "Command client data" in TCL. Typically, a struct is allocated and
36+
* the pointer to it is made available on each operation by TCL.
37+
* Here is the struct for the sha1 procedure.
3738
*/
3839

3940
struct Sha1ClientData {
40-
/* State of sha1 command */
4141
int numcontexts;
4242
SHA1_CTX *sha1Contexts;
4343
Tcl_Size *ctxtotalRead;
4444
};
4545

46-
struct CmdClientData {
47-
/* Tokens of the created commands to delete them on unload */
46+
/*
47+
* The DLL needs interpreter local storage to get the command tolkens to the
48+
* DLL unload procedure.
49+
* This is a pointer to the following struct.
50+
* This memory is called assoc data and has a name for identification.
51+
*/
52+
53+
struct DllAssocData {
4854
Tcl_Command sha1CmdTolken;
4955
Tcl_Command buildInfoCmdTolken;
5056
};
5157

52-
/* Prototype of the function executed by command "sha1" */
58+
/*
59+
* The name of the assoc data. This should be unique over packages and is
60+
* typically the module prefix of the package.
61+
*/
5362

54-
static int Sha1_Cmd(void *clientData, Tcl_Interp *interp,
55-
int objc, Tcl_Obj *const objv[]);
63+
#define ASSOC_DATA_KEY "sha1"
5664

57-
#define DIGESTSIZE 20
5865

5966
/*
6067
*----------------------------------------------------------------------
@@ -395,6 +402,66 @@ Sha1_CmdDeleteProc(ClientData clientData)
395402
ckfree(sha1ClientDataPtr);
396403
}
397404

405+
406+
/*
407+
*----------------------------------------------------------------------
408+
*
409+
* removeCommands --
410+
*
411+
* remove the created commands and free assoc data
412+
*
413+
* Results:
414+
* None
415+
*
416+
* Side effects:
417+
* None
418+
*
419+
*----------------------------------------------------------------------
420+
*/
421+
422+
void
423+
removeCommands(
424+
struct DllAssocData *dllAssocDataPtr,
425+
Tcl_Interp *interp)
426+
{
427+
428+
/* Remove the sha1 command */
429+
Tcl_DeleteCommandFromToken(interp, dllAssocDataPtr->sha1CmdTolken);
430+
431+
/* if created, also remove the build-info command */
432+
if (NULL != dllAssocDataPtr->buildInfoCmdTolken) {
433+
Tcl_DeleteCommandFromToken(interp, dllAssocDataPtr->buildInfoCmdTolken);
434+
}
435+
436+
/* free the client data */
437+
ckfree(dllAssocDataPtr);
438+
}
439+
440+
441+
/*
442+
*----------------------------------------------------------------------
443+
*
444+
* pkgInterpDeleted --
445+
*
446+
* Clean-up on interpreter deletion.
447+
*
448+
* Results:
449+
* None
450+
*
451+
* Side effects:
452+
* Library is unloaded.
453+
*
454+
*----------------------------------------------------------------------
455+
*/
456+
457+
static void
458+
pkgInterpDeleted (
459+
ClientData clientData,
460+
Tcl_Interp *interp)
461+
{
462+
/* remove the commands and clear the associated data */
463+
removeCommands(clientData, interp);
464+
}
398465

399466
/*
400467
*----------------------------------------------------------------------
@@ -428,7 +495,7 @@ Sample_Init(
428495
Tcl_Interp* interp) /* Tcl interpreter */
429496
{
430497
Tcl_CmdInfo info;
431-
struct CmdClientData *cmdClientDataPtr;
498+
struct DllAssocData *dllAssocDataPtr;
432499
struct Sha1ClientData *sha1ClientDataPtr;
433500

434501
/*
@@ -440,32 +507,35 @@ Sample_Init(
440507
* Note that Tcl_InitStubs is a macro, which is replaced by a Tcl version
441508
* check only, if TCL_STUBS is not defined (e.g. direct link, static build)
442509
*/
510+
443511
if (Tcl_InitStubs(interp, "8.1-", 0) == NULL) {
444512
return TCL_ERROR;
445513
}
446514

447515
/*
448-
* Create and init my client data
516+
* Create my DLL associated data and register it to the interpreter
449517
*/
450-
cmdClientDataPtr = ckalloc(sizeof(struct Sha1ClientData));
451-
cmdClientDataPtr->sha1CmdTolken = NULL;
452-
cmdClientDataPtr->buildInfoCmdTolken = NULL;
518+
519+
dllAssocDataPtr = ckalloc(sizeof(struct DllAssocData));
520+
Tcl_SetAssocData(interp, ASSOC_DATA_KEY, pkgInterpDeleted, dllAssocDataPtr);
453521

454522
/*
455523
* Init the sha1 context queues
456524
*/
525+
457526
sha1ClientDataPtr = ckalloc(sizeof(struct Sha1ClientData));
458527
sha1ClientDataPtr->numcontexts = 1;
459528
sha1ClientDataPtr->sha1Contexts = (SHA1_CTX *) ckalloc(sizeof(SHA1_CTX));
460529
sha1ClientDataPtr->ctxtotalRead = (Tcl_Size *) ckalloc(sizeof(Tcl_Size));
461530

462531
/*
463532
* Create the sha1 command.
464-
* Pass the client data pointer to the procedure, so the que data is available.
533+
* Pass the client data pointer to the procedure, so the queue data is
534+
* available.
465535
* Also, register a delete proc to clear the sha1 queue on deletion.
466536
*/
467537

468-
cmdClientDataPtr->sha1CmdTolken = Tcl_CreateObjCommand(
538+
dllAssocDataPtr->sha1CmdTolken = Tcl_CreateObjCommand(
469539
interp, "sha1", (Tcl_ObjCmdProc *)Sha1_Cmd,
470540
sha1ClientDataPtr, Sha1_CmdDeleteProc);
471541

@@ -474,7 +544,7 @@ Sample_Init(
474544
*/
475545

476546
if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {
477-
cmdClientDataPtr->buildInfoCmdTolken = Tcl_CreateObjCommand(
547+
dllAssocDataPtr->buildInfoCmdTolken = Tcl_CreateObjCommand(
478548
interp,
479549
"::sample::build-info",
480550
info.objProc, (void *)(
@@ -531,17 +601,14 @@ Sample_Init(
531601
#endif
532602
), NULL);
533603
} else {
604+
534605
/*
535-
* No build-info command created. Save a NULL tolken.
606+
* No build-info command created. Save a NULL command tolken.
536607
*/
537-
cmdClientDataPtr->buildInfoCmdTolken = NULL;
608+
609+
dllAssocDataPtr->buildInfoCmdTolken = NULL;
538610
}
539611

540-
/*
541-
* FIXME: Now I have to beam cmdClientDataPtr to the unload procedure below.
542-
* I have no idea, how to do that. Thanks for any help.
543-
*/
544-
545612
/* Provide the current package */
546613

547614
if (Tcl_PkgProvideEx(interp, PACKAGE_NAME, PACKAGE_VERSION, NULL) != TCL_OK) {
@@ -581,21 +648,25 @@ Sample_Unload(
581648
Tcl_Interp* interp, /* Tcl interpreter */
582649
int flags) /* interpreter or process detach */
583650
{
651+
struct DllAssocData *dllAssocDataPtr;
584652

585-
/* CLient data of the DLL */
586-
/* FIXME: this has to be beamed from the init procedure to this procedure */
587-
struct CmdClientData *cmdClientDataPtr = NULL;
653+
/*
654+
* Get the command tolkens from the assoc data and check, if present.
655+
* Delete it directly, so no action will happen on interpreter deletion.
656+
*/
657+
658+
dllAssocDataPtr = Tcl_GetAssocData(interp, ASSOC_DATA_KEY, NULL);
659+
if (NULL == dllAssocDataPtr) {
660+
return TCL_OK;
661+
}
662+
Tcl_DeleteAssocData(interp, ASSOC_DATA_KEY);
588663

589-
/* Remove the sha1 command */
590-
Tcl_DeleteCommandFromToken(interp, cmdClientDataPtr->sha1CmdTolken);
664+
/*
665+
* Now, remove the commands and free the assoc data memory
666+
*/
591667

592-
/* if created, also remove the build-info command */
593-
if (NULL != cmdClientDataPtr->buildInfoCmdTolken) {
594-
Tcl_DeleteCommandFromToken(interp, cmdClientDataPtr->buildInfoCmdTolken);
595-
}
668+
removeCommands(dllAssocDataPtr, interp);
596669

597-
/* free the client data */
598-
ckfree(cmdClientDataPtr);
599670
return TCL_OK;
600671
}
601672
#ifdef __cplusplus

0 commit comments

Comments
 (0)