summaryrefslogtreecommitdiffstats
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
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).
-rw-r--r--ChangeLog17
-rw-r--r--generic/tclBasic.c106
-rw-r--r--generic/tclCompile.h131
-rw-r--r--generic/tclDTrace.d10
-rw-r--r--generic/tclProc.c30
5 files changed, 260 insertions, 34 deletions
diff --git a/ChangeLog b/ChangeLog
index a69d097..b18c4e6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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);
}