* generic/tclDTrace.d (new file): add DTrace provider for Tcl; allows

	* generic/tclCompile.h:		  tracing of proc and command entry &
	* generic/tclBasic.c:		  return, bytecode execution, object
	* generic/tclExecute.c:		  allocation and more; with essentially
	* generic/tclInt.h:		  zero cost when tracing is inactive;
	* generic/tclObj.c:		  enable with --enable-dtrace configure
	* generic/tclProc.c:		  arg (disabled by default, will only
	* unix/Makefile.in:		  enable if DTrace is present).
	* unix/configure.in:		  [Patch 1793984]

	* macosx/Makefile:		  enable DTrace support.

	* unix/configure: autoconf-2.13

1 files changed, 78 insertions, 1 deletions

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 76f439c..270f3e2 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -9,11 +9,12 @@
  * Copyright (c) 1994-1997 Sun Microsystems, Inc.
  * Copyright (c) 1998-1999 by Scriptics Corporation.
  * Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
+ * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
  *
  * 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.75.2.26 2006/11/28 22:19:59 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.75.2.27 2007/09/13 15:28:10 das Exp $
  */
 
 #include "tclInt.h"
@@ -52,6 +53,11 @@ static int            EvalTokensStandard _ANSI_ARGS_((Tcl_Interp *interp,
 
 #endif
 
+#ifdef USE_DTRACE
+static int	DTraceObjCmd(ClientData dummy, Tcl_Interp *interp, int objc,
+		    Tcl_Obj *CONST objv[]);
+#endif
+
 extern TclStubs tclStubs;
 
 /*
@@ -508,6 +514,14 @@ Tcl_CreateInterp()
 	}
     }
 
+#ifdef USE_DTRACE
+    /*
+     * Register the tcl::dtrace command.
+     */
+
+    Tcl_CreateObjCommand(interp, "::tcl::dtrace", DTraceObjCmd, NULL, NULL);
+#endif /* USE_DTRACE */
+
     /*
      * Register the builtin math functions.
      */
@@ -3181,13 +3195,31 @@ TclEvalObjvInternal(interp, objc, objv, command, length, flags)
         break;
     }
 
+    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]);
+    }
+
     /*
      * Finally, invoke the command's Tcl_ObjCmdProc.
      */
     cmdPtr->refCount++;
     iPtr->cmdCount++;
     if ( code == TCL_OK && traceCode == TCL_OK) {
+	if (TCL_DTRACE_CMD_ENTRY_ENABLED()) {
+	    TCL_DTRACE_CMD_ENTRY(TclGetString(objv[0]), objc - 1,
+		    (Tcl_Obj **)(objv + 1));
+	}
 	code = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
+	if (TCL_DTRACE_CMD_RETURN_ENABLED()) {
+	    TCL_DTRACE_CMD_RETURN(TclGetString(objv[0]), code);
+	}
     }
     if (Tcl_AsyncReady()) {
 	code = Tcl_AsyncInvoke(interp, code);
@@ -3235,6 +3267,13 @@ TclEvalObjvInternal(interp, objc, objv, command, length, flags)
 	(void) Tcl_GetObjResult(interp);
     }
 
+    if (TCL_DTRACE_CMD_RESULT_ENABLED()) {
+	Tcl_Obj *r;
+
+	r = Tcl_GetObjResult(interp);
+	TCL_DTRACE_CMD_RESULT(TclGetString(objv[0]), code, TclGetString(r), r);
+    }
+
     done:
     iPtr->varFramePtr = savedVarFramePtr;
     return code;
@@ -6082,8 +6121,46 @@ Tcl_GetVersion(majorV, minorV, patchLevelV, type)
         *type = TCL_RELEASE_LEVEL;
     }
 }
+#ifdef USE_DTRACE
 
 /*
+ *----------------------------------------------------------------------
+ *
+ * DTraceObjCmd --
+ *
+ *	This function is invoked to process the "::tcl::dtrace" Tcl command.
+ *
+ * Results:
+ *	A standard Tcl object result.
+ *
+ * Side effects:
+ *	The 'tcl-probe' DTrace probe is triggered (if it is enabled).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DTraceObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *CONST objv[])	/* Argument objects. */
+{
+    if (TCL_DTRACE_TCL_PROBE_ENABLED()) {
+	char *a[10];
+	int i = 0;
+
+	while (i++ < 10) {
+	    a[i-1] = i < objc ? TclGetString(objv[i]) : NULL;
+	}
+	TCL_DTRACE_TCL_PROBE(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7],
+		a[8], a[9]);
+    }
+    return TCL_OK;
+}
+#endif /* USE_DTRACE */
+
+/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4