diff options
author | das <das> | 2007-09-13 15:27:06 (GMT) |
---|---|---|
committer | das <das> | 2007-09-13 15:27:06 (GMT) |
commit | b4f7e9054826f3cb4b839a9b91a987782829d802 (patch) | |
tree | ff84ac1598db6f87abe1e043a82b5a9358b11f52 /generic/tclObj.c | |
parent | aa1f9091eb3bb99bc9e42cff663cb010f63e7d8c (diff) | |
download | tcl-b4f7e9054826f3cb4b839a9b91a987782829d802.zip tcl-b4f7e9054826f3cb4b839a9b91a987782829d802.tar.gz tcl-b4f7e9054826f3cb4b839a9b91a987782829d802.tar.bz2 |
* generic/tclDTrace.d (new file): add DTrace provider for Tcl; allows
* generic/tclCompile.h: tracing of proc and command entry &
* generic/tclBasic.c: return, bytecode execution, object
* generic/tclExecute.c: allocation and more; with essentially
* generic/tclInt.h: zero cost when tracing is inactive;
* generic/tclObj.c: enable with --enable-dtrace configure
* generic/tclProc.c: arg (disabled by default, will only
* unix/Makefile.in: enable if DTrace is present).
* unix/configure.in: [Patch 1793984]
* macosx/GNUmakefile: enable DTrace support.
* macosx/Tcl-Common.xcconfig:
* macosx/Tcl.xcodeproj/project.pbxproj:
* unix/configure: autoconf-2.59
* unix/tclConfig.h.in: autoheader-2.59
Diffstat (limited to 'generic/tclObj.c')
-rw-r--r-- | generic/tclObj.c | 16 |
1 files changed, 9 insertions, 7 deletions
diff --git a/generic/tclObj.c b/generic/tclObj.c index 574947b..ee9807d 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -8,11 +8,12 @@ * Copyright (c) 1999 by Scriptics Corporation. * Copyright (c) 2001 by ActiveState Corporation. * Copyright (c) 2005 by Kevin B. Kenny. All rights reserved. + * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net> * * 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.134 2007/09/09 19:28:31 dgp Exp $ + * RCS: @(#) $Id: tclObj.c,v 1.135 2007/09/13 15:27:08 das Exp $ */ #include "tclInt.h" @@ -857,6 +858,7 @@ TclFreeObj( if (ObjDeletePending(context)) { PushObjToDelete(context, objPtr); } else { + TCL_DTRACE_OBJ_FREE(objPtr); if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { ObjDeletionLock(context); typePtr->freeIntRepProc(objPtr); @@ -866,22 +868,19 @@ TclFreeObj( Tcl_MutexLock(&tclObjMutex); ckfree((char *) objPtr); Tcl_MutexUnlock(&tclObjMutex); -#ifdef TCL_COMPILE_STATS - tclObjsFreed++; -#endif /* TCL_COMPILE_STATS */ + TclIncrObjsFreed(); ObjDeletionLock(context); while (ObjOnStack(context)) { Tcl_Obj *objToFree; PopObjToDelete(context,objToFree); + TCL_DTRACE_OBJ_FREE(objToFree); TclFreeIntRep(objToFree); Tcl_MutexLock(&tclObjMutex); ckfree((char *) objToFree); Tcl_MutexUnlock(&tclObjMutex); -#ifdef TCL_COMPILE_STATS - tclObjsFreed++; -#endif /* TCL_COMPILE_STATS */ + TclIncrObjsFreed(); } ObjDeletionUnlock(context); } @@ -905,6 +904,7 @@ TclFreeObj( * other objects: it will not cause recursive calls to this function. */ + TCL_DTRACE_OBJ_FREE(objPtr); TclFreeObjStorage(objPtr); TclIncrObjsFreed(); } else { @@ -927,6 +927,7 @@ TclFreeObj( * satisfy this. */ + TCL_DTRACE_OBJ_FREE(objPtr); ObjDeletionLock(context); objPtr->typePtr->freeIntRepProc(objPtr); ObjDeletionUnlock(context); @@ -937,6 +938,7 @@ TclFreeObj( while (ObjOnStack(context)) { Tcl_Obj *objToFree; PopObjToDelete(context,objToFree); + TCL_DTRACE_OBJ_FREE(objToFree); if ((objToFree->typePtr != NULL) && (objToFree->typePtr->freeIntRepProc != NULL)) { objToFree->typePtr->freeIntRepProc(objToFree); |