* generic/tclAlloc.c:

        * generic/tclInt.h:
        * generic/tclThreadAlloc.c (new):
        * unix/Makefile.in:
        * unix/tclUnixThrd.c:
        * win/Makefile.in:
        * win/tclWinInt.h:
        * win/tclWinThrd.c: added new threaded allocator contributed by
        AOL that significantly reduces lock contention when multiple
        threads are in use.  Only Windows and Unix implementations are
        ready, and the Windows one may need work.  It is only used by
        default on Unix for now, and requires that USE_THREAD_ALLOC be
        defined (--enable-threads on Unix will define this).

3 files changed, 86 insertions, 4 deletions

diff --git a/win/Makefile.in b/win/Makefile.in
index 56082fc..0c76143 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -5,7 +5,7 @@
 # "autoconf" program (constructs like "@foo@" will get replaced in the
 # actual Makefile.
 #
-# RCS: @(#) $Id: Makefile.in,v 1.60 2002/04/22 22:42:37 hobbs Exp $
+# RCS: @(#) $Id: Makefile.in,v 1.61 2002/04/23 17:03:35 hobbs Exp $
 
 VERSION = @TCL_VERSION@
 
@@ -258,6 +258,7 @@ GENERIC_OBJS = \
 	tclStubInit.$(OBJEXT) \
 	tclStubLib.$(OBJEXT) \
 	tclThread.$(OBJEXT) \
+	tclThreadAlloc.$(OBJEXT) \
 	tclThreadJoin.$(OBJEXT) \
 	tclTimer.$(OBJEXT) \
 	tclUtf.$(OBJEXT) \
diff --git a/win/tclWinInt.h b/win/tclWinInt.h
index 3ed0143..f0e8e42 100644
--- a/win/tclWinInt.h
+++ b/win/tclWinInt.h
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclWinInt.h,v 1.13 2002/03/22 23:37:39 hobbs Exp $
+ * RCS: @(#) $Id: tclWinInt.h,v 1.14 2002/04/23 17:03:35 hobbs Exp $
  */
 
 #ifndef _TCLWININT
@@ -102,6 +102,13 @@ EXTERN TclWinProcs *tclWinProcs;
  */
 
 EXTERN void		TclWinInit(HINSTANCE hInst);
+#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
+EXTERN void		TclWinFreeAllocCache(void);
+EXTERN void		TclFreeAllocCache(void *);
+EXTERN Tcl_Mutex	*TclpNewAllocMutex(void);
+EXTERN void		*TclpGetAllocCache(void);
+EXTERN void		TclpSetAllocCache(void *);
+#endif /* TCL_THREADS */
 
 #include "tclIntPlatDecls.h"
 
diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c
index e25b145..10a886c 100644
--- a/win/tclWinThrd.c
+++ b/win/tclWinThrd.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclWinThrd.c,v 1.18 2001/09/07 18:57:20 mdejong Exp $
+ * RCS: @(#) $Id: tclWinThrd.c,v 1.19 2002/04/23 17:03:35 hobbs Exp $
  */
 
 #include "tclWinInt.h"
@@ -367,7 +367,12 @@ Tcl_Mutex *
 Tcl_GetAllocMutex()
 {
 #ifdef TCL_THREADS
-    InitializeCriticalSection(&allocLock);
+    static int once = 0;
+
+    if (!once) {
+	InitializeCriticalSection(&allocLock);
+	once = 1;
+    }
     return &allocLockPtr;
 #else
     return NULL;
@@ -628,6 +633,14 @@ TclpFinalizeThreadData(keyPtr)
 {
     VOID *result;
     DWORD *indexPtr;
+#ifdef USE_THREAD_ALLOC
+    static int once = 0;
+
+    if (!once) {
+	once = 1;
+	TclWinFreeAllocCache();
+    }
+#endif
 
     if (*keyPtr != NULL) {
 	indexPtr = *(DWORD **)keyPtr;
@@ -970,4 +983,65 @@ TclpFinalizeCondition(condPtr)
 	*condPtr = NULL;
     }
 }
+
+/*
+ * Additions by AOL for specialized thread memory allocator.
+ */
+#ifdef USE_THREAD_ALLOC
+static DWORD key;
+
+Tcl_Mutex *
+TclpNewAllocMutex(void)
+{
+    struct lock {
+        Tcl_Mutex        tlock;
+        CRITICAL_SECTION wlock;
+    } *lockPtr;
+
+    lockPtr = malloc(sizeof(struct lock));
+    if (lockPtr == NULL) {
+	panic("could not allocate lock");
+    }
+    lockPtr->tlock = (Tcl_Mutex) &lockPtr->wlock;
+    InitializeCriticalSection(&lockPtr->wlock);
+    return &lockPtr->tlock;
+}
+
+void *
+TclpGetAllocCache(void)
+{
+    static int once = 0;
+
+    if (!once) {
+	/*
+	 * 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) {
+	    panic("could not allocate thread local storage");
+	}
+    }
+    return TlsGetValue(key);
+}
+
+void
+TclpSetAllocCache(void *ptr)
+{
+    TlsSetValue(key, ptr);
+}
+
+void
+TclWinFreeAllocCache(void)
+{
+    void *ptr;
+
+    ptr = TlsGetValue(key);
+    TlsSetValue(key, NULL);
+    TclFreeAllocCache(ptr);
+}
+
+#endif /* USE_THREAD_ALLOC */
 #endif /* TCL_THREADS */