summaryrefslogtreecommitdiffstats
path: root/generic/tclProc.c
diff options
context:
space:
mode:
authordas <das>2008-08-14 02:11:46 (GMT)
committerdas <das>2008-08-14 02:11:46 (GMT)
commitf4104c736e717c8d8f03582e042992b4128d56ae (patch)
treeae0f42bbae423340f5e92adc625009868bce86e5 /generic/tclProc.c
parent26fdc714770e1a928602741126a435c48ca9ff27 (diff)
downloadtcl-f4104c736e717c8d8f03582e042992b4128d56ae.zip
tcl-f4104c736e717c8d8f03582e042992b4128d56ae.tar.gz
tcl-f4104c736e717c8d8f03582e042992b4128d56ae.tar.bz2
* generic/tclBasic.c (TclNREvalObjv, Tcl_NRCallObjProc): DTrace probes
* generic/tclProc.c (TclNRInterpProcCore, InterpProcNR2): for NRE. [Bug 2017160] * generic/tclBasic.c (TclDTraceInfo): add two extra arguments to * generic/tclCompile.h: DTrace 'info' probes for tclOO * generic/tclDTrace.d: method & class/object info. * generic/tclCompile.h: add support for debug logging of DTrace * generic/tclBasic.c: 'proc', 'cmd' and 'inst' probes (does _not_ require a platform with DTrace).
Diffstat (limited to 'generic/tclProc.c')
-rw-r--r--generic/tclProc.c30
1 files changed, 21 insertions, 9 deletions
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 495e194..8d1c9d7 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -12,7 +12,7 @@
* 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.159 2008/08/12 17:45:25 dgp Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.160 2008/08/14 02:11:51 das Exp $
*/
#include "tclInt.h"
@@ -1751,11 +1751,11 @@ TclNRInterpProcCore(
#endif /*TCL_COMPILE_DEBUG*/
if (TCL_DTRACE_PROC_ARGS_ENABLED()) {
+ int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
char *a[10];
int i;
- int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
- for (i=0 ; i<10 ; i++) {
+ for (i = 0 ; i < 10 ; i++) {
a[i] = (l < iPtr->varFramePtr->objc ?
TclGetString(iPtr->varFramePtr->objv[l]) : NULL);
l++;
@@ -1765,12 +1765,20 @@ TclNRInterpProcCore(
}
if (TCL_DTRACE_PROC_INFO_ENABLED() && iPtr->cmdFramePtr) {
Tcl_Obj *info = TclInfoFrame(interp, iPtr->cmdFramePtr);
- char *a[4]; int i[2];
+ char *a[6]; int i[2];
TclDTraceInfo(info, a, i);
- TCL_DTRACE_PROC_INFO(a[0], a[1], a[2], a[3], i[0], i[1]);
+ TCL_DTRACE_PROC_INFO(a[0], a[1], a[2], a[3], i[0], i[1], a[4], a[5]);
TclDecrRefCount(info);
}
+ if (TCL_DTRACE_PROC_ENTRY_ENABLED()) {
+ int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
+
+ TCL_DTRACE_PROC_ENTRY(l < iPtr->varFramePtr->objc ?
+ TclGetString(iPtr->varFramePtr->objv[l]) : NULL,
+ iPtr->varFramePtr->objc - l - 1,
+ (Tcl_Obj **)(iPtr->varFramePtr->objv + l + 1));
+ }
/*
* Invoke the commands in the procedure's body.
@@ -1807,7 +1815,10 @@ InterpProcNR2(
ProcErrorProc errorProc = data[1];
if (TCL_DTRACE_PROC_RETURN_ENABLED()) {
- TCL_DTRACE_PROC_RETURN(TclGetString(procNameObj), result);
+ int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
+
+ TCL_DTRACE_PROC_RETURN(l < iPtr->varFramePtr->objc ?
+ TclGetString(iPtr->varFramePtr->objv[l]) : NULL, result);
}
if (--procPtr->refCount <= 0) {
TclProcCleanupProc(procPtr);
@@ -1868,10 +1879,11 @@ InterpProcNR2(
}
if (TCL_DTRACE_PROC_RESULT_ENABLED()) {
- Tcl_Obj *r;
+ int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
+ Tcl_Obj *r = Tcl_GetObjResult(interp);
- r = Tcl_GetObjResult(interp);
- TCL_DTRACE_PROC_RESULT(TclGetString(procNameObj), result,
+ TCL_DTRACE_PROC_RESULT(l < iPtr->varFramePtr->objc ?
+ TclGetString(iPtr->varFramePtr->objv[l]) : NULL, result,
TclGetString(r), r);
}