* generic/tclInt.h:

	* generic/tclObj.c (Tcl_DbIsShared): added support for checking
	result of Tcl_IsShared in evalstats (TCL_COMPILE_STATS).

1 files changed, 19 insertions, 1 deletions

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);
 }