diff options
author | das <das> | 2008-08-14 02:11:46 (GMT) |
---|---|---|
committer | das <das> | 2008-08-14 02:11:46 (GMT) |
commit | f4104c736e717c8d8f03582e042992b4128d56ae (patch) | |
tree | ae0f42bbae423340f5e92adc625009868bce86e5 /generic/tclProc.c | |
parent | 26fdc714770e1a928602741126a435c48ca9ff27 (diff) | |
download | tcl-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.c | 30 |
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); } |