* generic/tclBasic.c: Made use of the thread's alloc cache

	* generic/tclInt.h:    stored in the ekeko at interp creation
	* generic/tclNRE.h:    to avoid hitting the TSD each time an
	* generic/tclThreadAlloc.c: NRE callback is pushed or pulled; the
	approach is suitably general to extend to evry other obj
	allocation where an interp is know; this is left for some other
	time, requires a lot of grunt work.

5 files changed, 110 insertions, 32 deletions

diff --git a/ChangeLog b/ChangeLog
index 0bd884d..e471e99 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,13 @@
 2008-07-29  Miguel Sofer  <msofer@users.sf.net>
 
+	* generic/tclBasic.c:  Made use of the thread's alloc cache
+	* generic/tclInt.h:    stored in the ekeko at interp creation
+	* generic/tclNRE.h:    to avoid hitting the TSD each time an 
+	* generic/tclThreadAlloc.c: NRE callback is pushed or pulled; the
+	approach is suitably general to extend to evry other obj
+	allocation where an interp is know; this is left for some other
+	time, requires a lot of grunt work.
+
 	* generic/tclExecute.c:  fix [Bug 2030670] that cause
 	TclStackRealloc to panic on rare corner cases. Thx ajpasadyn for
 	diagnose and patch.
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index cb96099..3e5c1cf 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -16,7 +16,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclBasic.c,v 1.333 2008/07/29 05:30:25 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.334 2008/07/29 18:19:10 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -692,7 +692,8 @@ Tcl_CreateInterp(void)
     TclInitLimitSupport(interp);
 
     /*
-     * Initialise the thread-specific data ekeko.
+     * Initialise the thread-specific data ekeko. Note that the thread's alloc
+     * cache was already initialised by the call to alloc the interp struct.
      */
 
 #if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 1b10fc6..fb77ec5 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -14,7 +14,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInt.h,v 1.380 2008/07/29 05:30:32 msofer Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.381 2008/07/29 18:19:12 msofer Exp $
  */
 
 #ifndef _TCLINT
@@ -1602,6 +1602,24 @@ enum PkgPreferOptions {
 
 /*
  *----------------------------------------------------------------
+ * This structure shadows the first few fields of the memory cache for the
+ * allocator defined in tclThreadAlloc.c; it has to be kept in sync with the
+ * definition there.
+ * Some macros require knowledge of some fields in the struct in order to
+ * avoid hitting the TSD unnecessarily. In order to facilitate this, a pointer
+ * to the relevant fields is kept in the objCache field in struct Interp.
+ *----------------------------------------------------------------
+ */
+
+typedef struct AllocCache {
+    struct Cache *nextPtr;	/* Linked list of cache entries */
+    Tcl_ThreadId owner;		/* Which thread's cache is this? */
+    Tcl_Obj *firstObjPtr;	/* List of free objects for thread */
+    int numObjects;		/* Number of objects for thread */
+} AllocCache;
+
+/*
+ *----------------------------------------------------------------
  * This structure defines an interpreter, which is a collection of commands
  * plus other state information related to interpreting commands, such as
  * variable storage. Primary responsibility for this data structure is in
@@ -1928,17 +1946,12 @@ typedef struct Interp {
      * They are used by the macros defined below.
      */
 
-    void *allocCache;
+    AllocCache *allocCache;
     void *pendingObjDataPtr;	/* Pointer to the Cache and PendingObjData
 				 * structs for this interp's thread; see
 				 * tclObj.c and tclThreadAlloc.c */
     int *asyncReadyPtr;		/* Pointer to the asyncReady indicator for
 				 * this interp's thread; see tclAsync.c */
-    int *stackBound;		/* Pointer to the limit stack address
-				 * allowable for invoking a new command
-				 * without "risking" a C-stack overflow; see
-				 * TclpCheckStackSpace in the platform's
-				 * directory. */
 
     /*
      * The pointer to the object system root ekeko. c.f. TIP #257.
@@ -3411,6 +3424,12 @@ MODULE_SCOPE unsigned	TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr);
 #  define TclIncrObjsFreed()
 #endif /* TCL_COMPILE_STATS */
 
+#  define TclAllocObjStorage(objPtr)		\
+        TclAllocObjStorageEx(NULL, (objPtr))
+
+#  define TclFreeObjStorage(objPtr)		\
+        TclFreeObjStorageEx(NULL, (objPtr))
+
 #ifndef TCL_MEM_DEBUG
 # define TclNewObj(objPtr) \
     TclIncrObjsAllocated(); \
@@ -3453,10 +3472,10 @@ MODULE_SCOPE unsigned	TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr);
  * track memory leaks
  */
 
