Cleanup of the TclNewObj family of macros, and elimination of the

special Tcl_Obj memory allocator for the TCL_THREADS case, because
this only adds lock contention.


FossilOrigin-Name: cdb2cc1c305f74edf620927a0253a3d831c97cf8

2 files changed, 72 insertions, 133 deletions

diff --git a/generic/tclInt.h b/generic/tclInt.h
index b11e88b..6cf719b 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -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: tclInt.h,v 1.35 1999/08/02 17:45:37 redman Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.36 1999/10/30 00:27:26 welch Exp $
  */
 
 #ifndef _TCLINT
@@ -2025,14 +2025,33 @@ EXTERN int	TclCompileWhileCmd _ANSI_ARGS_((Tcl_Interp *interp,
  *
  * EXTERN void	TclNewObj _ANSI_ARGS_((Tcl_Obj *objPtr));
  * EXTERN void	TclDecrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr));
+ *
+ * There are three variations on these routines for:
+ *	TCL_MEM_DEBUG
+ *	TCL_THREADS
+ *	the normal case
  *----------------------------------------------------------------
  */
 
+/*
+ * TclDecrRefCount is the same for all cases.  The three cases
+ * are handled inside TclFreeObj.
+ */
+
+#define TclDecrRefCount(objPtr) \
+    if (--(objPtr)->refCount <= 0) { \
+	TclFreeObj(objPtr); \
+    }
+
 #ifdef TCL_COMPILE_STATS
 #  define TclIncrObjsAllocated() \
-    tclObjsAlloced++
+    Tcl_MutexLock(&tclCompStatsMutex); \
+    tclObjsAlloced++;
+    Tcl_MutexUnLock(&tclCompStatsMutex)
 #  define TclIncrObjsFreed() \
-    tclObjsFreed++
+    Tcl_MutexLock(&tclCompStatsMutex); \
+    tclObjsFreed++; \
+    Tcl_MutexUnLock(&tclCompStatsMutex)
 #else
 #  define TclIncrObjsAllocated()
 #  define TclIncrObjsFreed()
@@ -2040,47 +2059,40 @@ EXTERN int	TclCompileWhileCmd _ANSI_ARGS_((Tcl_Interp *interp,
 
 #ifdef TCL_MEM_DEBUG
 #  define TclNewObj(objPtr) \
-    (objPtr) = (Tcl_Obj *) \
-	 Tcl_DbCkalloc(sizeof(Tcl_Obj), __FILE__, __LINE__); \
+    TclDbNewObj(objPtr, __FILE__, __LINE__)
+     
+#  define TclDbNewObj(objPtr, file, line) \
+    (objPtr) = (Tcl_Obj *) Tcl_DbCkalloc(sizeof(Tcl_Obj), (file), (line)); \
     (objPtr)->refCount = 0; \
     (objPtr)->bytes    = tclEmptyStringRep; \
     (objPtr)->length   = 0; \
     (objPtr)->typePtr  = NULL; \
     TclIncrObjsAllocated()
      
-#  define TclDbNewObj(objPtr, file, line) \
-    (objPtr) = (Tcl_Obj *) Tcl_DbCkalloc(sizeof(Tcl_Obj), (file), (line)); \
+#else /* not TCL_MEM_DEBUG */
+
+#ifdef TCL_THREADS
+
+/*
+ * The TclAllocateFreeObjects is a source of lock contention,
+ * so we just don't use it and rely on a good threaded memory allocator.
+ */
+
+#  define TclNewObj(objPtr) \
+    (objPtr) = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj)); \
     (objPtr)->refCount = 0; \
     (objPtr)->bytes    = tclEmptyStringRep; \
     (objPtr)->length   = 0; \
     (objPtr)->typePtr  = NULL; \
     TclIncrObjsAllocated()
-     
-#  define TclDecrRefCount(objPtr) \
-    if (--(objPtr)->refCount <= 0) { \
-	if ((objPtr)->refCount < -1) \
-	    panic("Reference count for %lx was negative: %s line %d", \
-		  (objPtr), __FILE__, __LINE__); \
-	if (((objPtr)->bytes != NULL) \
-		&& ((objPtr)->bytes != tclEmptyStringRep)) { \
-	    ckfree((char *) (objPtr)->bytes); \
-	} \
-	if (((objPtr)->typePtr != NULL) \
-		&& ((objPtr)->typePtr->freeIntRepProc != NULL)) { \
-	    (objPtr)->typePtr->freeIntRepProc(objPtr); \
-	} \
-	ckfree((char *) (objPtr)); \
-	TclIncrObjsFreed(); \
-    }
 
-#else /* not TCL_MEM_DEBUG */
+#else
 
