Tcl package Thread source code

Artifact 77b93f020888c4e89549b4aa16851cde53ec77a5:

Attachment "3532972fff-3.patch" to ticket [3532972fff] added by adrianmedranocalvo 2016-05-18 17:21:30.

---

Index: generic/threadSvCmd.c
==================================================================
--- generic/threadSvCmd.c
+++ generic/threadSvCmd.c
@@ -19,10 +19,12 @@
 #include "threadSvListCmd.h"    /* Shared variants of list commands */
 #include "threadSvKeylistCmd.h" /* Shared variants of list commands */
 #include "psGdbm.h"             /* The gdbm persistent store implementation */
 #include "psLmdb.h"             /* The lmdb persistent store implementation */
 
+#define SV_FINALIZE
+
 /*
  * Number of buckets to spread shared arrays into. Each bucket is
  * associated with one mutex so locking a bucket locks all arrays
  * in that bucket as well. The number of buckets should be a prime.
  */
@@ -56,10 +58,15 @@
 static char *Sv_tclEmptyStringRep = NULL;
 
 /*
  * Global variables used within this file.
  */
+
+#ifdef SV_FINALIZE
+static size_t     nofThreads;      /* Number of initialized threads */
+static Tcl_Mutex  nofThreadsMutex; /* Protects the nofThreads variable */
+#endif
 
 static Bucket*    buckets;      /* Array of buckets. */
 static Tcl_Mutex  bucketsMutex; /* Protects the array of buckets */
 
 static SvCmdInfo* svCmdInfo;    /* Linked list of registered commands */
@@ -111,11 +118,10 @@
 static int DeleteArray(Array*);
 
 static void SvAllocateContainers(Bucket*);
 static void SvRegisterStdCommands(void);
 
-#define SV_FINALIZE
 #ifdef SV_FINALIZE
 static void SvFinalizeContainers(Bucket*);
 static void SvFinalize(ClientData);
 #endif /* SV_FINALIZE */
 
@@ -2128,10 +2134,24 @@
     Bucket *bucketPtr;
     SvCmdInfo *cmdPtr;
     const Tcl_UniChar no[3] = {'n', 'o', 0} ;
     Tcl_Obj *obj;
 
+#ifdef SV_FINALIZE
+    /*
+     * Create exit handler for this thread
+     */
+    Tcl_CreateThreadExitHandler(SvFinalize, NULL);
+
+    /*
+     * Increment number of threads
+     */
+    Tcl_MutexLock(&nofThreadsMutex);
+    ++nofThreads;
+    Tcl_MutexUnlock(&nofThreadsMutex);
+#endif
+
     /*
      * Add keyed-list datatype
      */
 
     TclX_KeyedListInit(interp);
@@ -2187,11 +2207,10 @@
 
     if (buckets == NULL) {
         Tcl_MutexLock(&bucketsMutex);
         if (buckets == NULL) {
             buckets = (Bucket *)ckalloc(sizeof(Bucket) * NUMBUCKETS);
-            Tcl_CreateExitHandler(SvFinalize, NULL);
 
             for (i = 0; i < NUMBUCKETS; ++i) {
                 bucketPtr = &buckets[i];
                 memset(bucketPtr, 0, sizeof(Bucket));
                 Tcl_InitHashTable(&bucketPtr->arrays, TCL_STRING_KEYS);
@@ -2256,10 +2275,22 @@
     SvCmdInfo *cmdPtr;
     RegType *regPtr;
 
     Tcl_HashEntry *hashPtr;
     Tcl_HashSearch search;
+
+    /*
+     * Decrement number of threads. Proceed only if I was the last one. The
+     * mutex is unlocked at the end of this function, so new threads that might
+     * want to register in the meanwhile will find a clean environment when
+     * they eventually succeed acquiring nofThreadsMutex.
+     */
+    Tcl_MutexLock(&nofThreadsMutex);
+    if (nofThreads > 1)
+    {
+        goto done;
+    }
 
     /*
      * Reclaim memory for shared arrays
      */
 
@@ -2317,10 +2348,14 @@
         }
         regType = NULL;
     }
 
     Tcl_MutexUnlock(&svMutex);
+
+done:
+    --nofThreads;
+    Tcl_MutexUnlock(&nofThreadsMutex);
 }
 #endif /* SV_FINALIZE */
 
 /* EOF $RCSfile: threadSvCmd.c,v $ */