diff options
| author | das <das> | 2007-09-13 15:28:09 (GMT) |
|---|---|---|
| committer | das <das> | 2007-09-13 15:28:09 (GMT) |
| commit | 6727c60fc8fb34e49299e93c7c9ac1502935b9b0 (patch) | |
| tree | 593d357422c91ee5b5623ed463f7d5629d99a4a5 /generic/tclProc.c | |
| parent | 31db1293d7001f8e7aeb25c06df292f43db1154e (diff) | |
| download | tcl-6727c60fc8fb34e49299e93c7c9ac1502935b9b0.zip tcl-6727c60fc8fb34e49299e93c7c9ac1502935b9b0.tar.gz tcl-6727c60fc8fb34e49299e93c7c9ac1502935b9b0.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/Makefile: enable DTrace support.
* unix/configure: autoconf-2.13
Diffstat (limited to 'generic/tclProc.c')
| -rw-r--r-- | generic/tclProc.c | 29 |
1 files changed, 28 insertions, 1 deletions
diff --git a/generic/tclProc.c b/generic/tclProc.c index 3ecf243..d903ae6 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -6,11 +6,12 @@ * * Copyright (c) 1987-1993 The Regents of the University of California. * Copyright (c) 1994-1998 Sun Microsystems, Inc. + * 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: tclProc.c,v 1.44.2.6 2006/11/28 22:20:02 andreas_kupries Exp $ + * RCS: @(#) $Id: tclProc.c,v 1.44.2.7 2007/09/13 15:28:17 das Exp $ */ #include "tclInt.h" @@ -1158,8 +1159,23 @@ TclObjInterpProc(clientData, interp, objc, objv) } #endif /*TCL_COMPILE_DEBUG*/ + if (TCL_DTRACE_PROC_ARGS_ENABLED()) { + char *a[10]; + int i = 0; + + while (i < 10) { + a[i] = i < objc ? TclGetString(objv[i]) : NULL; i++; + } + TCL_DTRACE_PROC_ARGS(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], + a[8], a[9]); + } + iPtr->returnCode = TCL_OK; procPtr->refCount++; + if (TCL_DTRACE_PROC_ENTRY_ENABLED()) { + TCL_DTRACE_PROC_ENTRY(TclGetString(objv[0]), objc - 1, + (Tcl_Obj **)(objv + 1)); + } #ifndef TCL_TIP280 result = TclCompEvalObj(interp, procPtr->bodyPtr); #else @@ -1169,6 +1185,9 @@ TclObjInterpProc(clientData, interp, objc, objv) result = TclCompEvalObj(interp, procPtr->bodyPtr, NULL, 0); #endif + if (TCL_DTRACE_PROC_RETURN_ENABLED()) { + TCL_DTRACE_PROC_RETURN(TclGetString(objv[0]), result); + } procPtr->refCount--; if (procPtr->refCount <= 0) { TclProcCleanupProc(procPtr); @@ -1178,6 +1197,14 @@ TclObjInterpProc(clientData, interp, objc, objv) result = ProcessProcResultCode(interp, procName, nameLen, result); } + if (TCL_DTRACE_PROC_RESULT_ENABLED()) { + Tcl_Obj *r; + + r = Tcl_GetObjResult(interp); + TCL_DTRACE_PROC_RESULT(TclGetString(objv[0]), result, + TclGetString(r), r); + } + /* * Pop and free the call frame for this procedure invocation, then * free the compiledLocals array if malloc'ed storage was used. |