diff options
| -rw-r--r-- | generic/tclInt.h | 4 | ||||
| -rw-r--r-- | generic/tclObj.c | 20 |
2 files changed, 22 insertions, 2 deletions
diff --git a/generic/tclInt.h b/generic/tclInt.h index 0c26e19..5edf6f1 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.44 2000/05/23 22:10:52 ericm Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.45 2000/05/26 08:51:44 hobbs Exp $ */ #ifndef _TCLINT @@ -1549,6 +1549,8 @@ extern Tcl_Obj * tclFreeObjList; #ifdef TCL_COMPILE_STATS extern long tclObjsAlloced; extern long tclObjsFreed; +#define TCL_MAX_SHARED_OBJ_STATS 5 +extern long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS]; #endif /* TCL_COMPILE_STATS */ /* diff --git a/generic/tclObj.c b/generic/tclObj.c index 73d8cce..ab46fe6 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.13 2000/05/08 22:13:13 hobbs Exp $ + * RCS: @(#) $Id: tclObj.c,v 1.14 2000/05/26 08:51:45 hobbs Exp $ */ #include "tclInt.h" @@ -56,6 +56,7 @@ char *tclEmptyStringRep = &emptyString; #ifdef TCL_COMPILE_STATS long tclObjsAlloced = 0; long tclObjsFreed = 0; +long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 }; #endif /* TCL_COMPILE_STATS */ /* @@ -143,6 +144,12 @@ TclInitObjSubsystem() Tcl_MutexLock(&tclObjMutex); tclObjsAlloced = 0; tclObjsFreed = 0; + { + int i; + for (i = 0; i < TCL_MAX_SHARED_OBJ_STATS; i++) { + tclObjsShared[i] = 0; + } + } Tcl_MutexUnlock(&tclObjMutex); #endif } @@ -2078,5 +2085,16 @@ Tcl_DbIsShared(objPtr, file, line) panic("Trying to check whether previously disposed object is shared."); } #endif +#ifdef TCL_COMPILE_STATS + Tcl_MutexLock(&tclObjMutex); + if ((objPtr)->refCount <= 1) { + tclObjsShared[1]++; + } else if ((objPtr)->refCount < TCL_MAX_SHARED_OBJ_STATS) { + tclObjsShared[(objPtr)->refCount]++; + } else { + tclObjsShared[0]++; + } + Tcl_MutexUnlock(&tclObjMutex); +#endif return ((objPtr)->refCount > 1); } |