-#  define TclAllocObjStorage(objPtr) \
+#  define TclAllocObjStorageEx(interp, objPtr)			\
 	(objPtr) = (Tcl_Obj *) Tcl_Alloc(sizeof(Tcl_Obj))
 
-#  define TclFreeObjStorage(objPtr) \
+#  define TclFreeObjStorageEx(interp, objPtr)	\
 	ckfree((char *) (objPtr))
 
 #undef USE_THREAD_ALLOC
@@ -3476,11 +3495,43 @@ MODULE_SCOPE void	TclpSetAllocCache(void *);
 MODULE_SCOPE void	TclpFreeAllocMutex(Tcl_Mutex *mutex);
 MODULE_SCOPE void	TclpFreeAllocCache(void *);
 
-#  define TclAllocObjStorage(objPtr) \
-	(objPtr) = TclThreadAllocObj()
-
-#  define TclFreeObjStorage(objPtr) \
-	TclThreadFreeObj((objPtr))
+/*
+ * These macros need to be kept in sync with the code of TclThreadAllocObj()
+ * and TclThreadFreeObj().
+ *
+ * Note that the optimiser should resolve the case (interp==NULL) at compile
+ * time. 
+ */
+
+#  define ALLOC_NOBJHIGH 1200
+
+#  define TclAllocObjStorageEx(interp, objPtr)				\
+    do {								\
+	AllocCache *cachePtr;						\
+	if (((interp) == NULL) ||					\
+		((cachePtr = ((Interp *)(interp))->allocCache),		\
+			(cachePtr->numObjects == 0))) {			\
+	    (objPtr) = TclThreadAllocObj();				\
+	} else {							\
+	    (objPtr) = cachePtr->firstObjPtr;				\
+	    cachePtr->firstObjPtr = (objPtr)->internalRep.otherValuePtr; \
+	    --cachePtr->numObjects;					\
+	}								\
+    } while (0)
+	
+#  define TclFreeObjStorageEx(interp, objPtr)				\
+    do {								\
+	AllocCache *cachePtr;						\
+	if (((interp) == NULL) ||					\
+		((cachePtr = ((Interp *)(interp))->allocCache),		\
+			(cachePtr->numObjects >= ALLOC_NOBJHIGH))) {	\
+	    TclThreadFreeObj(objPtr);					\
+	} else {							\
+	    (objPtr)->internalRep.otherValuePtr = cachePtr->firstObjPtr; \
+	    cachePtr->firstObjPtr = objPtr;				\
+	    ++cachePtr->numObjects;					\
+	}								\
+    } while (0)
 
 #else /* not PURIFY or USE_THREAD_ALLOC */
 
@@ -3489,7 +3540,7 @@ MODULE_SCOPE void	TclpFreeAllocCache(void *);
 MODULE_SCOPE Tcl_Mutex	tclObjMutex;
 #endif
 
