summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorhobbs <hobbs>2000-05-26 08:51:44 (GMT)
committerhobbs <hobbs>2000-05-26 08:51:44 (GMT)
commit72217c070e0958b9982d859aa9bad1248fb95f20 (patch)
tree0a21675c34ab5430f4c907a72ae464e0846bac80
parenteb8c96f7b284ef2edd736fb55e5ff1ea399c631a (diff)
downloadtcl-72217c070e0958b9982d859aa9bad1248fb95f20.zip
tcl-72217c070e0958b9982d859aa9bad1248fb95f20.tar.gz
tcl-72217c070e0958b9982d859aa9bad1248fb95f20.tar.bz2
* generic/tclInt.h:
* generic/tclObj.c (Tcl_DbIsShared): added support for checking result of Tcl_IsShared in evalstats (TCL_COMPILE_STATS).
-rw-r--r--generic/tclInt.h4
-rw-r--r--generic/tclObj.c20
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);
}