summaryrefslogtreecommitdiffstats
path: root/generic/tclBasic.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/tclBasic.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/tclBasic.c')
-rw-r--r--generic/tclBasic.c106
1 files changed, 92 insertions, 14 deletions
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);
}