-#  define TclAllocObjStorage(objPtr) \
+#  define TclAllocObjStorageEx(interp, objPtr)	\
 	Tcl_MutexLock(&tclObjMutex); \
 	if (tclFreeObjList == NULL) { \
 	    TclAllocateFreeObjects(); \
@@ -3499,7 +3550,7 @@ MODULE_SCOPE Tcl_Mutex	tclObjMutex;
 		tclFreeObjList->internalRep.otherValuePtr; \
 	Tcl_MutexUnlock(&tclObjMutex)
 
-#  define TclFreeObjStorage(objPtr) \
+#  define TclFreeObjStorageEx(interp, objPtr)	\
 	Tcl_MutexLock(&tclObjMutex); \
 	(objPtr)->internalRep.otherValuePtr = (void *) tclFreeObjList; \
 	tclFreeObjList = (objPtr); \
@@ -3957,8 +4008,14 @@ MODULE_SCOPE void	TclBNInitBignumFromWideUInt(mp_int *bignum,
  * DO NOT LET THEM CROSS THREAD BOUNDARIES
  */
 
+#define TclSmallAlloc(nbytes, memPtr)		\
+    TclSmallAllocEx(NULL, (nbytes), (memPtr))
+
+#define TclSmallFree(memPtr)			\
+    TclSmallFreeEx(NULL, (memPtr))
+
 #ifndef TCL_MEM_DEBUG
-#define TclSmallAlloc(nbytes, memPtr)					\
+#define TclSmallAllocEx(interp, nbytes, memPtr)				\
     {									\
 	Tcl_Obj *objPtr;						\
 	switch ((nbytes)>sizeof(Tcl_Obj)) {				\
@@ -3969,16 +4026,16 @@ MODULE_SCOPE void	TclBNInitBignumFromWideUInt(mp_int *bignum,
 	    case 0: (void)0;						\
 	}								\
 	TclIncrObjsAllocated();						\
-	TclAllocObjStorage(objPtr);					\
-	memPtr = (ClientData) objPtr;					\
+	TclAllocObjStorageEx((interp), (objPtr));			\
+	memPtr = (ClientData) (objPtr);					\
     }
 
-#define TclSmallFree(memPtr)			\
-    TclFreeObjStorage((Tcl_Obj *) memPtr);	\
+#define TclSmallFreeEx(interp, memPtr)		\
+    TclFreeObjStorageEx((interp), (Tcl_Obj *) (memPtr));	\
     TclIncrObjsFreed()
 
 #else    /* TCL_MEM_DEBUG */
-#define TclSmallAlloc(nbytes, memPtr)					\
+#define TclSmallAllocEx(interp, nbytes, memPtr)				\
     {									\
 	Tcl_Obj *objPtr;						\
 	switch ((nbytes)>sizeof(Tcl_Obj)) {				\
@@ -3992,7 +4049,7 @@ MODULE_SCOPE void	TclBNInitBignumFromWideUInt(mp_int *bignum,
 	memPtr = (ClientData) objPtr;					\
     }
 
-#define TclSmallFree(memPtr)						\
+#define TclSmallFreeEx(interp, memPtr)					\
     {									\
 	Tcl_Obj *objPtr = (Tcl_Obj *) memPtr;				\
 	objPtr->bytes = NULL;						\
diff --git a/generic/tclNRE.h b/generic/tclNRE.h
index a90bc8d..3943cfb 100644
--- a/generic/tclNRE.h
+++ b/generic/tclNRE.h
@@ -11,7 +11,7 @@
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
  * // FIXME: RCS numbering?
- * RCS: @(#) $Id: tclNRE.h,v 1.8 2008/07/29 05:52:29 msofer Exp $
+ * RCS: @(#) $Id: tclNRE.h,v 1.9 2008/07/29 18:19:17 msofer Exp $
  */
 
 
@@ -82,10 +82,10 @@ MODULE_SCOPE Tcl_ObjCmdProc TclTailcallObjCmd;
  *****************************************************************************/
 
 #if USE_SMALL_ALLOC
-#define TCLNR_ALLOC(interp, ptr) TclSmallAlloc(sizeof(TEOV_callback), ptr)
-#define TCLNR_FREE(interp, ptr)  TclSmallFree((ptr))
+#define TCLNR_ALLOC(interp, ptr) TclSmallAllocEx(interp, sizeof(TEOV_callback), (ptr))
+#define TCLNR_FREE(interp, ptr)  TclSmallFreeEx((interp), (ptr))
 #else
-#define TCLNR_ALLOC(interp, size, ptr) (ptr = ((ClientData) ckalloc(sizeof(TEOV_callback))))
+#define TCLNR_ALLOC(interp, ptr) (ptr = ((ClientData) ckalloc(sizeof(TEOV_callback))))
 #define TCLNR_FREE(interp, ptr)  ckfree((char *) (ptr))
 #endif
 
diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c
index 0850d66..a448328 100755
--- a/generic/tclThreadAlloc.c
+++ b/generic/tclThreadAlloc.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclThreadAlloc.c,v 1.27 2008/03/20 09:49:16 dkf Exp $
+ * RCS: @(#) $Id: tclThreadAlloc.c,v 1.28 2008/07/29 18:19:17 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -37,7 +37,9 @@
  */
 
 #define NOBJALLOC	800
-#define NOBJHIGH	1200
+
+/* Actual definition moved to tclInt.h */
+#define NOBJHIGH	ALLOC_NOBJHIGH
 
 /*
  * The following union stores accounting information for each block including
@@ -97,7 +99,9 @@ typedef struct Bucket {
 
 /*
  * The following structure defines a cache of buckets and objs, of which there
- * will be (at most) one per thread.
+ * will be (at most) one per thread. Any changes need to be reflected in the
+ * struct AllocCache defined in tclInt.h, possibly also in the initialisation
+ * code in Tcl_CreateInterp().
  */
 
 typedef struct Cache {
@@ -490,6 +494,10 @@ TclpRealloc(
  *	May move Tcl_Obj's from shared cached or allocate new Tcl_Obj's if
  *	list is empty.
  *
+ * Note:
+ *      If this code is updated, the changes need to be reflected in the
+ *      macro TclAllocObjStorageEx() defined in tclInt.h
+ *
  *----------------------------------------------------------------------
  */
 
@@ -559,6 +567,10 @@ TclThreadAllocObj(void)
  * Side effects:
  *	May move free Tcl_Obj's to shared list upon hitting high water mark.
  *
+ * Note:
+ *      If this code is updated, the changes need to be reflected in the
+ *      macro TclAllocObjStorageEx() defined in tclInt.h
+ *
  *----------------------------------------------------------------------
  */