-#ifdef TCL_THREADS
-extern Tcl_Mutex tclObjMutex;
-#endif
+/*
+ * Unthreaded case uses a special allocator.
+ */
 
 #  define TclNewObj(objPtr) \
-    Tcl_MutexLock(&tclObjMutex); \
     if (tclFreeObjList == NULL) { \
 	TclAllocateFreeObjects(); \
     } \
@@ -2091,25 +2103,10 @@ extern Tcl_Mutex tclObjMutex;
     (objPtr)->bytes    = tclEmptyStringRep; \
     (objPtr)->length   = 0; \
     (objPtr)->typePtr  = NULL; \
-    TclIncrObjsAllocated(); \
-    Tcl_MutexUnlock(&tclObjMutex)
+    TclIncrObjsAllocated()
+
+#endif /* TCL_THREADS */
 
-#  define TclDecrRefCount(objPtr) \
-    if (--(objPtr)->refCount <= 0) { \
-	if (((objPtr)->bytes != NULL) \
-		&& ((objPtr)->bytes != tclEmptyStringRep)) { \
-	    ckfree((char *) (objPtr)->bytes); \
-	} \
-	if (((objPtr)->typePtr != NULL) \
-		&& ((objPtr)->typePtr->freeIntRepProc != NULL)) { \
-	    (objPtr)->typePtr->freeIntRepProc(objPtr); \
-	} \
-	Tcl_MutexLock(&tclObjMutex); \
-	(objPtr)->internalRep.otherValuePtr = (VOID *) tclFreeObjList; \
-	tclFreeObjList = (objPtr); \
-	TclIncrObjsFreed(); \
-	Tcl_MutexUnlock(&tclObjMutex); \
-    }
 #endif /* TCL_MEM_DEBUG */
 
 /*
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 67be178..900a861 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclObj.c,v 1.9 1999/06/15 01:16:23 hershey Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.10 1999/10/30 00:27:26 welch Exp $
  */
 
 #include "tclInt.h"
@@ -26,20 +26,12 @@ TCL_DECLARE_MUTEX(tableMutex)
 
 /*
  * Head of the list of free Tcl_Obj structs we maintain.
+ * This is not used in the threaded case, so no lock is declared.
  */
 
 Tcl_Obj *tclFreeObjList = NULL;
 
 /*
- * The object allocator is single threaded.  This mutex is referenced
- * by the TclNewObj macro, however, so must be visible.
- */
-
-#ifdef TCL_THREADS
-Tcl_Mutex tclObjMutex;
-#endif
-
-/*
  * Pointer to a heap-allocated string of length zero that the Tcl core uses
  * as the value of an empty string representation for an object. This value
  * is shared by all new objects allocated by Tcl_NewObj.
@@ -56,6 +48,7 @@ char *tclEmptyStringRep = &emptyString;
 #ifdef TCL_COMPILE_STATS
 long tclObjsAlloced = 0;
 long tclObjsFreed = 0;
+TCL_DECLARE_MUTEX(tclCompStatsMutex)
 #endif /* TCL_COMPILE_STATS */
 
 /*
@@ -140,10 +133,10 @@ TclInitObjSubsystem()
     Tcl_RegisterObjType(&tclProcBodyType);
 
 #ifdef TCL_COMPILE_STATS
-    Tcl_MutexLock(&tclObjMutex);
+    Tcl_MutexLock(&tclCompStatsMutex);
     tclObjsAlloced = 0;
     tclObjsFreed = 0;
-    Tcl_MutexUnlock(&tclObjMutex);
+    Tcl_MutexUnlock(&tclCompStatsMutex);
 #endif
 }
 
@@ -174,9 +167,12 @@ TclFinalizeCompExecEnv()
         typeTableInitialized = 0;
     }
     Tcl_MutexUnlock(&tableMutex);
-    Tcl_MutexLock(&tclObjMutex);
+#ifndef TCL_THREADS
+    /*
+     * This would a source of lock contention, so we don't use it.
+     */
     tclFreeObjList = NULL;
-    Tcl_MutexUnlock(&tclObjMutex);
+#endif
 
     TclFinalizeCompilation();
     TclFinalizeExecution();
@@ -389,43 +385,16 @@ Tcl_ConvertToType(interp, objPtr, typePtr)
 
 #ifdef TCL_MEM_DEBUG
 #undef Tcl_NewObj
