summaryrefslogtreecommitdiffstats
path: root/generic/tclObj.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclObj.c')
-rw-r--r--generic/tclObj.c101
1 files changed, 95 insertions, 6 deletions
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 39b8515..23097f6 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.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: tclObj.c,v 1.139.2.4 2009/10/07 23:10:50 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.139.2.5 2009/10/18 11:21:38 mistachkin Exp $
*/
#include "tclInt.h"
@@ -54,6 +54,22 @@ Tcl_Mutex tclObjMutex;
char tclEmptyString = '\0';
char *tclEmptyStringRep = &tclEmptyString;
+#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
+/*
+ * Structure for tracking the source file and line number where a given Tcl_Obj
+ * was allocated. We also track the pointer to the Tcl_Obj itself, for sanity
+ * checking purposes.
+ */
+
+typedef struct ObjData {
+ Tcl_Obj *objPtr; /* The pointer to the allocated Tcl_Obj. */
+ CONST char *file; /* The name of the source file calling this
+ * function; used for debugging. */
+ int line; /* Line number in the source file; used for
+ * debugging. */
+} ObjData;
+#endif /* TCL_MEM_DEBUG && TCL_THREADS */
+
/*
* All static variables used in this file are collected into a single instance
* of the following structure. For multi-threaded implementations, there is
@@ -81,6 +97,7 @@ typedef struct ThreadSpecificData {
* Thread local table that is used to check that a Tcl_Obj was not
* allocated by some other thread.
*/
+
Tcl_HashTable *objThreadMap;
#endif /* TCL_MEM_DEBUG && TCL_THREADS */
} ThreadSpecificData;
@@ -960,6 +977,55 @@ Tcl_ConvertToType(
}
/*
+ *--------------------------------------------------------------
+ *
+ * TclDbDumpActiveObjects --
+ *
+ * This function is called to dump all of the active Tcl_Obj structs this
+ * allocator knows about.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TclDbDumpActiveObjects(
+ FILE *outFile)
+{
+#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
+ Tcl_HashSearch hSearch;
+ Tcl_HashEntry *hPtr;
+ Tcl_HashTable *tablePtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ tablePtr = tsdPtr->objThreadMap;
+
+ if (tablePtr != NULL) {
+ fprintf(outFile, "total objects: %d\n", tablePtr->numEntries);
+ for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSearch); hPtr != NULL;
+ hPtr = Tcl_NextHashEntry(&hSearch)) {
+ ObjData *objData = Tcl_GetHashValue(hPtr);
+
+ if (objData != NULL) {
+ fprintf(outFile,
+ "key = 0x%p, objPtr = 0x%p, file = %s, line = %d\n",
+ Tcl_GetHashKey(tablePtr, hPtr), objData->objPtr,
+ objData->file, objData->line);
+ } else {
+ fprintf(outFile, "key = 0x%p\n",
+ Tcl_GetHashKey(tablePtr, hPtr));
+ }
+ }
+ }
+#endif
+}
+
+/*
*----------------------------------------------------------------------
*
* TclDbInitNewObj --
@@ -980,7 +1046,11 @@ Tcl_ConvertToType(
#ifdef TCL_MEM_DEBUG
void
TclDbInitNewObj(
- register Tcl_Obj *objPtr)
+ register Tcl_Obj *objPtr,
+ register CONST char *file, /* The name of the source file calling this
+ * function; used for debugging. */
+ register int line) /* Line number in the source file; used for
+ * debugging. */
{
objPtr->refCount = 0;
objPtr->bytes = tclEmptyStringRep;
@@ -997,7 +1067,8 @@ TclDbInitNewObj(
Tcl_HashEntry *hPtr;
Tcl_HashTable *tablePtr;
int isNew;
- ThreadSpecificData *tsdPtr = TclGetContLineTable();
+ ObjData *objData;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (tsdPtr->objThreadMap == NULL) {
tsdPtr->objThreadMap = (Tcl_HashTable *)
@@ -1009,7 +1080,16 @@ TclDbInitNewObj(
if (!isNew) {
Tcl_Panic("expected to create new entry for object map");
}
- Tcl_SetHashValue(hPtr, NULL);
+
+ /*
+ * Record the debugging information.
+ */
+
+ objData = (ObjData *) ckalloc(sizeof(ObjData));
+ objData->objPtr = objPtr;
+ objData->file = file;
+ objData->line = line;
+ Tcl_SetHashValue(hPtr, objData);
}
#endif /* TCL_THREADS */
}
@@ -3596,8 +3676,17 @@ Tcl_DbDecrRefCount(
"Tcl_Obj allocated in another thread");
}
- /* If the Tcl_Obj is going to be deleted, remove the entry */
- if ((((objPtr)->refCount) - 1) <= 0) {
+ /*
+ * If the Tcl_Obj is going to be deleted, remove the entry.
+ */
+
+ if ((objPtr->refCount - 1) <= 0) {
+ ObjData *objData = Tcl_GetHashValue(hPtr);
+
+ if (objData != NULL) {
+ ckfree((char *) objData);
+ }
+
Tcl_DeleteHashEntry(hPtr);
}
}