summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorhobbs <hobbs>1999-11-10 02:51:56 (GMT)
committerhobbs <hobbs>1999-11-10 02:51:56 (GMT)
commit92091cf22933ea53ced7f0ec22fdc6d1d33077aa (patch)
tree08a12b832ed3d87eab5e754f4607d7dd15e9d077
parent284e6ca672d27e0c62c184d39089428622a453c1 (diff)
downloadtcl-92091cf22933ea53ced7f0ec22fdc6d1d33077aa.zip
tcl-92091cf22933ea53ced7f0ec22fdc6d1d33077aa.tar.gz
tcl-92091cf22933ea53ced7f0ec22fdc6d1d33077aa.tar.bz2
* 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
-rw-r--r--generic/tclIOUtil.c8
-rw-r--r--generic/tclInt.h91
-rw-r--r--generic/tclObj.c114
-rw-r--r--generic/tclParse.c37
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;