28
28
static const unsigned char itoa64f [] =
29
29
"0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_," ;
30
30
31
+ #define DIGESTSIZE 20
32
+
31
33
/*
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.
37
38
*/
38
39
39
40
struct Sha1ClientData {
40
- /* State of sha1 command */
41
41
int numcontexts ;
42
42
SHA1_CTX * sha1Contexts ;
43
43
Tcl_Size * ctxtotalRead ;
44
44
};
45
45
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 {
48
54
Tcl_Command sha1CmdTolken ;
49
55
Tcl_Command buildInfoCmdTolken ;
50
56
};
51
57
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
+ */
53
62
54
- static int Sha1_Cmd (void * clientData , Tcl_Interp * interp ,
55
- int objc , Tcl_Obj * const objv []);
63
+ #define ASSOC_DATA_KEY "sha1"
56
64
57
- #define DIGESTSIZE 20
58
65
59
66
/*
60
67
*----------------------------------------------------------------------
@@ -395,6 +402,66 @@ Sha1_CmdDeleteProc(ClientData clientData)
395
402
ckfree (sha1ClientDataPtr );
396
403
}
397
404
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
+ }
398
465
399
466
/*
400
467
*----------------------------------------------------------------------
@@ -428,7 +495,7 @@ Sample_Init(
428
495
Tcl_Interp * interp ) /* Tcl interpreter */
429
496
{
430
497
Tcl_CmdInfo info ;
431
- struct CmdClientData * cmdClientDataPtr ;
498
+ struct DllAssocData * dllAssocDataPtr ;
432
499
struct Sha1ClientData * sha1ClientDataPtr ;
433
500
434
501
/*
@@ -440,32 +507,35 @@ Sample_Init(
440
507
* Note that Tcl_InitStubs is a macro, which is replaced by a Tcl version
441
508
* check only, if TCL_STUBS is not defined (e.g. direct link, static build)
442
509
*/
510
+
443
511
if (Tcl_InitStubs (interp , "8.1-" , 0 ) == NULL ) {
444
512
return TCL_ERROR ;
445
513
}
446
514
447
515
/*
448
- * Create and init my client data
516
+ * Create my DLL associated data and register it to the interpreter
449
517
*/
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 );
453
521
454
522
/*
455
523
* Init the sha1 context queues
456
524
*/
525
+
457
526
sha1ClientDataPtr = ckalloc (sizeof (struct Sha1ClientData ));
458
527
sha1ClientDataPtr -> numcontexts = 1 ;
459
528
sha1ClientDataPtr -> sha1Contexts = (SHA1_CTX * ) ckalloc (sizeof (SHA1_CTX ));
460
529
sha1ClientDataPtr -> ctxtotalRead = (Tcl_Size * ) ckalloc (sizeof (Tcl_Size ));
461
530
462
531
/*
463
532
* 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.
465
535
* Also, register a delete proc to clear the sha1 queue on deletion.
466
536
*/
467
537
468
- cmdClientDataPtr -> sha1CmdTolken = Tcl_CreateObjCommand (
538
+ dllAssocDataPtr -> sha1CmdTolken = Tcl_CreateObjCommand (
469
539
interp , "sha1" , (Tcl_ObjCmdProc * )Sha1_Cmd ,
470
540
sha1ClientDataPtr , Sha1_CmdDeleteProc );
471
541
@@ -474,7 +544,7 @@ Sample_Init(
474
544
*/
475
545
476
546
if (Tcl_GetCommandInfo (interp , "::tcl::build-info" , & info )) {
477
- cmdClientDataPtr -> buildInfoCmdTolken = Tcl_CreateObjCommand (
547
+ dllAssocDataPtr -> buildInfoCmdTolken = Tcl_CreateObjCommand (
478
548
interp ,
479
549
"::sample::build-info" ,
480
550
info .objProc , (void * )(
@@ -531,17 +601,14 @@ Sample_Init(
531
601
#endif
532
602
), NULL );
533
603
} else {
604
+
534
605
/*
535
- * No build-info command created. Save a NULL tolken.
606
+ * No build-info command created. Save a NULL command tolken.
536
607
*/
537
- cmdClientDataPtr -> buildInfoCmdTolken = NULL ;
608
+
609
+ dllAssocDataPtr -> buildInfoCmdTolken = NULL ;
538
610
}
539
611
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
-
545
612
/* Provide the current package */
546
613
547
614
if (Tcl_PkgProvideEx (interp , PACKAGE_NAME , PACKAGE_VERSION , NULL ) != TCL_OK ) {
@@ -581,21 +648,25 @@ Sample_Unload(
581
648
Tcl_Interp * interp , /* Tcl interpreter */
582
649
int flags ) /* interpreter or process detach */
583
650
{
651
+ struct DllAssocData * dllAssocDataPtr ;
584
652
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 );
588
663
589
- /* Remove the sha1 command */
590
- Tcl_DeleteCommandFromToken (interp , cmdClientDataPtr -> sha1CmdTolken );
664
+ /*
665
+ * Now, remove the commands and free the assoc data memory
666
+ */
591
667
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 );
596
669
597
- /* free the client data */
598
- ckfree (cmdClientDataPtr );
599
670
return TCL_OK ;
600
671
}
601
672
#ifdef __cplusplus
0 commit comments