summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordas <das>2008-08-14 02:12:05 (GMT)
committerdas <das>2008-08-14 02:12:05 (GMT)
commitd2a98c066035c60995e044906c3619b7c5293012 (patch)
treee2c63313d8def410604e5c2852148f7669589e79
parentaf494a7fa60b807ea5ea6c39c2cfe0da1c846eb8 (diff)
downloadtcl-d2a98c066035c60995e044906c3619b7c5293012.zip
tcl-d2a98c066035c60995e044906c3619b7c5293012.tar.gz
tcl-d2a98c066035c60995e044906c3619b7c5293012.tar.bz2
* 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--ChangeLog9
-rw-r--r--generic/tclBasic.c5
-rw-r--r--generic/tclCompile.h124
3 files changed, 135 insertions, 3 deletions
diff --git a/ChangeLog b/ChangeLog
index 3fffa4f..ccaedf9 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,14 @@
2008-08-14 Daniel Steffen <das@users.sourceforge.net>
+ * 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/msgcat.test: fix for ::tcl::mac::locale with
@modifier (HEAD backport 2008-06-01).
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index fcdd41d..9a159be 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -14,7 +14,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.295.2.8 2008/07/30 20:59:16 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.295.2.9 2008/08/14 02:12:06 das Exp $
*/
#include "tclInt.h"
@@ -6879,6 +6879,9 @@ TclDTraceInfo(
}
}
}
+
+TCL_DTRACE_DEBUG_LOG();
+
#endif /* USE_DTRACE */
/*
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 777fd3e..de25b1b 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.90.2.3 2008/07/22 22:26:58 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.90.2.4 2008/08/14 02:12:08 das Exp $
*/
#ifndef _TCLCOMPILATION
@@ -1217,11 +1217,32 @@ 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
@@ -1263,6 +1284,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 */
@@ -1301,6 +1324,103 @@ 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
+OG_ENABLED 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) \
+ TclDTraceDbgMsg(" | proc-info", "%s %s %s %s %d %d", a0, a1, \
+ a2, a3, a4, a5)
+
+#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) \
+ TclDTraceDbgMsg(" | cmd-info", "%s %s %s %s %d %d", a0, a1, \
+ a2, a3, a4, a5)
+
+#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 */
/*