* generic/tclIOUtil.c: changed Tcl_Alloc to ckalloc

	* generic/tclInt.h:
	* generic/tclObj.c: rolled back changes from 1999-10-29
	Purify noted new leaks with that code

	* generic/tclParse.c: added code in Tcl_ParseBraces to test for
	possible unbalanced open brace in a comment

4 files changed, 173 insertions, 77 deletions

diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 9f9969a..65dca78 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclIOUtil.c,v 1.8 1999/04/21 21:50:26 rjohnson Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.9 1999/11/10 02:51:56 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -593,7 +593,7 @@ TclStatInsertProc (proc)
     if (proc != NULL) {
 	StatProc *newStatProcPtr;
 
-	newStatProcPtr = (StatProc *)Tcl_Alloc(sizeof(StatProc));;
+	newStatProcPtr = (StatProc *)ckalloc(sizeof(StatProc));
 
 	if (newStatProcPtr != NULL) {
 	    newStatProcPtr->proc = proc;
@@ -696,7 +696,7 @@ TclAccessInsertProc(proc)
     if (proc != NULL) {
 	AccessProc *newAccessProcPtr;
 
-	newAccessProcPtr = (AccessProc *)Tcl_Alloc(sizeof(AccessProc));;
+	newAccessProcPtr = (AccessProc *)ckalloc(sizeof(AccessProc));
 
 	if (newAccessProcPtr != NULL) {
 	    newAccessProcPtr->proc = proc;
@@ -801,7 +801,7 @@ TclOpenFileChannelInsertProc(proc)
 	OpenFileChannelProc *newOpenFileChannelProcPtr;
 
 	newOpenFileChannelProcPtr =
-		(OpenFileChannelProc *)Tcl_Alloc(sizeof(OpenFileChannelProc));;
+		(OpenFileChannelProc *)ckalloc(sizeof(OpenFileChannelProc));
 
 	if (newOpenFileChannelProcPtr != NULL) {
 	    newOpenFileChannelProcPtr->proc = proc;
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 6cf719b..0be91e1 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.36 1999/10/30 00:27:26 welch Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.37 1999/11/10 02:51:56 hobbs Exp $
  */
 
 #ifndef _TCLINT
@@ -2025,33 +2025,14 @@ 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() \
-    Tcl_MutexLock(&tclCompStatsMutex); \
-    tclObjsAlloced++;
-    Tcl_MutexUnLock(&tclCompStatsMutex)
+    tclObjsAlloced++
 #  define TclIncrObjsFreed() \
-    Tcl_MutexLock(&tclCompStatsMutex); \
-    tclObjsFreed++; \
-    Tcl_MutexUnLock(&tclCompStatsMutex)
+    tclObjsFreed++
 #else
 #  define TclIncrObjsAllocated()
 #  define TclIncrObjsFreed()
@@ -2059,40 +2040,47 @@ EXTERN int	TclCompileWhileCmd _ANSI_ARGS_((Tcl_Interp *interp,
 
 #ifdef TCL_MEM_DEBUG
 #  define TclNewObj(objPtr) \
-    TclDbNewObj(objPtr, __FILE__, __LINE__)
-     
-#  define TclDbNewObj(objPtr, file, line) \
-    (objPtr) = (Tcl_Obj *) Tcl_DbCkalloc(sizeof(Tcl_Obj), (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()
      
-#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)); \
+#  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 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
+#else /* not TCL_MEM_DEBUG */
 
-/*
- * Unthreaded case uses a special allocator.
- */
+#ifdef TCL_THREADS
+extern Tcl_Mutex tclObjMutex;
+#endif
 
 #  define TclNewObj(objPtr) \
+    Tcl_MutexLock(&tclObjMutex); \
     if (tclFreeObjList == NULL) { \
 	TclAllocateFreeObjects(); \
     } \
@@ -2103,10 +2091,25 @@ EXTERN int	TclCompileWhileCmd _ANSI_ARGS_((Tcl_Interp *interp,
     (objPtr)->bytes    = tclEmptyStringRep; \
     (objPtr)->length   = 0; \
     (objPtr)->typePtr  = NULL; \
-    TclIncrObjsAllocated()
-
-#endif /* TCL_THREADS */
+    TclIncrObjsAllocated(); \
+    Tcl_MutexUnlock(&tclObjMutex)
 
+#  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 900a861..e83d70a 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.10 1999/10/30 00:27:26 welch Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.11 1999/11/10 02:51:57 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -26,12 +26,20 @@ 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.
@@ -48,7 +56,6 @@ char *tclEmptyStringRep = &emptyString;
 #ifdef TCL_COMPILE_STATS
 long tclObjsAlloced = 0;
 long tclObjsFreed = 0;
-TCL_DECLARE_MUTEX(tclCompStatsMutex)
 #endif /* TCL_COMPILE_STATS */
 
 /*
@@ -133,10 +140,10 @@ TclInitObjSubsystem()
     Tcl_RegisterObjType(&tclProcBodyType);
 
 #ifdef TCL_COMPILE_STATS
-    Tcl_MutexLock(&tclCompStatsMutex);
+    Tcl_MutexLock(&tclObjMutex);
     tclObjsAlloced = 0;
     tclObjsFreed = 0;
-    Tcl_MutexUnlock(&tclCompStatsMutex);
+    Tcl_MutexUnlock(&tclObjMutex);
 #endif
 }
 
@@ -167,12 +174,9 @@ TclFinalizeCompExecEnv()
         typeTableInitialized = 0;
     }
     Tcl_MutexUnlock(&tableMutex);
-#ifndef TCL_THREADS
-    /*
-     * This would a source of lock contention, so we don't use it.
-     */
+    Tcl_MutexLock(&tclObjMutex);
     tclFreeObjList = NULL;
-#endif
+    Tcl_MutexUnlock(&tclObjMutex);
 
     TclFinalizeCompilation();
     TclFinalizeExecution();
@@ -385,16 +389,43 @@ Tcl_ConvertToType(interp, objPtr, typePtr)
 
 #ifdef TCL_MEM_DEBUG
 #undef Tcl_NewObj
-#endif
 
 Tcl_Obj *
 Tcl_NewObj()
 {
-    Tcl_Obj *objPtr;
-    TclNewObj(objPtr);
-    return objPtr;
+    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);
+    return objPtr;
+}
+#endif /* TCL_MEM_DEBUG */
 
 /*
  *----------------------------------------------------------------------
@@ -410,7 +441,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 TclNewObj.
+ *	result of calling Tcl_NewObj.
  *
  * Results:
  *	The result is a newly allocated that represents the empty string.
@@ -423,6 +454,7 @@ Tcl_NewObj()
  *----------------------------------------------------------------------
  */
 
+#ifdef TCL_MEM_DEBUG
 
 Tcl_Obj *
 Tcl_DbNewObj(file, line)
@@ -432,13 +464,38 @@ Tcl_DbNewObj(file, line)
 				 * for debugging. */
 {
     register Tcl_Obj *objPtr;
-#ifdef TCL_MEM_DEBUG
-    TclDbNewObj(objPtr, file, line);
-#else
-    TclNewObj(objPtr);
-#endif
+
+    /*
+     * 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 */
     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 */
 
 /*
  *----------------------------------------------------------------------
@@ -448,7 +505,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.
  *
- *	NOTE: This memory is not freed.
+ *	Assumes mutex is held.
  *
  * Results:
  *	None.
@@ -531,22 +588,23 @@ TclFreeObj(objPtr)
     Tcl_InvalidateStringRep(objPtr);
 
     /*
-     * There are three cases, TCL_MEM_DEBUG and TCL_THREADS just use
-     * ckfree.  The normal case uses the special object freelist.
+     * 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.
      */
 
+    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 */
 
-    TclIncrObjsFreed();
+#ifdef TCL_COMPILE_STATS
+    tclObjsFreed++;
+#endif /* TCL_COMPILE_STATS */
+    Tcl_MutexUnlock(&tclObjMutex);
 }
 
 /*
diff --git a/generic/tclParse.c b/generic/tclParse.c
index 56b0a05..ab50ac4 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -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: tclParse.c,v 1.12 1999/08/12 23:14:42 stanton Exp $
+ * RCS: @(#) $Id: tclParse.c,v 1.13 1999/11/10 02:51:57 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -1973,9 +1973,44 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr)
 		src += length;
 	    }
 	} else if (src == end) {
+	    int openBrace;
+
 	    if (interp != NULL) {
 		Tcl_SetResult(interp, "missing close-brace", TCL_STATIC);
 	    }
+	    /*
+	     *  Search the source string for a possible open
+	     *  brace within the context of a comment.  Since we
+	     *  aren't performing a full Tcl parse, just look for
+	     *  an open brace preceeded by a '<whitspace>#' on 
+	     *  the same line.
+	     */
+	    openBrace = 0;
+	    while (src > string ) {
+		switch (*src) {
+		    case '{': 
+			openBrace = 1; 
+			break;
+		    case '\n':
+			openBrace = 0; 
+			break;
+		    case '#':
+			if ((openBrace == 1) && (isspace(UCHAR(src[-1])))) {
+			    if (interp != NULL) {
+				Tcl_AppendResult(interp,
+					": possible unbalanced brace in comment",
+					(char *) NULL);
+			    }
+			    openBrace = -1;
+			    break;
+			}
+			break;
+		}
+		if (openBrace == -1) {
+		    break;
+		}
+		src--;
+	    }
 	    parsePtr->errorType = TCL_PARSE_MISSING_BRACE;
 	    parsePtr->term = string;
 	    parsePtr->incomplete = 1;