summaryrefslogtreecommitdiffstats
path: root/generic/tclObj.c
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 /generic/tclObj.c
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
Diffstat (limited to 'generic/tclObj.c')
-rw-r--r--generic/tclObj.c114
1 files changed, 86 insertions, 28 deletions
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);
}
/*