diff options
Diffstat (limited to 'generic/tclObj.c')
| -rw-r--r-- | generic/tclObj.c | 101 |
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); } } |