Tcl package Thread source code

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87

--- generic/threadSvCmd.c +++ generic/threadSvCmd.c @@ -57,10 +57,13 @@ /* * Global variables used within this file. */ +static size_t nofThreads; /* Number of initialized threads */ +static Tcl_Mutex nofThreadsMutex; /* Protects the nofThreads variable */ + static Bucket* buckets; /* Array of buckets. */ static Tcl_Mutex bucketsMutex; /* Protects the array of buckets */ static SvCmdInfo* svCmdInfo; /* Linked list of registered commands */ static RegType* regType; /* Linked list of registered obj types */ @@ -2128,10 +2131,17 @@ Bucket *bucketPtr; SvCmdInfo *cmdPtr; const Tcl_UniChar no[3] = {'n', 'o', 0} ; Tcl_Obj *obj; + /* + * Increment number of threads + */ + Tcl_MutexLock(&nofThreadsMutex); + ++nofThreads; + Tcl_MutexUnlock(&nofThreadsMutex); + /* * Add keyed-list datatype */ TclX_KeyedListInit(interp); @@ -2187,11 +2197,13 @@ if (buckets == NULL) { Tcl_MutexLock(&bucketsMutex); if (buckets == NULL) { buckets = (Bucket *)ckalloc(sizeof(Bucket) * NUMBUCKETS); +#ifdef SV_FINALIZE Tcl_CreateExitHandler(SvFinalize, NULL); +#endif for (i = 0; i < NUMBUCKETS; ++i) { bucketPtr = &buckets[i]; memset(bucketPtr, 0, sizeof(Bucket)); Tcl_InitHashTable(&bucketPtr->arrays, TCL_STRING_KEYS); @@ -2256,10 +2268,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 +2341,14 @@ } regType = NULL; } Tcl_MutexUnlock(&svMutex); + +done: + --nofThreads; + Tcl_MutexUnlock(&nofThreadsMutex); } #endif /* SV_FINALIZE */ /* EOF $RCSfile: threadSvCmd.c,v $ */