Attachment "731356.patch" to
ticket [731356ffff]
added by
dgp
2003-11-15 04:15:01.
Index: generic/tcl.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.h,v
retrieving revision 1.167
diff -u -r1.167 tcl.h
--- generic/tcl.h 14 Nov 2003 20:44:44 -0000 1.167
+++ generic/tcl.h 14 Nov 2003 21:13:19 -0000
@@ -1169,8 +1169,13 @@
* hash table will attempt to rectify this by
* randomising the bits and then using the upper
* N bits as the index into the table.
+ * TCL_HASH_KEY_SYSTEM_HASH:
+ * If this flag is set then all memory internally
+ * allocated for the hash table that is not for an
+ * entry will use the system heap.
*/
#define TCL_HASH_KEY_RANDOMIZE_HASH 0x1
+#define TCL_HASH_KEY_SYSTEM_HASH 0x2
/*
* Structure definition for the methods associated with a hash table
Index: generic/tclCkalloc.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCkalloc.c,v
retrieving revision 1.19
diff -u -r1.19 tclCkalloc.c
--- generic/tclCkalloc.c 19 Jan 2003 07:21:18 -0000 1.19
+++ generic/tclCkalloc.c 14 Nov 2003 21:13:19 -0000
@@ -1249,4 +1249,8 @@
#if USE_TCLALLOC
TclFinalizeAllocSubsystem();
#endif
+
+#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
+ TclpFinalizeThreadAllocSubsystem();
+#endif
}
Index: generic/tclHash.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclHash.c,v
retrieving revision 1.13
diff -u -r1.13 tclHash.c
--- generic/tclHash.c 24 Jun 2003 19:56:12 -0000 1.13
+++ generic/tclHash.c 14 Nov 2003 21:13:19 -0000
@@ -14,6 +14,7 @@
*/
#include "tclInt.h"
+#include "tclPort.h"
/*
* Prevent macros from clashing with function definitions.
@@ -626,8 +627,12 @@
*/
if (tablePtr->buckets != tablePtr->staticBuckets) {
+ if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
+ TclpSysFree((char *) tablePtr->buckets);
+ } else {
ckfree((char *) tablePtr->buckets);
}
+ }
/*
* Arrange for panics if the table is used again without
@@ -745,6 +750,26 @@
double average, tmp;
register Tcl_HashEntry *hPtr;
char *result, *p;
+ Tcl_HashKeyType *typePtr;
+
+#if TCL_PRESERVE_BINARY_COMPATABILITY
+ if (tablePtr->keyType == TCL_STRING_KEYS) {
+ typePtr = &tclStringHashKeyType;
+ } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
+ typePtr = &tclOneWordHashKeyType;
+ } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
+ || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
+ typePtr = tablePtr->typePtr;
+ } else {
+ typePtr = &tclArrayHashKeyType;
+ }
+#else
+ typePtr = tablePtr->typePtr;
+ if (typePtr == NULL) {
+ Tcl_Panic("called Tcl_HashStats on deleted table");
+ return NULL;
+ }
+#endif
/*
* Compute a histogram of bucket usage.
@@ -774,8 +799,11 @@
/*
* Print out the histogram and a few other pieces of information.
*/
-
+ if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
+ result = (char *) TclpSysAlloc((unsigned) ((NUM_COUNTERS*60) + 300), 0);
+ } else {
result = (char *) ckalloc((unsigned) ((NUM_COUNTERS*60) + 300));
+ }
sprintf(result, "%d entries in table, %d buckets\n",
tablePtr->numEntries, tablePtr->numBuckets);
p = result + strlen(result);
@@ -1122,6 +1150,21 @@
Tcl_HashKeyType *typePtr;
VOID *key;
+#if TCL_PRESERVE_BINARY_COMPATABILITY
+ if (tablePtr->keyType == TCL_STRING_KEYS) {
+ typePtr = &tclStringHashKeyType;
+ } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
+ typePtr = &tclOneWordHashKeyType;
+ } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
+ || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
+ typePtr = tablePtr->typePtr;
+ } else {
+ typePtr = &tclArrayHashKeyType;
+ }
+#else
+ typePtr = tablePtr->typePtr;
+#endif
+
oldSize = tablePtr->numBuckets;
oldBuckets = tablePtr->buckets;
@@ -1131,8 +1174,13 @@
*/
tablePtr->numBuckets *= 4;
+ if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
+ tablePtr->buckets = (Tcl_HashEntry **) TclpSysAlloc((unsigned)
+ (tablePtr->numBuckets * sizeof(Tcl_HashEntry *)), 0);
+ } else {
tablePtr->buckets = (Tcl_HashEntry **) ckalloc((unsigned)
(tablePtr->numBuckets * sizeof(Tcl_HashEntry *)));
+ }
for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
count > 0; count--, newChainPtr++) {
*newChainPtr = NULL;
@@ -1141,21 +1189,6 @@
tablePtr->downShift -= 2;
tablePtr->mask = (tablePtr->mask << 2) + 3;
-#if TCL_PRESERVE_BINARY_COMPATABILITY
- if (tablePtr->keyType == TCL_STRING_KEYS) {
- typePtr = &tclStringHashKeyType;
- } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
- typePtr = &tclOneWordHashKeyType;
- } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
- || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
- typePtr = tablePtr->typePtr;
- } else {
- typePtr = &tclArrayHashKeyType;
- }
-#else
- typePtr = tablePtr->typePtr;
-#endif
-
/*
* Rehash all of the existing entries into the new bucket array.
*/
@@ -1200,6 +1233,10 @@
*/
if (oldBuckets != tablePtr->staticBuckets) {
+ if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
+ TclpSysFree((char *) oldBuckets);
+ } else {
ckfree((char *) oldBuckets);
+ }
}
}
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.138
diff -u -r1.138 tclInt.h
--- generic/tclInt.h 3 Nov 2003 12:49:31 -0000 1.138
+++ generic/tclInt.h 14 Nov 2003 21:13:20 -0000
@@ -1722,6 +1722,8 @@
EXTERN void TclpFinalizeCondition _ANSI_ARGS_((
Tcl_Condition *condPtr));
EXTERN void TclpFinalizeMutex _ANSI_ARGS_((Tcl_Mutex *mutexPtr));
+EXTERN void TclpFinalizeThreadStorage _ANSI_ARGS_((void));
+EXTERN void TclpFinalizeThreadAllocSubsystem _ANSI_ARGS_((void));
EXTERN void TclpFinalizeThreadData _ANSI_ARGS_((
Tcl_ThreadDataKey *keyPtr));
EXTERN void TclpFinalizeThreadDataKey _ANSI_ARGS_((
@@ -1744,6 +1746,9 @@
EXTERN Tcl_Obj* TclpObjListVolumes _ANSI_ARGS_((void));
EXTERN void TclpMasterLock _ANSI_ARGS_((void));
EXTERN void TclpMasterUnlock _ANSI_ARGS_((void));
+EXTERN void TclpThreadStorageLockInit _ANSI_ARGS_((void));
+EXTERN void TclpThreadStorageLock _ANSI_ARGS_((void));
+EXTERN void TclpThreadStorageUnlock _ANSI_ARGS_((void));
EXTERN int TclpMatchFiles _ANSI_ARGS_((Tcl_Interp *interp,
char *separators, Tcl_DString *dirPtr,
char *pattern, char *tail));
@@ -1791,6 +1796,11 @@
EXTERN void TclpReleaseFile _ANSI_ARGS_((TclFile file));
EXTERN void TclpSetVariables _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN void TclpUnloadFile _ANSI_ARGS_((Tcl_LoadHandle loadHandle));
+EXTERN Tcl_HashTable * TclpThreadStorageInit _ANSI_ARGS_((Tcl_ThreadId id));
+EXTERN Tcl_HashTable * TclpThreadStorageGetHashTable _ANSI_ARGS_((
+ Tcl_ThreadId id));
+EXTERN void TclpThreadStoragePrint _ANSI_ARGS_((FILE *outFile,
+ int flags));
EXTERN VOID * TclpThreadDataKeyGet _ANSI_ARGS_((
Tcl_ThreadDataKey *keyPtr));
EXTERN void TclpThreadDataKeyInit _ANSI_ARGS_((
Index: generic/tclThread.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclThread.c,v
retrieving revision 1.6
diff -u -r1.6 tclThread.c
--- generic/tclThread.c 10 Dec 2002 00:34:15 -0000 1.6
+++ generic/tclThread.c 14 Nov 2003 21:13:20 -0000
@@ -484,6 +484,9 @@
condRecord.max = 0;
condRecord.num = 0;
+ /* call platform specific thread storage master cleanup */
+ TclpFinalizeThreadStorage();
+
TclpMasterUnlock();
#else
if (keyRecord.list != NULL) {
Index: win/tclWin32Dll.c
===================================================================
RCS file: /cvsroot/tcl/tcl/win/tclWin32Dll.c,v
retrieving revision 1.28
diff -u -r1.28 tclWin32Dll.c
--- win/tclWin32Dll.c 13 Oct 2003 16:48:07 -0000 1.28
+++ win/tclWin32Dll.c 14 Nov 2003 21:13:21 -0000
@@ -244,8 +244,12 @@
switch (reason) {
case DLL_PROCESS_ATTACH:
TclWinInit(hInst);
+ TclpThreadStorageLockInit(); /*
+ * Eliminate potential race condition by
+ * doing this here in case multiple threads
+ * need to allocate memory straight away.
+ */
return TRUE;
-
case DLL_PROCESS_DETACH:
if (hInst == hInstance) {
Tcl_Finalize();
Index: win/tclWinThrd.c
===================================================================
RCS file: /cvsroot/tcl/tcl/win/tclWinThrd.c,v
retrieving revision 1.26
diff -u -r1.26 tclWinThrd.c
--- win/tclWinThrd.c 13 May 2003 10:16:17 -0000 1.26
+++ win/tclWinThrd.c 14 Nov 2003 21:13:21 -0000
@@ -14,6 +14,12 @@
#include "tclWinInt.h"
+/* TODO: put these in the "standard" location(s). */
+#define TCL_NO_TLS
+#define TCL_THREAD_ALLOC_NO_TLS
+/* WARNING: produces a lot of output. */
+/* #define TCL_THREAD_STORAGE_DEBUG */
+
#include <fcntl.h>
#include <io.h>
#include <sys/stat.h>
@@ -110,6 +116,96 @@
struct ThreadSpecificData *lastPtr;
} WinCondition;
+/*
+ * This is the thread storage cache array and it's accompanying mutex.
+ * The elements are pairs of thread Id and an associated hash table
+ * pointer; the hash table being pointed to contains the thread storage
+ * for it's associated thread. The purpose of this cache is to minimize
+ *
+ */
+static CRITICAL_SECTION threadStorageLock;
+#define STORAGE_LOCK TclpThreadStorageLock()
+#define STORAGE_UNLOCK TclpThreadStorageUnlock()
+
+/*
+ * This is the struct used for a thread storage cache slot. It
+ * contains the owning thread Id and the associated hash table
+ * pointer.
+ */
+typedef struct WinThreadStorage {
+ Tcl_ThreadId id; /* the owning thread id */
+ Tcl_HashTable *hashTablePtr; /* the hash table for the thread */
+} WinThreadStorage;
+
+/*
+ * These are the prototypes for the custom hash table allocation
+ * functions used by the thread storage subsystem.
+ */
+static Tcl_HashEntry * AllocThreadStorageEntry _ANSI_ARGS_((
+ Tcl_HashTable *tablePtr, VOID *keyPtr));
+static void FreeThreadStorageEntry _ANSI_ARGS_((
+ Tcl_HashEntry *hPtr));
+
+/*
+ * This is the hash key type for thread storage. We MUST use
+ * this because these hash tables are used by the threaded memory
+ * allocator.
+ */
+Tcl_HashKeyType tclThreadStorageHashKeyType = {
+ TCL_HASH_KEY_TYPE_VERSION, /* version */
+ TCL_HASH_KEY_SYSTEM_HASH, /* flags */
+ NULL, /* hashKeyProc */
+ NULL, /* compareKeysProc */
+ AllocThreadStorageEntry, /* allocEntryProc */
+ FreeThreadStorageEntry /* freeEntryProc */
+};
+
+/*
+ * This is an invalid thread value.
+ */
+#define STORAGE_INVALID_THREAD 0
+
+/*
+ * This is the value for an invalid thread storage key.
+ */
+#define STORAGE_INVALID_KEY 0
+
+/*
+ * This is the first valid key for use by external callers.
+ */
+#define STORAGE_FIRST_KEY 1
+
+/*
+ * This define may need to be fine tuned for maximum performance.
+ */
+#define STORAGE_CACHE_SLOTS 100
+
+/*
+ * This is the master thread storage hash table. It is keyed on
+ * thread Id and contains values that are hash tables for each thread.
+ * The thread specific hash tables contain the actual thread storage.
+ */
+static Tcl_HashTable *threadStorageHashTablePtr = NULL;
+
+/*
+ * This is the next thread data key value to use. We increment this
+ * everytime we "allocate" one. It is initially set to 1 in
+ * TclpThreadStorageInit.
+ */
+static DWORD nextThreadStorageKey = STORAGE_INVALID_KEY;
+
+/*
+ * Have we initialized the thread storage critical section yet?
+ */
+static int initThreadStorage = 0;
+
+/*
+ * This is the master thread storage cache. Per kennykb's idea, this
+ * prevents unnecessary lookups for threads that use a lot of thread
+ * storage.
+ */
+volatile WinThreadStorage threadStorageCache[STORAGE_CACHE_SLOTS];
+
/*
*----------------------------------------------------------------------
@@ -373,6 +469,88 @@
/*
*----------------------------------------------------------------------
*
+ * TclpThreadStorageLockInit
+ *
+ * This procedure is used to initialize the lock that serializes
+ * creation of thread storage.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpThreadStorageLockInit()
+{
+ if (!initThreadStorage) {
+ /*
+ * There is a fundamental race here that is solved by creating
+ * the first Tcl interpreter in a single threaded environment.
+ * Once the interpreter has been created, it is safe to create
+ * more threads that create interpreters in parallel.
+ */
+ initThreadStorage = 1;
+ InitializeCriticalSection(&threadStorageLock);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpThreadStorageLock
+ *
+ * This procedure is used to grab a lock that serializes creation
+ * of thread storage.
+ *
+ * This lock must be different than the initLock because the
+ * initLock is held during creation of syncronization objects.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Acquire the thread storage mutex.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpThreadStorageLock()
+{
+ TclpThreadStorageLockInit();
+ EnterCriticalSection(&threadStorageLock);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpThreadStorageUnlock
+ *
+ * This procedure is used to release a lock that serializes creation
+ * of thread storage.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Release the thread storage mutex.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpThreadStorageUnlock()
+{
+ LeaveCriticalSection(&threadStorageLock);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_GetAllocMutex
*
* This procedure returns a pointer to a statically initialized
@@ -511,6 +689,304 @@
/*
*----------------------------------------------------------------------
*
+ * AllocThreadStorageEntry --
+ *
+ * Allocate space for a Tcl_HashEntry using TclpSysAlloc (not ckalloc).
+ * We do this because the threaded memory allocator uses the thread
+ * storage hash tables.
+ *
+ * Results:
+ * The return value is a pointer to the created entry.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_HashEntry *
+AllocThreadStorageEntry(tablePtr, keyPtr)
+ Tcl_HashTable *tablePtr; /* Hash table. */
+ VOID *keyPtr; /* Key to store in the hash table entry. */
+{
+ Tcl_HashEntry *hPtr;
+
+ hPtr = (Tcl_HashEntry *)TclpSysAlloc(sizeof(Tcl_HashEntry), 0);
+ hPtr->key.oneWordValue = (char *)keyPtr;
+
+ return hPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeThreadStorageEntry --
+ *
+ * Frees space for a Tcl_HashEntry using TclpSysFree (not ckfree).
+ * We do this because the threaded memory allocator uses the thread
+ * storage hash tables.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeThreadStorageEntry(hPtr)
+ Tcl_HashEntry *hPtr; /* Hash entry to free. */
+{
+ TclpSysFree((char *)hPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpThreadStoragePrint --
+ *
+ * This procedure prints out the contents of the master thread
+ * storage hash table, the thread storage cache, and the next key
+ * value to the specified file.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpThreadStoragePrint(outFile, flags)
+ FILE *outFile; /* The file to print the information to. */
+ int flags; /* Reserved for future use. */
+{
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+#if 0
+ /* Please see comment regarding Tcl_HashStats below. */
+ CONST char *stats;
+#endif
+ int header;
+ int index;
+
+ STORAGE_LOCK;
+ if (threadStorageHashTablePtr != NULL) {
+ hPtr = Tcl_FirstHashEntry(threadStorageHashTablePtr, &search);
+
+ if (hPtr != NULL) {
+ fprintf(outFile, "master thread storage hash table:\n");
+ for (; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ fprintf(outFile, "master entry ptr 0x%08lx, thread %ld, thread table ptr 0x%08lx\n",
+ hPtr, Tcl_GetHashKey(threadStorageHashTablePtr, hPtr), Tcl_GetHashValue(hPtr));
+ }
+ } else {
+ fprintf(outFile, "master thread storage hash table has no entries\n");
+ }
+ } else {
+ fprintf(outFile, "master thread storage hash table not initialized\n");
+ }
+
+ header = 0; /* we have not output the header yet. */
+ for (index = 0; index < STORAGE_CACHE_SLOTS; index++) {
+ if (threadStorageCache[index].id != STORAGE_INVALID_THREAD) {
+ if (!header) {
+ fprintf(outFile, "thread storage cache (%d total slots):\n", STORAGE_CACHE_SLOTS);
+ header = 1;
+ }
+
+ fprintf(outFile, "slot %d, thread %d, thread table ptr 0x%08lx\n",
+ index, threadStorageCache[index].id,
+ threadStorageCache[index].hashTablePtr);
+#if 0
+ /*
+ * Currently disabled due to Tcl_HashStats use of ckalloc and ckfree.
+ */
+ if (threadStorageCache[index].hashTablePtr != NULL) {
+ stats = Tcl_HashStats(threadStorageCache[index].hashTablePtr);
+ if (stats != NULL) {
+ fprintf(outFile, "%s\n", stats);
+ ckfree((void *)stats);
+ } else {
+ fprintf(outFile, "could not get table statistics for slot %d\n", index);
+ }
+ }
+#endif
+ } else {
+ /* fprintf(outFile, "cache slot %d not used\n", index); */
+ }
+ }
+
+ if (!header) {
+ fprintf(outFile, "thread storage cache is empty (%d total slots)\n", STORAGE_CACHE_SLOTS);
+ header = 1;
+ }
+
+ /* Show the next data key value. */
+ fprintf(outFile, "next data key value is: %ld\n", nextThreadStorageKey);
+ STORAGE_UNLOCK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpThreadStorageGetHashTable --
+ *
+ * This procedure returns a hash table pointer to be used for thread
+ * storage for the specified thread.
+ *
+ * Results:
+ * A hash table pointer for the specified thread, or NULL
+ * if the hash table has not been created yet.
+ *
+ * Side effects:
+ * May change an entry in the master thread storage cache to point
+ * to the specified thread and it's associated hash table.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_HashTable *
+TclpThreadStorageGetHashTable(id)
+ Tcl_ThreadId id; /* Id of the thread to get the hash table for */
+{
+ int index = (DWORD)id % STORAGE_CACHE_SLOTS;
+ Tcl_HashEntry *hPtr;
+
+ /*
+ * It's important that we pick up the hash table pointer BEFORE
+ * comparing thread Id in case another thread is in the critical
+ * region changing things out from under you.
+ */
+ Tcl_HashTable *hashTablePtr = threadStorageCache[index].hashTablePtr;
+
+ if (threadStorageCache[index].id != id) {
+ STORAGE_LOCK;
+ if (threadStorageHashTablePtr != NULL) {
+ /* it's not in the cache, so we look it up... */
+ hPtr = Tcl_FindHashEntry(threadStorageHashTablePtr, (char *)id);
+
+ if (hPtr != NULL) {
+ /* we found it, extract the hash table pointer. */
+ hashTablePtr = Tcl_GetHashValue(hPtr);
+ } else {
+ /* the thread specific hash table is not found. */
+ hashTablePtr = NULL;
+ }
+ } else {
+ /* we cannot look it up, the master hash table has not been initialized. */
+ hashTablePtr = NULL;
+ }
+
+ /* for threads that have not created their hash table yet, we need to skip
+ putting that thread in the cache. */
+ if (hashTablePtr != NULL) {
+ /* now, we put it in the cache since it is highly likely it will
+ be needed again shortly. */
+ threadStorageCache[index].id = id;
+ threadStorageCache[index].hashTablePtr = hashTablePtr;
+ }
+ STORAGE_UNLOCK;
+ }
+
+ return hashTablePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpThreadStorageInit --
+ *
+ * This procedure initializes a thread specific hash table for the
+ * current thread. It may also initialize the master hash table which
+ * stores all the thread specific hash tables.
+ *
+ * Results:
+ * A hash table pointer for the specified thread, or NULL if we are
+ * be called to initialize the master hash table only.
+ *
+ * Side effects:
+ * The thread specific hash table may be initialized and added to the
+ * master hash table.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_HashTable *
+TclpThreadStorageInit(id)
+ Tcl_ThreadId id; /* Id of the thread to get the hash table for */
+{
+ Tcl_HashTable *hashTablePtr; /* hash table for current thread */
+ Tcl_HashEntry *hPtr; /* hash entry for current thread in master table */
+ int new;
+
+#ifdef TCL_THREAD_STORAGE_DEBUG
+ TclpThreadStoragePrint(stderr, 0);
+#endif
+
+ STORAGE_LOCK;
+ if (threadStorageHashTablePtr == NULL) {
+ /* looks like we haven't created the outer hash table yet
+ we can just do that now. */
+ threadStorageHashTablePtr = (Tcl_HashTable *)TclpSysAlloc(sizeof(Tcl_HashTable), 0);
+
+ if (threadStorageHashTablePtr != NULL) {
+ /* initialize the hash table */
+ Tcl_InitCustomHashTable(threadStorageHashTablePtr, TCL_CUSTOM_TYPE_KEYS, &tclThreadStorageHashKeyType);
+ } else {
+ panic("could not allocate master thread storage hash table");
+ }
+
+ /* we MUST also initialize the cache, since it is checked by
+ TclpThreadStorageGetHashTable in the call below. */
+ memset((WinThreadStorage *)&threadStorageCache, 0, sizeof(WinThreadStorage) * STORAGE_CACHE_SLOTS);
+
+ /* now, we set the first value to be used for a thread data key. */
+ nextThreadStorageKey = STORAGE_FIRST_KEY;
+ }
+ STORAGE_UNLOCK;
+
+ /*
+ * A thread Id of zero indicates that the caller does not want to
+ * lookup or initialize the hash table pointer for the thread.
+ */
+ if (id != STORAGE_INVALID_THREAD) {
+ hashTablePtr = TclpThreadStorageGetHashTable(id);
+
+ if (hashTablePtr == NULL) {
+ hashTablePtr = (Tcl_HashTable *)TclpSysAlloc(sizeof(Tcl_HashTable), 0);
+
+ if (hashTablePtr != NULL) {
+ Tcl_InitCustomHashTable(hashTablePtr, TCL_CUSTOM_TYPE_KEYS, &tclThreadStorageHashKeyType);
+
+ /* add new thread storage hash table to the master hash table */
+ STORAGE_LOCK;
+ hPtr = Tcl_CreateHashEntry(threadStorageHashTablePtr, (char *)id, &new);
+
+ if (hPtr != NULL) {
+ Tcl_SetHashValue(hPtr, hashTablePtr);
+ } else {
+ panic("Tcl_CreateHashEntry failed from TclpThreadStorageInit!");
+ }
+ STORAGE_UNLOCK;
+ } else {
+ panic("could not allocate thread specific hash table");
+ }
+ }
+ } else {
+ hashTablePtr = NULL;
+ }
+
+ return hashTablePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclpThreadDataKeyInit --
*
* This procedure initializes a thread specific data block key.
@@ -540,18 +1016,67 @@
{
DWORD *indexPtr;
DWORD newKey;
-
MASTER_LOCK;
if (*keyPtr == NULL) {
indexPtr = (DWORD *)ckalloc(sizeof(DWORD));
+ if (indexPtr != NULL) {
+#ifndef TCL_NO_TLS
newKey = TlsAlloc();
if (newKey != TLS_OUT_OF_INDEXES) {
*indexPtr = newKey;
+ *keyPtr = (Tcl_ThreadDataKey)indexPtr;
+ TclRememberDataKey(keyPtr);
} else {
+ /*
+ * This panic is probably the most likely one in this
+ * entire file to actually be hit. The primary reason for
+ * this is that there are hard coded limits on the number
+ * of TLS indexes/slots on ALL versions of Win32, as
+ * follows:
+ *
+ * 95/NT4: 64
+ * 98/Me: 80
+ * 2000/XP: 1088
+ * 2003: 1088
+ *
+ * All of these limits are per process, for the lifetime
+ * of the process, which could be a big problem for long
+ * running processes that load and unload a lot of DLLs
+ * that use TLS.
+ */
panic("TlsAlloc failed from TclpThreadDataKeyInit!"); /* this should be a fatal error */
}
+#else
+ /*
+ * We must call this now to make sure
+ * that nextThreadStorageKey has a well defined
+ * value.
+ */
+ TclpThreadStorageInit(STORAGE_INVALID_THREAD);
+ STORAGE_LOCK;
+ /*
+ * These data key values are sequentially
+ * assigned and we must use the storage
+ * lock to prevent serious problems here.
+ * We could use the Win32 interlocked
+ * increment here IF it had consistent
+ * behavior on different variations of
+ * Win32. Also note that the caller should
+ * NOT make any assumptions about the
+ * provided values. In particular, we may
+ * need to reserve some values in the
+ * future.
+ */
+ newKey = nextThreadStorageKey++;
+ STORAGE_UNLOCK;
+
+ *indexPtr = newKey;
*keyPtr = (Tcl_ThreadDataKey)indexPtr;
TclRememberDataKey(keyPtr);
+#endif
+ } else {
+ panic("ckalloc failed from TclpThreadDataKeyInit!"); /* this should also be a fatal error */
+ }
}
MASTER_UNLOCK;
}
@@ -580,15 +1105,41 @@
{
DWORD *indexPtr = *(DWORD **)keyPtr;
LPVOID result;
+#ifndef TCL_NO_TLS
if (indexPtr == NULL) {
- return NULL;
+ result = NULL;
} else {
result = TlsGetValue(*indexPtr);
if ((result == NULL) && (GetLastError() != NO_ERROR)) {
panic("TlsGetValue failed from TclpThreadDataKeyGet!");
}
+ }
return result;
+#else
+ Tcl_ThreadId id = Tcl_GetCurrentThread();
+ Tcl_HashTable *hashTablePtr;
+ Tcl_HashEntry *hPtr;
+
+ if (indexPtr == NULL) {
+ result = NULL;
+ } else {
+ hashTablePtr = TclpThreadStorageInit(id);
+
+ if (hashTablePtr != NULL) {
+ hPtr = Tcl_FindHashEntry(hashTablePtr, (char *)*indexPtr);
+
+ if (hPtr != NULL) {
+ result = (LPVOID)Tcl_GetHashValue(hPtr);
+ } else {
+ result = NULL;
}
+ } else {
+ panic("TclpThreadStorageInit failed from TclpThreadDataKeyGet!");
+ result = NULL;
+ }
+ }
+ return result;
+#endif /* TCL_NO_TLS */
}
/*
@@ -615,11 +1166,97 @@
VOID *data; /* Thread local storage */
{
DWORD *indexPtr = *(DWORD **)keyPtr;
+#ifndef TCL_NO_TLS
BOOL success;
success = TlsSetValue(*indexPtr, (void *)data);
if (!success) {
panic("TlsSetValue failed from TclpThreadDataKeySet!");
}
+#else
+ Tcl_ThreadId id = Tcl_GetCurrentThread();
+ Tcl_HashTable *hashTablePtr;
+ Tcl_HashEntry *hPtr;
+ int new;
+
+ hashTablePtr = TclpThreadStorageInit(id);
+
+ if (hashTablePtr != NULL) {
+ hPtr = Tcl_FindHashEntry(hashTablePtr, (char *)*indexPtr);
+
+ /* does the item need to be created? */
+ if (hPtr == NULL) {
+ hPtr = Tcl_CreateHashEntry(hashTablePtr, (char *)*indexPtr, &new);
+ }
+
+ if (hPtr != NULL) {
+ Tcl_SetHashValue(hPtr, data);
+ } else {
+ panic("could not set hash entry value from TclpThreadDataKeySet");
+ }
+ } else {
+ panic("TclpThreadStorageInit failed from TclpThreadDataKeySet!");
+ }
+#endif /* TCL_NO_TLS */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpFinalizeThreadStorage --
+ *
+ * This procedure cleans up the master thread storage hash table,
+ * all thread specific hash tables, and the thread storage cache.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The master thread storage hash table and thread storage cache are
+ * reset to their initial (empty) state.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpFinalizeThreadStorage()
+{
+ Tcl_HashTable *hashTablePtr; /* hash table for current thread */
+ Tcl_HashSearch search; /* we need to hit every thread with this search */
+ Tcl_HashEntry *hPtr; /* hash entry for current thread in master table */
+
+ STORAGE_LOCK;
+ if (threadStorageHashTablePtr != NULL) {
+ /* we are going to delete the hash table for every thread now. */
+ for (hPtr = Tcl_FirstHashEntry(threadStorageHashTablePtr, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+
+ /* get the hash table corresponding to the thread in question. */
+ hashTablePtr = Tcl_GetHashValue(hPtr);
+
+ if (hashTablePtr != NULL) {
+ /* delete thread specific hash table and free the struct. */
+ Tcl_DeleteHashTable(hashTablePtr);
+ TclpSysFree((char *)hashTablePtr);
+ }
+
+ /* delete thread specific entry from master hash table. */
+ Tcl_SetHashValue(hPtr, NULL);
+ }
+
+ Tcl_DeleteHashTable(threadStorageHashTablePtr);
+ TclpSysFree((char *)threadStorageHashTablePtr);
+
+ /* reset this so that next time around we know it's not valid. */
+ threadStorageHashTablePtr = NULL;
+
+ /* clear out the thread storage cache as well */
+ memset((WinThreadStorage *)&threadStorageCache, 0, sizeof(WinThreadStorage) * STORAGE_CACHE_SLOTS);
+
+ /* reset this to zero, it will be set to 1 if the thread storage
+ subsystem gets reinitialized */
+ nextThreadStorageKey = STORAGE_INVALID_KEY;
+ }
+ STORAGE_UNLOCK;
}
/*
@@ -645,11 +1282,19 @@
{
VOID *result;
DWORD *indexPtr;
+#ifndef TCL_NO_TLS
BOOL success;
+#else
+ Tcl_ThreadId id = Tcl_GetCurrentThread();
+ Tcl_HashTable *hashTablePtr; /* hash table for current thread */
+ Tcl_HashEntry *hPtr; /* hash entry for data key in current thread */
+#endif
#ifdef USE_THREAD_ALLOC
TclWinFreeAllocCache();
#endif
+
+#ifndef TCL_NO_TLS
if (*keyPtr != NULL) {
indexPtr = *(DWORD **)keyPtr;
result = (VOID *)TlsGetValue(*indexPtr);
@@ -665,6 +1310,29 @@
}
}
}
+#else
+ if (*keyPtr != NULL) {
+ indexPtr = *(DWORD **)keyPtr;
+
+ hashTablePtr = TclpThreadStorageInit(id);
+
+ if (hashTablePtr != NULL) {
+ hPtr = Tcl_FindHashEntry(hashTablePtr, (char *)*indexPtr);
+
+ if (hPtr != NULL) {
+ result = Tcl_GetHashValue(hPtr);
+
+ if (result != NULL) {
+ ckfree((char *)result);
+ }
+
+ Tcl_SetHashValue(hPtr, NULL);
+ }
+ } else {
+ panic("TclpThreadStorageInit failed from TclpFinalizeThreadData!");
+ }
+ }
+#endif /* TCL_NO_TLS */
}
/*
@@ -692,16 +1360,53 @@
Tcl_ThreadDataKey *keyPtr;
{
DWORD *indexPtr;
+#ifndef TCL_NO_TLS
BOOL success;
if (*keyPtr != NULL) {
indexPtr = *(DWORD **)keyPtr;
success = TlsFree(*indexPtr);
- if (!success) {
+ if (success) {
+ ckfree((char *)indexPtr);
+ *keyPtr = NULL;
+ } else {
panic("TlsFree failed from TclpFinalizeThreadDataKey!");
}
+ }
+#else
+ Tcl_HashTable *hashTablePtr; /* hash table for current thread */
+ Tcl_HashSearch search; /* we need to hit every thread with this search */
+ Tcl_HashEntry *hPtr; /* hash entry for current thread in master table */
+ Tcl_HashEntry *hDataPtr; /* hash entry for data key in current thread */
+
+ if (*keyPtr != NULL) {
+ indexPtr = *(DWORD **)keyPtr;
+
+ STORAGE_LOCK;
+ if (threadStorageHashTablePtr != NULL) {
+ /* we are going to delete the specified data key entry from every thread. */
+ for (hPtr = Tcl_FirstHashEntry(threadStorageHashTablePtr, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+
+ /* get the hash table corresponding to the thread in question. */
+ hashTablePtr = Tcl_GetHashValue(hPtr);
+
+ if (hashTablePtr != NULL) {
+ /* now find the entry for the specified data key. */
+ hDataPtr = Tcl_FindHashEntry(hashTablePtr, (char *)*indexPtr);
+
+ if (hDataPtr != NULL) {
+ /* delete the data key for this thread. */
+ Tcl_DeleteHashEntry(hDataPtr);
+ }
+ }
+ }
+ }
+ STORAGE_UNLOCK;
+
ckfree((char *)indexPtr);
*keyPtr = NULL;
}
+#endif
}
/*
@@ -1005,7 +1710,16 @@
* Additions by AOL for specialized thread memory allocator.
*/
#ifdef USE_THREAD_ALLOC
-static DWORD key;
+static int initThreadAlloc = 0;
+
+#ifndef TCL_NO_TLS
+#define THREAD_ALLOC_BAD_KEY TLS_OUT_OF_INDEXES
+#else
+#define THREAD_ALLOC_BAD_KEY STORAGE_INVALID_KEY
+#endif
+
+/* set to an invalid value for a thread [local] storage index */
+static DWORD key = THREAD_ALLOC_BAD_KEY;
Tcl_Mutex *
TclpNewAllocMutex(void)
@@ -1027,57 +1741,174 @@
void *
TclpGetAllocCache(void)
{
- static int once = 0;
VOID *result;
-
- if (!once) {
+#ifndef TCL_THREAD_ALLOC_NO_TLS
+ if (!initThreadAlloc) {
/*
* We need to make sure that TclWinFreeAllocCache is called
* on each thread that calls this, but only on threads that
* call this.
*/
key = TlsAlloc();
- once = 1;
- if (key == TLS_OUT_OF_INDEXES) {
+ if (key != TLS_OUT_OF_INDEXES) {
+ initThreadAlloc = 1;
+ } else {
panic("could not allocate thread local storage");
}
}
+ if (key != TLS_OUT_OF_INDEXES) {
result = TlsGetValue(key);
if ((result == NULL) && (GetLastError() != NO_ERROR)) {
panic("TlsGetValue failed from TclpGetAllocCache!");
}
+ } else {
+ result = NULL;
+ }
+#else
+ Tcl_ThreadId id = Tcl_GetCurrentThread();
+ Tcl_HashTable *hashTablePtr;
+ Tcl_HashEntry *hPtr;
+ int new;
+
+ hashTablePtr = TclpThreadStorageInit(id);
+
+ if (!initThreadAlloc) {
+ STORAGE_LOCK;
+ /*
+ * This must be after call to TclpThreadStorageInit,
+ * otherwise nextThreadStorageKey may not have been initialized.
+ */
+ key = nextThreadStorageKey++;
+ STORAGE_UNLOCK;
+ initThreadAlloc = 1;
+ }
+
+ if (hashTablePtr != NULL) {
+ hPtr = Tcl_FindHashEntry(hashTablePtr, (char *)key);
+
+ if (hPtr != NULL) {
+ /* return the value for this thread */
+ result = Tcl_GetHashValue(hPtr);
+ } else {
+ result = NULL;
+
+ /* now create the thread storage index for this thread */
+ hPtr = Tcl_CreateHashEntry(hashTablePtr, (char *)key, &new);
+
+ if (hPtr != NULL) {
+ /* initially, set to NULL */
+ Tcl_SetHashValue(hPtr, NULL);
+ } else {
+ panic("Tcl_CreateHashEntry failed from TclpGetAllocCache!");
+ }
+ }
+ } else {
+ panic("TclpThreadStorageInit failed from TclpGetAllocCache!");
+ result = NULL;
+ }
+#endif
return result;
}
void
TclpSetAllocCache(void *ptr)
{
+#ifndef TCL_THREAD_ALLOC_NO_TLS
BOOL success;
success = TlsSetValue(key, ptr);
if (!success) {
panic("TlsSetValue failed from TclpSetAllocCache!");
}
+#else
+ Tcl_ThreadId id = Tcl_GetCurrentThread();
+ Tcl_HashTable *hashTablePtr;
+ Tcl_HashEntry *hPtr;
+
+ hashTablePtr = TclpThreadStorageInit(id);
+
+ if (hashTablePtr != NULL) {
+ hPtr = Tcl_FindHashEntry(hashTablePtr, (char *)key);
+
+ if (hPtr != NULL) {
+ Tcl_SetHashValue(hPtr, ptr);
+ } else {
+ /*
+ * This may indicate an error by the caller, they should have
+ * called TclpGetAllocCache prior to calling this function.
+ */
+ panic("could not find thread alloc hash entry from TclpSetAllocCache");
+ }
+ } else {
+ panic("TclpThreadStorageInit failed from TclpSetAllocCache!");
+ }
+#endif
}
void
TclWinFreeAllocCache(void)
{
void *ptr;
+#ifndef TCL_THREAD_ALLOC_NO_TLS
BOOL success;
-
ptr = TlsGetValue(key);
if (ptr != NULL) {
success = TlsSetValue(key, NULL);
- if (!success) {
+ if (success) {
+ TclFreeAllocCache(ptr);
+ } else {
panic("TlsSetValue failed from TclWinFreeAllocCache!");
}
- TclFreeAllocCache(ptr);
} else {
if (GetLastError() != NO_ERROR) {
panic("TlsGetValue failed from TclWinFreeAllocCache!");
}
}
+#else
+ Tcl_ThreadId id = Tcl_GetCurrentThread();
+ Tcl_HashTable *hashTablePtr;
+ Tcl_HashEntry *hPtr;
+
+ hashTablePtr = TclpThreadStorageInit(id);
+
+ if (hashTablePtr != NULL) {
+ hPtr = Tcl_FindHashEntry(hashTablePtr, (char *)key);
+
+ if (hPtr != NULL) {
+ ptr = Tcl_GetHashValue(hPtr);
+
+ if (ptr != NULL) {
+ TclFreeAllocCache(ptr);
+ }
+
+ Tcl_DeleteHashEntry(hPtr);
+ }
+ } else {
+ panic("TclpThreadStorageInit failed from TclWinFreeAllocCache!");
+ }
+#endif
+}
+
+void
+TclpFinalizeThreadAllocSubsystem(void)
+{
+#ifndef TCL_THREAD_ALLOC_NO_TLS
+ BOOL success;
+ if (initThreadAlloc) {
+ success = TlsFree(key);
+ if (success) {
+ /* reset the variable for next time. */
+ key = TLS_OUT_OF_INDEXES;
+ initThreadAlloc = 0;
+ } else {
+ panic("TlsFree failed from TclpFinalizeThreadAllocSubsystem!");
+ }
+ }
+#else
+ /* reset for next time around... */
+ key = STORAGE_INVALID_KEY;
+ initThreadAlloc = 0;
+#endif
}
#endif /* USE_THREAD_ALLOC */
