diff options
| -rw-r--r-- | ChangeLog | 17 | ||||
| -rw-r--r-- | generic/tclBasic.c | 106 | ||||
| -rw-r--r-- | generic/tclCompile.h | 131 | ||||
| -rw-r--r-- | generic/tclDTrace.d | 10 | ||||
| -rw-r--r-- | generic/tclProc.c | 30 |
5 files changed, 260 insertions, 34 deletions
@@ -1,5 +1,22 @@ 2008-08-14 Daniel Steffen <das@users.sourceforge.net> + * 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). + + * generic/tclCmdIL.c (TclInfoFrame): check fPtr->line before + dereferencing as line info may + not exists when TclInfoFrame() + is called from a DTrace probe. + * tests/fCmd.test (fCmd-6.23): made result matching robust when test workdir and /tmp are not on same FS. diff --git a/generic/tclBasic.c b/generic/tclBasic.c index b1ceab7..96857ac 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -16,7 +16,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclBasic.c,v 1.352 2008/08/09 22:20:56 msofer Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.353 2008/08/14 02:11:50 das Exp $ */ #include "tclInt.h" @@ -105,6 +105,8 @@ static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected, #ifdef USE_DTRACE static int DTraceObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +static int DTraceCmdReturn(ClientData data[], Tcl_Interp *interp, + int result); #endif MODULE_SCOPE const TclStubs * const tclConstStubsPtr; @@ -4112,12 +4114,19 @@ TclNREvalObjv( } if (TCL_DTRACE_CMD_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_CMD_INFO(a[0], a[1], a[2], a[3], i[0], i[1]); + TCL_DTRACE_CMD_INFO(a[0], a[1], a[2], a[3], i[0], i[1], a[4], a[5]); TclDecrRefCount(info); } + if (TCL_DTRACE_CMD_RETURN_ENABLED() || TCL_DTRACE_CMD_RESULT_ENABLED()) { + TclNRAddCallback(interp, DTraceCmdReturn, objv[0], NULL, NULL, NULL); + } + if (TCL_DTRACE_CMD_ENTRY_ENABLED()) { + TCL_DTRACE_CMD_ENTRY(TclGetString(objv[0]), objc - 1, + (Tcl_Obj **)(objv + 1)); + } /* * Fix the original callback to point to the now known cmdPtr. Insure that @@ -7662,28 +7671,33 @@ TclDTraceInfo( char **args, int *argsi) { - static Tcl_Obj *keys[7] = { NULL }; + static Tcl_Obj *keys[10] = { NULL }; Tcl_Obj **k = keys, *val; - int i; + int i = 0; if (!*k) { - TclNewLiteralStringObj(keys[0], "cmd"); - TclNewLiteralStringObj(keys[1], "type"); - TclNewLiteralStringObj(keys[2], "proc"); - TclNewLiteralStringObj(keys[3], "file"); - TclNewLiteralStringObj(keys[4], "lambda"); - TclNewLiteralStringObj(keys[5], "line"); - TclNewLiteralStringObj(keys[6], "level"); - } - for (i = 0; i < 4; i++) { +#define kini(s) TclNewLiteralStringObj(keys[i], s); i++ + kini("cmd"); kini("type"); kini("proc"); kini("file"); + kini("method"); kini("class"); kini("lambda"); kini("object"); + kini("line"); kini("level"); +#undef kini + } + for (i = 0; i < 6; i++) { Tcl_DictObjGet(NULL, info, *k++, &val); args[i] = val ? TclGetString(val) : NULL; } + /* no "proc" -> use "lambda" */ if (!args[2]) { Tcl_DictObjGet(NULL, info, *k, &val); args[2] = val ? TclGetString(val) : NULL; } k++; + /* no "class" -> use "object" */ + if (!args[5]) { + Tcl_DictObjGet(NULL, info, *k, &val); + args[5] = val ? TclGetString(val) : NULL; + } + k++; for (i = 0; i < 2; i++) { Tcl_DictObjGet(NULL, info, *k++, &val); if (val) { @@ -7693,6 +7707,44 @@ TclDTraceInfo( } } } + +/* + *---------------------------------------------------------------------- + * + * DTraceCmdReturn -- + * + * NR callback for DTrace command return probes. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +DTraceCmdReturn( + ClientData data[], + Tcl_Interp *interp, + int result) +{ + char *cmdName = TclGetString((Tcl_Obj *)data[0]); + + if (TCL_DTRACE_CMD_RETURN_ENABLED()) { + TCL_DTRACE_CMD_RETURN(cmdName, result); + } + if (TCL_DTRACE_CMD_RESULT_ENABLED()) { + Tcl_Obj *r = Tcl_GetObjResult(interp); + + TCL_DTRACE_CMD_RESULT(cmdName, result, TclGetString(r), r); + } + return result; +} + +TCL_DTRACE_DEBUG_LOG(); + #endif /* USE_DTRACE */ /* @@ -7726,6 +7778,32 @@ Tcl_NRCallObjProc( int result = TCL_OK; TEOV_callback *rootPtr = TOP_CB(interp); + if (TCL_DTRACE_CMD_ARGS_ENABLED()) { + char *a[10]; + int i = 0; + + while (i < 10) { + a[i] = i < objc ? TclGetString(objv[i]) : NULL; i++; + } + TCL_DTRACE_CMD_ARGS(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], + a[8], a[9]); + } + if (TCL_DTRACE_CMD_INFO_ENABLED() && ((Interp *) interp)->cmdFramePtr) { + Tcl_Obj *info = TclInfoFrame(interp, ((Interp *) interp)->cmdFramePtr); + char *a[6]; int i[2]; + + TclDTraceInfo(info, a, i); + TCL_DTRACE_CMD_INFO(a[0], a[1], a[2], a[3], i[0], i[1], a[4], a[5]); + TclDecrRefCount(info); + } + if ((TCL_DTRACE_CMD_RETURN_ENABLED() || TCL_DTRACE_CMD_RESULT_ENABLED()) + && objc) { + TclNRAddCallback(interp, DTraceCmdReturn, objv[0], NULL, NULL, NULL); + } + if (TCL_DTRACE_CMD_ENTRY_ENABLED() && objc) { + TCL_DTRACE_CMD_ENTRY(TclGetString(objv[0]), objc - 1, + (Tcl_Obj **)(objv + 1)); + } result = (*objProc)(clientData, interp, objc, objv); return TclNRRunCallbacks(interp, result, rootPtr, 0); } diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 53a2c95..4bf78af 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompile.h,v 1.102 2008/08/09 22:20:56 msofer Exp $ + * RCS: @(#) $Id: tclCompile.h,v 1.103 2008/08/14 02:11:51 das Exp $ */ #ifndef _TCLCOMPILATION @@ -1223,11 +1223,30 @@ MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr, * DTrace probe macros (NOPs if DTrace support is not enabled). */ +/* + * Define the following macros to enable debug logging of the DTrace proc, + * cmd, and inst probes. Note that this does _not_ require a platform with + * DTrace, it simply logs all probe output to /tmp/tclDTraceDebug-[pid].log. + * + * If the second macro is defined, logging to file starts immediately, + * otherwise only after the first call to [tcl::dtrace]. Note that the debug + * probe data is always computed, even when it is not logged to file. + * + * Defining the third macro enables debug logging of inst probes (disabled + * by default due to the significant performance impact). + */ + +#define TCL_DTRACE_DEBUG 1 +//#define TCL_DTRACE_DEBUG_LOG_ENABLED 1 +#define TCL_DTRACE_DEBUG_INST_PROBES 1 + +#if !(defined(TCL_DTRACE_DEBUG) && defined(__GNUC__)) + #ifdef USE_DTRACE #include "tclDTrace.h" -#if defined(__GNUC__ ) && __GNUC__ > 2 +#if defined(__GNUC__) && __GNUC__ > 2 /* Use gcc branch prediction hint to minimize cost of DTrace ENABLED checks. */ #define unlikely(x) (__builtin_expect((x), 0)) #else @@ -1244,8 +1263,8 @@ MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr, #define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) TCL_PROC_RESULT(a0, a1, a2, a3) #define TCL_DTRACE_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \ TCL_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) -#define TCL_DTRACE_PROC_INFO(a0, a1, a2, a3, a4, a5) \ - TCL_PROC_INFO(a0, a1, a2, a3, a4, a5) +#define TCL_DTRACE_PROC_INFO(a0, a1, a2, a3, a4, a5, a6, a7) \ + TCL_PROC_INFO(a0, a1, a2, a3, a4, a5, a6, a7) #define TCL_DTRACE_CMD_ENTRY_ENABLED() unlikely(TCL_CMD_ENTRY_ENABLED()) #define TCL_DTRACE_CMD_RETURN_ENABLED() unlikely(TCL_CMD_RETURN_ENABLED()) @@ -1257,8 +1276,8 @@ MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr, #define TCL_DTRACE_CMD_RESULT(a0, a1, a2, a3) TCL_CMD_RESULT(a0, a1, a2, a3) #define TCL_DTRACE_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \ TCL_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) -#define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5) \ - TCL_CMD_INFO(a0, a1, a2, a3, a4, a5) +#define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5, a6, a7) \ + TCL_CMD_INFO(a0, a1, a2, a3, a4, a5, a6, a7) #define TCL_DTRACE_INST_START_ENABLED() unlikely(TCL_INST_START_ENABLED()) #define TCL_DTRACE_INST_DONE_ENABLED() unlikely(TCL_INST_DONE_ENABLED()) @@ -1269,6 +1288,8 @@ MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr, #define TCL_DTRACE_TCL_PROBE(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \ TCL_TCL_PROBE(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) +#define TCL_DTRACE_DEBUG_LOG() + MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, char **args, int *argsi); #else /* USE_DTRACE */ @@ -1282,7 +1303,7 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, char **args, int *argsi); #define TCL_DTRACE_PROC_RETURN(a0, a1) {} #define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) {} #define TCL_DTRACE_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) {} -#define TCL_DTRACE_PROC_INFO(a0, a1, a2, a3, a4, a5) {} +#define TCL_DTRACE_PROC_INFO(a0, a1, a2, a3, a4, a5, a6, a7) {} #define TCL_DTRACE_CMD_ENTRY_ENABLED() 0 #define TCL_DTRACE_CMD_RETURN_ENABLED() 0 @@ -1293,7 +1314,7 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, char **args, int *argsi); #define TCL_DTRACE_CMD_RETURN(a0, a1) {} #define TCL_DTRACE_CMD_RESULT(a0, a1, a2, a3) {} #define TCL_DTRACE_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) {} -#define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5) {} +#define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5, a6, a7) {} #define TCL_DTRACE_INST_START_ENABLED() 0 #define TCL_DTRACE_INST_DONE_ENABLED() 0 @@ -1307,6 +1328,100 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, char **args, int *argsi); #endif /* USE_DTRACE */ +#else /* TCL_DTRACE_DEBUG */ + +#define USE_DTRACE 1 + +#if !defined(TCL_DTRACE_DEBUG_LOG_ENABLED) || !(TCL_DTRACE_DEBUG_LOG_ENABLED) +#undef TCL_DTRACE_DEBUG_LOG_ENABLED +#define TCL_DTRACE_DEBUG_LOG_ENABLED 0 +#endif + +#if !defined(TCL_DTRACE_DEBUG_INST_PROBES) || !(TCL_DTRACE_DEBUG_INST_PROBES) +#undef TCL_DTRACE_DEBUG_INST_PROBES +#define TCL_DTRACE_DEBUG_INST_PROBES 0 +#endif + +MODULE_SCOPE int tclDTraceDebugEnabled, tclDTraceDebugIndent; +MODULE_SCOPE FILE *tclDTraceDebugLog; +MODULE_SCOPE void TclDTraceOpenDebugLog(void); +MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, char **args, int *argsi); + +#define TCL_DTRACE_DEBUG_LOG() \ + int tclDTraceDebugEnabled = TCL_DTRACE_DEBUG_LOG_ENABLED;\ + int tclDTraceDebugIndent = 0; \ + FILE *tclDTraceDebugLog = NULL; \ + void TclDTraceOpenDebugLog(void) { char n[35]; \ + sprintf(n, "/tmp/tclDTraceDebug-%lu.log", (unsigned long) getpid()); \ + tclDTraceDebugLog = fopen(n, "a"); } \ + +#define TclDTraceDbgMsg(p, m, ...) do { if (tclDTraceDebugEnabled) { \ + int _l, _t = 0; if (!tclDTraceDebugLog) { TclDTraceOpenDebugLog(); } \ + fprintf(tclDTraceDebugLog, "%.12s:%.4d:%n", strrchr(__FILE__, '/') + \ + 1, __LINE__, &_l); _t += _l; \ + fprintf(tclDTraceDebugLog, " %.*s():%n", (_t < 18 ? 18 - _t : 0) + \ + 18, __func__, &_l); _t += _l; \ + fprintf(tclDTraceDebugLog, "%*s" p "%n", (_t < 40 ? 40 - _t : 0) + \ + 2 * tclDTraceDebugIndent, "", &_l); _t += _l; \ + fprintf(tclDTraceDebugLog, "%*s" m "\n", (_t < 64 ? 64 - _t : 1), "", \ + ##__VA_ARGS__); fflush(tclDTraceDebugLog); \ + } } while (0) + +#define TCL_DTRACE_PROC_ENTRY_ENABLED() 1 +#define TCL_DTRACE_PROC_RETURN_ENABLED() 1 +#define TCL_DTRACE_PROC_RESULT_ENABLED() 1 +#define TCL_DTRACE_PROC_ARGS_ENABLED() 1 +#define TCL_DTRACE_PROC_INFO_ENABLED() 1 +#define TCL_DTRACE_PROC_ENTRY(a0, a1, a2) \ + tclDTraceDebugIndent++; \ + TclDTraceDbgMsg("-> proc-entry", "%s %d %p", a0, a1, a2) +#define TCL_DTRACE_PROC_RETURN(a0, a1) \ + TclDTraceDbgMsg("<- proc-return", "%s %d", a0, a1); \ + tclDTraceDebugIndent-- +#define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) \ + TclDTraceDbgMsg(" | proc-result", "%s %d %s %p", a0, a1, a2, a3) +#define TCL_DTRACE_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \ + TclDTraceDbgMsg(" | proc-args", "%s %s %s %s %s %s %s %s %s %s", a0, \ + a1, a2, a3, a4, a5, a6, a7, a8, a9) +#define TCL_DTRACE_PROC_INFO(a0, a1, a2, a3, a4, a5, a6, a7) \ + TclDTraceDbgMsg(" | proc-info", "%s %s %s %s %d %d %s %s", a0, a1, \ + a2, a3, a4, a5, a6, a7) + +#define TCL_DTRACE_CMD_ENTRY_ENABLED() 1 +#define TCL_DTRACE_CMD_RETURN_ENABLED() 1 +#define TCL_DTRACE_CMD_RESULT_ENABLED() 1 +#define TCL_DTRACE_CMD_ARGS_ENABLED() 1 +#define TCL_DTRACE_CMD_INFO_ENABLED() 1 +#define TCL_DTRACE_CMD_ENTRY(a0, a1, a2) \ + tclDTraceDebugIndent++; \ + TclDTraceDbgMsg("-> cmd-entry", "%s %d %p", a0, a1, a2) +#define TCL_DTRACE_CMD_RETURN(a0, a1) \ + TclDTraceDbgMsg("<- cmd-return", "%s %d", a0, a1); \ + tclDTraceDebugIndent-- +#define TCL_DTRACE_CMD_RESULT(a0, a1, a2, a3) \ + TclDTraceDbgMsg(" | cmd-result", "%s %d %s %p", a0, a1, a2, a3) +#define TCL_DTRACE_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \ + TclDTraceDbgMsg(" | cmd-args", "%s %s %s %s %s %s %s %s %s %s", a0, \ + a1, a2, a3, a4, a5, a6, a7, a8, a9) +#define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5, a6, a7) \ + TclDTraceDbgMsg(" | cmd-info", "%s %s %s %s %d %d %s %s", a0, a1, \ + a2, a3, a4, a5, a6, a7) + +#define TCL_DTRACE_INST_START_ENABLED() TCL_DTRACE_DEBUG_INST_PROBES +#define TCL_DTRACE_INST_DONE_ENABLED() TCL_DTRACE_DEBUG_INST_PROBES +#define TCL_DTRACE_INST_START(a0, a1, a2) \ + TclDTraceDbgMsg(" | inst-start", "%s %d %p", a0, a1, a2) +#define TCL_DTRACE_INST_DONE(a0, a1, a2) \ + TclDTraceDbgMsg(" | inst-end", "%s %d %p", a0, a1, a2) + +#define TCL_DTRACE_TCL_PROBE_ENABLED() 1 +#define TCL_DTRACE_TCL_PROBE(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \ + tclDTraceDebugEnabled = 1; \ + TclDTraceDbgMsg(" | tcl-probe", "%s %s %s %s %s %s %s %s %s %s", a0, \ + a1, a2, a3, a4, a5, a6, a7, a8, a9) + +#endif /* TCL_DTRACE_DEBUG */ + #endif /* _TCLCOMPILATION */ /* diff --git a/generic/tclDTrace.d b/generic/tclDTrace.d index 8d0fbcc..65c804e 100644 --- a/generic/tclDTrace.d +++ b/generic/tclDTrace.d @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclDTrace.d,v 1.2 2007/12/13 15:23:16 dgp Exp $ + * RCS: @(#) $Id: tclDTrace.d,v 1.3 2008/08/14 02:11:51 das Exp $ */ typedef struct Tcl_Obj Tcl_Obj; @@ -63,9 +63,11 @@ provider tcl { * arg3: TIP 280 file (string) * arg4: TIP 280 line (int) * arg5: TIP 280 level (int) + * arg6: TclOO method (string) + * arg7: TclOO class/object (string) */ probe proc__info(char* cmd, char* type, char* proc, char* file, int line, - int level); + int level, char* method, char* class); /***************************** cmd probes ******************************/ /* @@ -112,9 +114,11 @@ provider tcl { * arg3: TIP 280 file (string) * arg4: TIP 280 line (int) * arg5: TIP 280 level (int) + * arg6: TclOO method (string) + * arg7: TclOO class/object (string) */ probe cmd__info(char* cmd, char* type, char* proc, char* file, int line, - int level); + int level, char* method, char* class); /***************************** inst probes *****************************/ /* 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); } |