+#endif
 
 Tcl_Obj *
 Tcl_NewObj()
 {
-    return Tcl_DbNewObj("unknown", 0);
-}
-
-#else /* if not TCL_MEM_DEBUG */
-
-Tcl_Obj *
-Tcl_NewObj()
-{
-    register Tcl_Obj *objPtr;
-
-    /*
-     * Allocate the object using the list of free Tcl_Obj structs
-     * we maintain.
-     */
-
-    Tcl_MutexLock(&tclObjMutex);
-    if (tclFreeObjList == NULL) {
-	TclAllocateFreeObjects();
-    }
-    objPtr = tclFreeObjList;
-    tclFreeObjList = (Tcl_Obj *) tclFreeObjList->internalRep.otherValuePtr;
-    
-    objPtr->refCount = 0;
-    objPtr->bytes    = tclEmptyStringRep;
-    objPtr->length   = 0;
-    objPtr->typePtr  = NULL;
-#ifdef TCL_COMPILE_STATS
-    tclObjsAlloced++;
-#endif /* TCL_COMPILE_STATS */
-    Tcl_MutexUnlock(&tclObjMutex);
+    Tcl_Obj *objPtr;
+    TclNewObj(objPtr);
     return objPtr;
 }
-#endif /* TCL_MEM_DEBUG */
+
 
 /*
  *----------------------------------------------------------------------
@@ -441,7 +410,7 @@ Tcl_NewObj()
  *	number when reporting objects that haven't been freed.
  *
  *	When TCL_MEM_DEBUG is not defined, this procedure just returns the
- *	result of calling Tcl_NewObj.
+ *	result of calling TclNewObj.
  *
  * Results:
  *	The result is a newly allocated that represents the empty string.
@@ -454,7 +423,6 @@ Tcl_NewObj()
  *----------------------------------------------------------------------
  */
 
-#ifdef TCL_MEM_DEBUG
 
 Tcl_Obj *
 Tcl_DbNewObj(file, line)
@@ -464,38 +432,13 @@ Tcl_DbNewObj(file, line)
 				 * for debugging. */
 {
     register Tcl_Obj *objPtr;
-
-    /*
-     * If debugging Tcl's memory usage, allocate the object using ckalloc.
-     * Otherwise, allocate it using the list of free Tcl_Obj structs we
-     * maintain.
-     */
-
-    objPtr = (Tcl_Obj *) Tcl_DbCkalloc(sizeof(Tcl_Obj), file, line);
-    objPtr->refCount = 0;
-    objPtr->bytes    = tclEmptyStringRep;
-    objPtr->length   = 0;
-    objPtr->typePtr  = NULL;
-#ifdef TCL_COMPILE_STATS
-    Tcl_MutexLock(&tclObjMutex);
-    tclObjsAlloced++;
-    Tcl_MutexUnlock(&tclObjMutex);
-#endif /* TCL_COMPILE_STATS */
+#ifdef TCL_MEM_DEBUG
+    TclDbNewObj(objPtr, file, line);
+#else
+    TclNewObj(objPtr);
+#endif
     return objPtr;
 }
-
-#else /* if not TCL_MEM_DEBUG */
-
-Tcl_Obj *
-Tcl_DbNewObj(file, line)
-    char *file;			/* The name of the source file calling this
-				 * procedure; used for debugging. */
-    int line;			/* Line number in the source file; used
-				 * for debugging. */
-{
-    return Tcl_NewObj();
-}
-#endif /* TCL_MEM_DEBUG */
 
 /*
  *----------------------------------------------------------------------
@@ -505,7 +448,7 @@ Tcl_DbNewObj(file, line)
  *	Procedure to allocate a number of free Tcl_Objs. This is done using
  *	a single ckalloc to reduce the overhead for Tcl_Obj allocation.
  *
- *	Assumes mutex is held.
+ *	NOTE: This memory is not freed.
  *
  * Results:
  *	None.
@@ -588,23 +531,22 @@ TclFreeObj(objPtr)
     Tcl_InvalidateStringRep(objPtr);
 
     /*
-     * If debugging Tcl's memory usage, deallocate the object using ckfree.
-     * Otherwise, deallocate it by adding it onto the list of free
-     * Tcl_Obj structs we maintain.
+     * There are three cases, TCL_MEM_DEBUG and TCL_THREADS just use
+     * ckfree.  The normal case uses the special object freelist.
      */
 
-    Tcl_MutexLock(&tclObjMutex);
 #ifdef TCL_MEM_DEBUG
     ckfree((char *) objPtr);
 #else
+#ifdef TCL_THREADS
+    ckfree((char *) objPtr);
+#else
     objPtr->internalRep.otherValuePtr = (VOID *) tclFreeObjList;
     tclFreeObjList = objPtr;
+#endif /* TCL_THREADS */
 #endif /* TCL_MEM_DEBUG */
 
-#ifdef TCL_COMPILE_STATS
-    tclObjsFreed++;
-#endif /* TCL_COMPILE_STATS */
-    Tcl_MutexUnlock(&tclObjMutex);
+    TclIncrObjsFreed();
 }
 
 /*