* 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).

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);
 }