Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.267
diff -u -p -r1.267 tclBasic.c
--- generic/tclBasic.c	5 Sep 2007 21:31:01 -0000	1.267
+++ generic/tclBasic.c	13 Sep 2007 04:56:01 -0000
@@ -9,6 +9,7 @@
  * 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.
@@ -93,6 +94,11 @@ static int	ExprWideFunc(ClientData clien
 static void	MathFuncWrongNumArgs(Tcl_Interp* interp, int expected,
 		    int actual, Tcl_Obj *const *objv);
 
+#ifdef USE_DTRACE
+static int	DTraceObjCmd(ClientData dummy, Tcl_Interp *interp, int objc,
+		    Tcl_Obj *const objv[]);
+#endif
+
 extern TclStubs tclStubs;
 
 /*
@@ -650,6 +656,14 @@ Tcl_CreateInterp(void)
     Tcl_CreateObjCommand(interp, "::tcl::Bgerror",
 	    TclDefaultBgErrorHandlerObjCmd, NULL, NULL);
 
+#ifdef USE_DTRACE
+    /*
+     * Register the tcl::dtrace command.
+     */
+
+    Tcl_CreateObjCommand(interp, "::tcl::dtrace", DTraceObjCmd, NULL, NULL);
+#endif /* USE_DTRACE */
+
     /*
      * Register the builtin math functions.
      */
@@ -2908,6 +2922,7 @@ CallCommandTraces(
  *	command. This insures that traces get a correct nul-terminated command
  *	string. 
  *
+ *----------------------------------------------------------------------
  */
 
 static Tcl_Obj *
@@ -3559,6 +3574,25 @@ TclEvalObjvInternal(
 	}
     }
 
+    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() && iPtr->cmdFramePtr) {
+	Tcl_Obj *info = TclInfoFrame(interp, iPtr->cmdFramePtr);
+	char *a[4]; int i[2];
+	
+	TclDTraceInfo(info, a, i);
+	TCL_DTRACE_CMD_INFO(a[0], a[1], a[2], a[3], i[0], i[1]);
+	TclDecrRefCount(info);
+    }
+
     /*
      * Finally, invoke the command's Tcl_ObjCmdProc.
      */
@@ -3566,7 +3600,14 @@ TclEvalObjvInternal(
     cmdPtr->refCount++;
     iPtr->cmdCount++;
     if (code == TCL_OK && traceCode == TCL_OK && !TclLimitExceeded(iPtr->limit)) {
+	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);
@@ -3623,6 +3664,13 @@ TclEvalObjvInternal(
 	(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:
     if (savedVarFramePtr) {
 	iPtr->varFramePtr = savedVarFramePtr;
@@ -6362,6 +6410,98 @@ MathFuncWrongNumArgs(
 	    "too %s arguments for math function \"%s\"",
 	    (found < expected ? "few" : "many"), name));
 }
+#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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclDTraceInfo --
+ *
+ *	Extract information from a TIP280 dict for use by DTrace probes.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclDTraceInfo(
+    Tcl_Obj *info,
+    char **args,
+    int *argsi)
+{
+	static Tcl_Obj *keys[7] = { NULL };
+	Tcl_Obj **k = keys, *val;
+	int i;
+	
+	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++) {
+	    Tcl_DictObjGet(NULL, info, *k++, &val);
+	    args[i] = val ? TclGetString(val) : NULL;
+	}
+	if (!args[2]) {
+	    Tcl_DictObjGet(NULL, info, *k, &val);
+	    args[2] = val ? TclGetString(val) : NULL;
+	}
+	k++;
+	for (i = 0; i < 2; i++) {
+	    Tcl_DictObjGet(NULL, info, *k++, &val);
+	    if (val) {
+		Tcl_GetIntFromObj(NULL, val, &(argsi[i]));
+	    } else {
+		argsi[i] = 0;
+	    }
+	}
+}
+#endif /* USE_DTRACE */
 
 /*
  * Local Variables:
Index: generic/tclCmdIL.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdIL.c,v
retrieving revision 1.122
diff -u -p -r1.122 tclCmdIL.c
--- generic/tclCmdIL.c	31 Jul 2007 17:03:36 -0000	1.122
+++ generic/tclCmdIL.c	13 Sep 2007 04:56:02 -0000
@@ -1060,18 +1060,8 @@ InfoFrameCmd(
     Tcl_Obj *CONST objv[])	/* Argument objects. */
 {
     Interp *iPtr = (Interp *) interp;
-    Tcl_Obj *lv[20];		/* Keep uptodate when more keys are added to
-				 * the dict. */
-    int level, lc = 0;
+    int level;
     CmdFrame *framePtr;
-    /*
-     * This array is indexed by the TCL_LOCATION_... values, except
-     * for _LAST.
-     */
-    static CONST char *typeString[TCL_LOCATION_LAST] = {
-	"eval", "eval", "eval", "precompiled", "source", "proc"
-    };
-    Tcl_Obj *tmpObj;
 
     if (objc == 1) {
 	/*
@@ -1125,7 +1115,45 @@ InfoFrameCmd(
 	goto levelError;
     }
 
+    Tcl_SetObjResult(interp, TclInfoFrame(interp, framePtr));
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInfoFrame --
+ *
+ *	Core of InfoFrameCmd, returns TIP280 dict for a given frame.
+ *
+ * Results:
+ *	Returns TIP280 dict.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclInfoFrame(
+    Tcl_Interp *interp,		/* Current interpreter. */
+    CmdFrame *framePtr)		/* Frame to get info for. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Tcl_Obj *lv[20];		/* Keep uptodate when more keys are added to
+				 * the dict. */
+    int lc = 0;
     /*
+     * This array is indexed by the TCL_LOCATION_... values, except
+     * for _LAST.
+     */
+    static CONST char *typeString[TCL_LOCATION_LAST] = {
+	"eval", "eval", "eval", "precompiled", "source", "proc"
+    };
+    Tcl_Obj *tmpObj;
+
+   /*
      * Pull the information and construct the dictionary to return, as list.
      * Regarding use of the CmdFrame fields see tclInt.h, and its definition.
      */
@@ -1301,8 +1329,7 @@ InfoFrameCmd(
 	}
     }
 
-    Tcl_SetObjResult(interp, Tcl_NewListObj(lc, lv));
-    return TCL_OK;
+    return Tcl_NewListObj(lc, lv);
 }
 
 /*
Index: generic/tclCompile.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.h,v
retrieving revision 1.78
diff -u -p -r1.78 tclCompile.h
--- generic/tclCompile.h	9 Sep 2007 16:51:19 -0000	1.78
+++ generic/tclCompile.h	13 Sep 2007 04:56:02 -0000
@@ -4,6 +4,7 @@
  * Copyright (c) 1996-1998 Sun Microsystems, Inc.
  * Copyright (c) 1998-2000 by Scriptics Corporation.
  * Copyright (c) 2001 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.
@@ -1203,6 +1204,94 @@ MODULE_SCOPE int	TclWordKnownAtCompileTi
 #define TclMin(i, j)   ((((int) i) < ((int) j))? (i) : (j))
 #define TclMax(i, j)   ((((int) i) > ((int) j))? (i) : (j))
 
+/*
+ * DTrace probe macros (NOPs if DTrace support is not enabled).
+ */
+
+#ifdef USE_DTRACE
+
+#include "tclDTrace.h"
+
+#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
+#define unlikely(x) (x)
+#endif
+
+#define TCL_DTRACE_PROC_ENTRY_ENABLED()	    unlikely(TCL_PROC_ENTRY_ENABLED())
+#define TCL_DTRACE_PROC_RETURN_ENABLED()    unlikely(TCL_PROC_RETURN_ENABLED())
+#define TCL_DTRACE_PROC_RESULT_ENABLED()    unlikely(TCL_PROC_RESULT_ENABLED())
+#define TCL_DTRACE_PROC_ARGS_ENABLED()	    unlikely(TCL_PROC_ARGS_ENABLED())
+#define TCL_DTRACE_PROC_INFO_ENABLED()	    unlikely(TCL_PROC_INFO_ENABLED())
+#define TCL_DTRACE_PROC_ENTRY(a0, a1, a2)   TCL_PROC_ENTRY(a0, a1, a2)
+#define TCL_DTRACE_PROC_RETURN(a0, a1)	    TCL_PROC_RETURN(a0, a1)
+#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_CMD_ENTRY_ENABLED()	    unlikely(TCL_CMD_ENTRY_ENABLED())
+#define TCL_DTRACE_CMD_RETURN_ENABLED()	    unlikely(TCL_CMD_RETURN_ENABLED())
+#define TCL_DTRACE_CMD_RESULT_ENABLED()	    unlikely(TCL_CMD_RESULT_ENABLED())
+#define TCL_DTRACE_CMD_ARGS_ENABLED()	    unlikely(TCL_CMD_ARGS_ENABLED())
+#define TCL_DTRACE_CMD_INFO_ENABLED()	    unlikely(TCL_CMD_INFO_ENABLED())
+#define TCL_DTRACE_CMD_ENTRY(a0, a1, a2)    TCL_CMD_ENTRY(a0, a1, a2)
+#define TCL_DTRACE_CMD_RETURN(a0, a1)	    TCL_CMD_RETURN(a0, a1)
+#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_INST_START_ENABLED()	    unlikely(TCL_INST_START_ENABLED())
+#define TCL_DTRACE_INST_DONE_ENABLED()	    unlikely(TCL_INST_DONE_ENABLED())
+#define TCL_DTRACE_INST_START(a0, a1, a2)   TCL_INST_START(a0, a1, a2)
+#define TCL_DTRACE_INST_DONE(a0, a1, a2)    TCL_INST_DONE(a0, a1, a2)
+
+#define TCL_DTRACE_TCL_PROBE_ENABLED()	    unlikely(TCL_TCL_PROBE_ENABLED())
+#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)
+
+MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, char **args, int *argsi);
+
+#else /* USE_DTRACE */
+
+#define TCL_DTRACE_PROC_ENTRY_ENABLED()	    0
+#define TCL_DTRACE_PROC_RETURN_ENABLED()    0
+#define TCL_DTRACE_PROC_RESULT_ENABLED()    0
+#define TCL_DTRACE_PROC_ARGS_ENABLED()	    0
+#define TCL_DTRACE_PROC_INFO_ENABLED()	    0
+#define TCL_DTRACE_PROC_ENTRY(a0, a1, a2)   {}
+#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_CMD_ENTRY_ENABLED()	    0
+#define TCL_DTRACE_CMD_RETURN_ENABLED()	    0
+#define TCL_DTRACE_CMD_RESULT_ENABLED()	    0
+#define TCL_DTRACE_CMD_ARGS_ENABLED()	    0
+#define TCL_DTRACE_CMD_INFO_ENABLED()	    0
+#define TCL_DTRACE_CMD_ENTRY(a0, a1, a2)    {}
+#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_INST_START_ENABLED()	    0
+#define TCL_DTRACE_INST_DONE_ENABLED()	    0
+#define TCL_DTRACE_INST_START(a0, a1, a2)   {}
+#define TCL_DTRACE_INST_DONE(a0, a1, a2)    {}
+
+#define TCL_DTRACE_TCL_PROBE_ENABLED()	    0
+#define TCL_DTRACE_TCL_PROBE(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) {}
+
+#define TclDTraceInfo(info, args, argsi)    {*args = ""; *argsi = 0;}
+
+#endif /* USE_DTRACE */
+
 #endif /* _TCLCOMPILATION */
 
 /*
Index: generic/tclDTrace.d
===================================================================
RCS file: generic/tclDTrace.d
diff -N generic/tclDTrace.d
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ generic/tclDTrace.d	13 Sep 2007 04:56:02 -0000
@@ -0,0 +1,215 @@
+/*
+ * tclDTrace.d --
+ *
+ *	Tcl DTrace provider.
+ *
+ * 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$
+ */
+
+typedef struct Tcl_Obj Tcl_Obj;
+
+/*
+ * Tcl DTrace probes
+ */
+
+provider tcl {
+    /***************************** proc probes *****************************/
+    /*
+     *	tcl*:::proc-entry probe
+     *	    triggered immediately before proc bytecode execution
+     *		arg0: proc name				(string)
+     *		arg1: number of arguments		(int)
+     *		arg2: array of proc argument objects	(Tcl_Obj**)
+     */
+    probe proc__entry(char* name, int objc, Tcl_Obj **objv);
+    /*
+     *	tcl*:::proc-return probe
+     *	    triggered immediately after proc bytecode execution
+     *		arg0: proc name				(string)
+     *		arg1: return code			(int)
+     */
+    probe proc__return(char* name, int code);
+    /*
+     *	tcl*:::proc-result probe
+     *	    triggered after proc-return probe and result processing
+     *		arg0: proc name				(string)
+     *		arg1: return code			(int)
+     *		arg2: proc result			(string)
+     *		arg3: proc result object		(Tcl_Obj*)
+     */
+    probe proc__result(char* name, int code, char* result, Tcl_Obj *resultobj);
+    /*
+     *	tcl*:::proc-args probe
+     *	    triggered before proc-entry probe, gives access to string
+     *	    representation of proc arguments
+     *		arg0: proc name				(string)
+     *		arg1-arg9: proc arguments or NULL	(strings)
+     */
+    probe proc__args(char* name, char* arg1, char* arg2, char* arg3,
+	    char* arg4, char* arg5, char* arg6, char* arg7, char* arg8,
+	    char* arg9);
+    /*
+     *	tcl*:::proc-info probe:
+     *	    triggered before proc-entry probe, gives access to TIP 280
+     *	    information for the proc invocation (i.e. [info frame 0])
+     *		arg0: TIP 280 cmd			(string)
+     *		arg1: TIP 280 type			(string)
+     *		arg2: TIP 280 proc			(string)
+     *		arg3: TIP 280 file			(string)
+     *		arg4: TIP 280 line			(int)
+     *		arg5: TIP 280 level			(int)
+     */
+    probe proc__info(char* cmd, char* type, char* proc, char* file, int line,
+	    int level);
+
+    /***************************** cmd probes ******************************/
+    /*
+     *	tcl*:::cmd-entry probe
+     *	    triggered immediately before commmand execution
+     *		arg0: command name			(string)
+     *		arg1: number of arguments		(int)
+     *		arg2: array of command argument objects	(Tcl_Obj**)
+     */
+    probe cmd__entry(char* name, int objc, Tcl_Obj **objv);
+    /*
+     *	tcl*:::cmd-return probe
+     *	    triggered immediately after commmand execution
+     *		arg0: command name			(string)
+     *		arg1: return code			(int)
+     */
+    probe cmd__return(char* name, int code);
+    /*
+     *	tcl*:::cmd-result probe
+     *	    triggered after cmd-return probe and result processing
+     *		arg0: command name			(string)
+     *		arg1: return code			(int)
+     *		arg2: command result			(string)
+     *		arg3: command result object		(Tcl_Obj*)
+     */
+    probe cmd__result(char* name, int code, char* result, Tcl_Obj *resultobj);
+    /*
+     *	tcl*:::cmd-args probe
+     *	    triggered before cmd-entry probe, gives access to string
+     *	    representation of command arguments
+     *		arg0: command name			(string)
+     *		arg1-arg9: command arguments or NULL	(strings)
+     */
+    probe cmd__args(char* name, char* arg1, char* arg2, char* arg3,
+	    char* arg4, char* arg5, char* arg6, char* arg7, char* arg8,
+	    char* arg9);
+    /*
+     *	tcl*:::cmd-info probe:
+     *	    triggered before cmd-entry probe, gives access to TIP 280
+     *	    information for the command invocation (i.e. [info frame 0])
+     *		arg0: TIP 280 cmd			(string)
+     *		arg1: TIP 280 type			(string)
+     *		arg2: TIP 280 proc			(string)
+     *		arg3: TIP 280 file			(string)
+     *		arg4: TIP 280 line			(int)
+     *		arg5: TIP 280 level			(int)
+     */
+    probe cmd__info(char* cmd, char* type, char* proc, char* file, int line,
+	    int level);
+
+    /***************************** inst probes *****************************/
+    /*
+     *	tcl*:::inst-start probe
+     *	    triggered immediately before execution of a bytecode
+     *		arg0: bytecode name			(string)
+     *		arg1: depth of stack			(int)
+     *		arg2: top of stack			(Tcl_Obj**)
+     */
+    probe inst__start(char* name, int depth, Tcl_Obj **stack);
+    /*
+     *	tcl*:::inst-done probe
+     *	    triggered immediately after execution of a bytecode
+     *		arg0: bytecode name			(string)
+     *		arg1: depth of stack			(int)
+     *		arg2: top of stack			(Tcl_Obj**)
+     */
+    probe inst__done(char* name, int depth, Tcl_Obj **stack);
+
+    /***************************** obj probes ******************************/
+    /*
+     *	tcl*:::obj-create probe
+     *	    triggered immediately after a new Tcl_Obj has been created
+     *		arg0: object created			(Tcl_Obj*)
+     */
+    probe obj__create(Tcl_Obj* obj);
+    /*
+     *	tcl*:::obj-free probe
+     *	    triggered immediately before a Tcl_Obj is freed
+     *		arg0: object to be freed		(Tcl_Obj*)
+     */
+    probe obj__free(Tcl_Obj* obj);
+
+    /***************************** tcl probes ******************************/
+    /*
+     *	tcl*:::tcl-probe probe
+     *	    triggered when the ::tcl::dtrace command is called
+     *		arg0-arg9: command arguments		(strings)
+     */
+    probe tcl__probe(char* arg0, char* arg1, char* arg2, char* arg3,
+	    char* arg4, char* arg5, char* arg6, char* arg7, char* arg8,
+	    char* arg9);
+};
+
+/*
+ * Tcl types and constants for use in DTrace scripts
+ */
+
+typedef struct Tcl_ObjType {
+    char *name;
+    void *freeIntRepProc;
+    void *dupIntRepProc;
+    void *updateStringProc;
+    void *setFromAnyProc;
+} Tcl_ObjType;
+
+struct Tcl_Obj {
+    int refCount;
+    char *bytes;
+    int length;
+    Tcl_ObjType *typePtr;
+    union {
+	long longValue;
+	double doubleValue;
+	void *otherValuePtr;
+	int64_t wideValue;
+	struct {
+	    void *ptr1;
+	    void *ptr2;
+	} twoPtrValue;
+	struct {
+	    void *ptr;
+	    unsigned long value;
+	} ptrAndLongRep;
+    } internalRep;
+};
+
+enum return_codes {
+    TCL_OK = 0,
+    TCL_ERROR,
+    TCL_RETURN,
+    TCL_BREAK,
+    TCL_CONTINUE
+};
+
+#pragma D attributes Evolving/Evolving/Common provider tcl provider
+#pragma D attributes Private/Private/Common provider tcl module
+#pragma D attributes Private/Private/Common provider tcl function
+#pragma D attributes Evolving/Evolving/Common provider tcl name
+#pragma D attributes Evolving/Evolving/Common provider tcl args
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
Index: generic/tclExecute.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclExecute.c,v
retrieving revision 1.335
diff -u -p -r1.335 tclExecute.c
--- generic/tclExecute.c	11 Sep 2007 14:47:43 -0000	1.335
+++ generic/tclExecute.c	13 Sep 2007 04:56:04 -0000
@@ -8,6 +8,7 @@
  * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
  * Copyright (c) 2002-2005 by Miguel Sofer.
  * Copyright (c) 2005-2007 by Donal K. Fellows.
+ * 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.
@@ -318,6 +319,28 @@ VarHashCreateVar(TclVarHashTable *tableP
 #endif /* TCL_COMPILE_DEBUG */
 
 /*
+ * DTrace instruction probe macros.
+ */
+
+#define TCL_DTRACE_INST_NEXT() \
+    if (TCL_DTRACE_INST_DONE_ENABLED()) {\
+	if (curInstName) {\
+	    TCL_DTRACE_INST_DONE(curInstName, (int) CURR_DEPTH, tosPtr);\
+	}\
+	curInstName = tclInstructionTable[*pc].name;\
+	if (TCL_DTRACE_INST_START_ENABLED()) {\
+	    TCL_DTRACE_INST_START(curInstName, (int) CURR_DEPTH, tosPtr);\
+	}\
+    } else if (TCL_DTRACE_INST_START_ENABLED()) {\
+	TCL_DTRACE_INST_START(tclInstructionTable[*pc].name, (int) CURR_DEPTH,\
+		tosPtr);\
+    }
+#define TCL_DTRACE_INST_LAST() \
+    if (TCL_DTRACE_INST_DONE_ENABLED() && curInstName) {\
+	TCL_DTRACE_INST_DONE(curInstName, (int) CURR_DEPTH, tosPtr);\
+    }
+
+/*
  * Macro used in this file to save a function call for common uses of
  * TclGetNumberFromObj(). The ANSI C "prototype" is:
  *
@@ -1555,6 +1578,7 @@ TclExecuteByteCode(
     int traceInstructions = (tclTraceExec == 3);
     char cmdNameBuf[21];
 #endif
+    char *curInstName = NULL;
 
     /*
      * The execution uses a unified stack: first the catch stack, immediately
@@ -1693,6 +1717,8 @@ TclExecuteByteCode(
     iPtr->stats.instructionCount[*pc]++;
 #endif
 
+     TCL_DTRACE_INST_NEXT();
+
     /*
      * Check for asynchronous handlers [Bug 746722]; we do the check every
      * ASYNC_CHECK_COUNT_MASK instruction, of the form (2**n-1).
@@ -1818,6 +1844,7 @@ TclExecuteByteCode(
 	 */
 
 	if (*pc == INST_PUSH1) {
+	    TCL_DTRACE_INST_NEXT();
 	    goto instPush1Peephole;
 	}
 #endif
@@ -1844,6 +1871,7 @@ TclExecuteByteCode(
 	pc++;
 #if !TCL_COMPILE_DEBUG
 	if (*pc == INST_START_CMD) {
+	    TCL_DTRACE_INST_NEXT();
 	    goto instStartCmdPeephole;
 	}
 #endif
@@ -6095,6 +6123,7 @@ TclExecuteByteCode(
 	 */
 
 	pc += 5;
+	TCL_DTRACE_INST_NEXT();
 #else
 	NEXT_INST_F(5, 0, 0);
 #endif
@@ -7008,6 +7037,7 @@ TclExecuteByteCode(
 
 	abnormalReturn:
 	{
+	    TCL_DTRACE_INST_LAST();
 	    while (tosPtr > initTosPtr) {
 		Tcl_Obj *objPtr = POP_OBJECT();
 		Tcl_DecrRefCount(objPtr);
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.334
diff -u -p -r1.334 tclInt.h
--- generic/tclInt.h	9 Sep 2007 19:28:31 -0000	1.334
+++ generic/tclInt.h	13 Sep 2007 04:56:06 -0000
@@ -8,6 +8,7 @@
  * Copyright (c) 1994-1998 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.
@@ -2396,6 +2397,7 @@ MODULE_SCOPE int	TclIncrObj(Tcl_Interp *
 			    Tcl_Obj *incrPtr);
 MODULE_SCOPE Tcl_Obj *	TclIncrObjVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
 			    Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags);
+MODULE_SCOPE Tcl_Obj *	TclInfoFrame(Tcl_Interp *interp, CmdFrame *framePtr);
 MODULE_SCOPE int	TclInfoGlobalsCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *CONST objv[]);
 MODULE_SCOPE int	TclInfoLocalsCmd(ClientData dummy, Tcl_Interp *interp,
@@ -3067,6 +3069,19 @@ MODULE_SCOPE int	TclObjCallVarTraces(Int
  *----------------------------------------------------------------
  */
 
+/*
+ * DTrace object allocation probe macros.
+ */
+
+#ifdef USE_DTRACE
+#include "tclDTrace.h"
+#define	TCL_DTRACE_OBJ_CREATE(objPtr)	TCL_OBJ_CREATE(objPtr)
+#define	TCL_DTRACE_OBJ_FREE(objPtr)	TCL_OBJ_FREE(objPtr)
+#else /* USE_DTRACE */
+#define	TCL_DTRACE_OBJ_CREATE(objPtr)	{}
+#define	TCL_DTRACE_OBJ_FREE(objPtr)	{}
+#endif /* USE_DTRACE */
+
 #ifdef TCL_COMPILE_STATS
 #  define TclIncrObjsAllocated() \
     tclObjsAlloced++
@@ -3084,7 +3099,8 @@ MODULE_SCOPE int	TclObjCallVarTraces(Int
     (objPtr)->refCount = 0; \
     (objPtr)->bytes    = tclEmptyStringRep; \
     (objPtr)->length   = 0; \
-    (objPtr)->typePtr  = NULL
+    (objPtr)->typePtr  = NULL; \
+    TCL_DTRACE_OBJ_CREATE(objPtr)
 
 /*
  * Invalidate the string rep first so we can use the bytes value for our
@@ -3096,6 +3112,7 @@ MODULE_SCOPE int	TclObjCallVarTraces(Int
 # define TclDecrRefCount(objPtr) \
     if (--(objPtr)->refCount > 0) ; else { \
 	if (!(objPtr)->typePtr || !(objPtr)->typePtr->freeIntRepProc) { \
+	    TCL_DTRACE_OBJ_FREE(objPtr); \
   	    if ((objPtr)->bytes \
 	            && ((objPtr)->bytes != tclEmptyStringRep)) { \
 	        ckfree((char *) (objPtr)->bytes); \
@@ -3176,7 +3193,8 @@ MODULE_SCOPE void	TclDbInitNewObj(Tcl_Ob
 # define TclDbNewObj(objPtr, file, line) \
     TclIncrObjsAllocated(); \
     (objPtr) = (Tcl_Obj *) Tcl_DbCkalloc(sizeof(Tcl_Obj), (file), (line)); \
-    TclDbInitNewObj(objPtr);
+    TclDbInitNewObj(objPtr); \
+    TCL_DTRACE_OBJ_CREATE(objPtr)
 
 # define TclNewObj(objPtr) \
     TclDbNewObj(objPtr, __FILE__, __LINE__);
@@ -3423,7 +3441,8 @@ MODULE_SCOPE void	TclBNInitBignumFromWid
     (objPtr)->refCount = 0; \
     (objPtr)->bytes = NULL; \
     (objPtr)->internalRep.longValue = (long)(i); \
-    (objPtr)->typePtr = &tclIntType
+    (objPtr)->typePtr = &tclIntType; \
+    TCL_DTRACE_OBJ_CREATE(objPtr)
 
 #define TclNewLongObj(objPtr, l) \
     TclNewIntObj((objPtr), (l))
@@ -3441,14 +3460,16 @@ MODULE_SCOPE void	TclBNInitBignumFromWid
     (objPtr)->refCount = 0; \
     (objPtr)->bytes = NULL; \
     (objPtr)->internalRep.doubleValue = (double)(d); \
-    (objPtr)->typePtr = &tclDoubleType
+    (objPtr)->typePtr = &tclDoubleType; \
+    TCL_DTRACE_OBJ_CREATE(objPtr)
 
 #define TclNewStringObj(objPtr, s, len) \
     TclIncrObjsAllocated(); \
     TclAllocObjStorage(objPtr); \
     (objPtr)->refCount = 0; \
     TclInitStringRep((objPtr), (s), (len));\
-    (objPtr)->typePtr = NULL
+    (objPtr)->typePtr = NULL; \
+    TCL_DTRACE_OBJ_CREATE(objPtr)
 
 #else /* TCL_MEM_DEBUG */
 #define TclNewIntObj(objPtr, i)   \
Index: generic/tclObj.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclObj.c,v
retrieving revision 1.134
diff -u -p -r1.134 tclObj.c
--- generic/tclObj.c	9 Sep 2007 19:28:31 -0000	1.134
+++ generic/tclObj.c	13 Sep 2007 04:56:06 -0000
@@ -8,6 +8,7 @@
  * Copyright (c) 1999 by Scriptics Corporation.
  * Copyright (c) 2001 by ActiveState Corporation.
  * Copyright (c) 2005 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.
@@ -857,6 +858,7 @@ TclFreeObj(
     if (ObjDeletePending(context)) {
 	PushObjToDelete(context, objPtr);
     } else {
+	TCL_DTRACE_OBJ_FREE(objPtr);
 	if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
 	    ObjDeletionLock(context);
 	    typePtr->freeIntRepProc(objPtr);
@@ -866,22 +868,19 @@ TclFreeObj(
 	Tcl_MutexLock(&tclObjMutex);
 	ckfree((char *) objPtr);
 	Tcl_MutexUnlock(&tclObjMutex);
-#ifdef TCL_COMPILE_STATS
-	tclObjsFreed++;
-#endif /* TCL_COMPILE_STATS */
+	TclIncrObjsFreed();
 	ObjDeletionLock(context);
 	while (ObjOnStack(context)) {
 	    Tcl_Obj *objToFree;
 
 	    PopObjToDelete(context,objToFree);
+	    TCL_DTRACE_OBJ_FREE(objToFree);
 	    TclFreeIntRep(objToFree);
 
 	    Tcl_MutexLock(&tclObjMutex);
 	    ckfree((char *) objToFree);
 	    Tcl_MutexUnlock(&tclObjMutex);
-#ifdef TCL_COMPILE_STATS
-	    tclObjsFreed++;
-#endif /* TCL_COMPILE_STATS */
+	    TclIncrObjsFreed();
 	}
 	ObjDeletionUnlock(context);
     }
@@ -905,6 +904,7 @@ TclFreeObj(
 	 * other objects: it will not cause recursive calls to this function.
 	 */
 
+	TCL_DTRACE_OBJ_FREE(objPtr);
 	TclFreeObjStorage(objPtr);
 	TclIncrObjsFreed();
     } else {
@@ -927,6 +927,7 @@ TclFreeObj(
 	     * satisfy this.
 	     */
 
+	    TCL_DTRACE_OBJ_FREE(objPtr);
 	    ObjDeletionLock(context);
 	    objPtr->typePtr->freeIntRepProc(objPtr);
 	    ObjDeletionUnlock(context);
@@ -937,6 +938,7 @@ TclFreeObj(
 	    while (ObjOnStack(context)) {
 		Tcl_Obj *objToFree;
 		PopObjToDelete(context,objToFree);
+		TCL_DTRACE_OBJ_FREE(objToFree);
 		if ((objToFree->typePtr != NULL)
 			&& (objToFree->typePtr->freeIntRepProc != NULL)) {
 		    objToFree->typePtr->freeIntRepProc(objToFree);
Index: generic/tclProc.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclProc.c,v
retrieving revision 1.133
diff -u -p -r1.133 tclProc.c
--- generic/tclProc.c	9 Sep 2007 19:28:31 -0000	1.133
+++ generic/tclProc.c	13 Sep 2007 04:56:07 -0000
@@ -7,6 +7,7 @@
  * Copyright (c) 1987-1993 The Regents of the University of California.
  * Copyright (c) 1994-1998 Sun Microsystems, Inc.
  * Copyright (c) 2004-2006 Miguel Sofer
+ * 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.
@@ -1645,7 +1646,8 @@ TclObjInterpProcCore(
     ProcErrorProc errorProc)	/* How to convert results from the script into
 				 * results of the overall procedure. */
 {
-    register Proc *procPtr = ((Interp *)interp)->varFramePtr->procPtr;
+    Interp *iPtr = (Interp *) interp;
+    register Proc *procPtr = iPtr->varFramePtr->procPtr;
     int result;
     CallFrame *freePtr;
 
@@ -1656,7 +1658,7 @@ TclObjInterpProcCore(
 
 #if defined(TCL_COMPILE_DEBUG)
     if (tclTraceExec >= 1) {
-	register CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
+	register CallFrame *framePtr = iPtr->varFramePtr;
 	register int i;
 
 	if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) {
@@ -1673,12 +1675,33 @@ TclObjInterpProcCore(
     }
 #endif /*TCL_COMPILE_DEBUG*/
 
+    if (TCL_DTRACE_PROC_ARGS_ENABLED()) {
+	char *a[10];
+	int i = 0;
+	int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
+
+	while (i < 10) {
+	    a[i] = (l < iPtr->varFramePtr->objc ? 
+		    TclGetString(iPtr->varFramePtr->objv[l]) : NULL); i++; l++;
+	}
+	TCL_DTRACE_PROC_ARGS(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7],
+		a[8], a[9]);
+    }
+    if (TCL_DTRACE_PROC_INFO_ENABLED() && iPtr->cmdFramePtr) {
+	Tcl_Obj *info = TclInfoFrame(interp, iPtr->cmdFramePtr);
+	char *a[4]; int i[2];
+	
+	TclDTraceInfo(info, a, i);
+	TCL_DTRACE_PROC_INFO(a[0], a[1], a[2], a[3], i[0], i[1]);
+	TclDecrRefCount(info);
+    }
+
     /*
      * Invoke the commands in the procedure's body.
      */
 
     procPtr->refCount++;
-    ((Interp *)interp)->numLevels++;
+    iPtr->numLevels++;
 
     if (TclInterpReady(interp) == TCL_ERROR) {
 	result = TCL_ERROR;
@@ -1687,14 +1710,25 @@ TclObjInterpProcCore(
 		procPtr->bodyPtr->internalRep.otherValuePtr;
 
 	codePtr->refCount++;
+	if (TCL_DTRACE_PROC_ENTRY_ENABLED()) {
+	    int l;
+	    
+	    l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 2 : 1;
+	    TCL_DTRACE_PROC_ENTRY(TclGetString(procNameObj),
+		    iPtr->varFramePtr->objc - l,
+		    (Tcl_Obj **)(iPtr->varFramePtr->objv + l));
+	}
 	result = TclExecuteByteCode(interp, codePtr);
+	if (TCL_DTRACE_PROC_RETURN_ENABLED()) {
+	    TCL_DTRACE_PROC_RETURN(TclGetString(procNameObj), result);
+	}
 	codePtr->refCount--;
 	if (codePtr->refCount <= 0) {
 	    TclCleanupByteCode(codePtr);
 	}
     }
 
-    ((Interp *)interp)->numLevels--;
+    iPtr->numLevels--;
     procPtr->refCount--;
     if (procPtr->refCount <= 0) {
 	TclProcCleanupProc(procPtr);
@@ -1754,6 +1788,14 @@ TclObjInterpProcCore(
 	(void) 0;		/* do nothing */
     }
 
+    if (TCL_DTRACE_PROC_RESULT_ENABLED()) {
+	Tcl_Obj *r;
+
+	r = Tcl_GetObjResult(interp);
+	TCL_DTRACE_PROC_RESULT(TclGetString(procNameObj), result,
+		TclGetString(r), r);
+    }
+
   procDone:
     /*
      * Free the stack-allocated compiled locals and CallFrame. It is important
@@ -1763,7 +1805,7 @@ TclObjInterpProcCore(
      * allocated later on the stack.
      */
 
-    freePtr = ((Interp *)interp)->framePtr;
+    freePtr = iPtr->framePtr;
     Tcl_PopCallFrame(interp);		/* Pop but do not free. */
     TclStackFree(interp, freePtr->compiledLocals);
 					/* Free compiledLocals. */
Index: macosx/GNUmakefile
===================================================================
RCS file: /cvsroot/tcl/tcl/macosx/GNUmakefile,v
retrieving revision 1.6
diff -u -p -r1.6 GNUmakefile
--- macosx/GNUmakefile	6 Sep 2007 05:02:12 -0000	1.6
+++ macosx/GNUmakefile	13 Sep 2007 04:56:07 -0000
@@ -131,7 +131,7 @@ ${OBJ_DIR}/Makefile: ${UNIX_DIR}/Makefil
 	mkdir -p ${OBJ_DIR} && cd ${OBJ_DIR} && \
 	if [ ${UNIX_DIR}/configure -nt config.status ]; then ${UNIX_DIR}/configure -C \
 	--prefix=${PREFIX} --bindir=${BINDIR} --libdir=${LIBDIR} \
-	--mandir=${MANDIR} --enable-threads --enable-framework \
+	--mandir=${MANDIR} --enable-threads --enable-framework --enable-dtrace \
 	${CONFIGURE_ARGS} ${EXTRA_CONFIGURE_ARGS}; else ./config.status; fi
 
 build-${PROJECT}: ${OBJ_DIR}/Makefile
Index: macosx/Tcl-Common.xcconfig
===================================================================
RCS file: /cvsroot/tcl/tcl/macosx/Tcl-Common.xcconfig,v
retrieving revision 1.6
diff -u -p -r1.6 Tcl-Common.xcconfig
--- macosx/Tcl-Common.xcconfig	6 Sep 2007 08:07:18 -0000	1.6
+++ macosx/Tcl-Common.xcconfig	13 Sep 2007 04:56:07 -0000
@@ -34,7 +34,7 @@ MANDIR = $(PREFIX)/man
 PER_ARCH_CFLAGS_ppc = -mcpu=G3 -mtune=G4 $(PER_ARCH_CFLAGS_ppc)
 PER_ARCH_CFLAGS_ppc64 = -mcpu=G5 -mpowerpc64 $(PER_ARCH_CFLAGS_ppc64)
 PREFIX = /usr/local
-TCL_CONFIGURE_ARGS = --enable-threads
+TCL_CONFIGURE_ARGS = --enable-threads --enable-dtrace
 TCL_LIBRARY = $(LIBDIR)/tcl$(VERSION)
 TCL_PACKAGE_PATH = "$(LIBDIR)"
 TCL_DEFS = HAVE_TCL_CONFIG_H
Index: macosx/Tcl.xcodeproj/project.pbxproj
===================================================================
RCS file: /cvsroot/tcl/tcl/macosx/Tcl.xcodeproj/project.pbxproj,v
retrieving revision 1.26
diff -u -p -r1.26 project.pbxproj
--- macosx/Tcl.xcodeproj/project.pbxproj	6 Sep 2007 08:07:18 -0000	1.26
+++ macosx/Tcl.xcodeproj/project.pbxproj	13 Sep 2007 04:56:08 -0000
@@ -160,6 +160,7 @@
 		F9E61D30090A48E2002B3151 /* bn_mp_to_unsigned_bin_n.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C708F272B3004A47F5 /* bn_mp_to_unsigned_bin_n.c */; };
 		F9E61D31090A48F9002B3151 /* bn_mp_to_unsigned_bin.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C608F272B3004A47F5 /* bn_mp_to_unsigned_bin.c */; };
 		F9E61D32090A48FA002B3151 /* bn_mp_unsigned_bin_size.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CC08F272B3004A47F5 /* bn_mp_unsigned_bin_size.c */; };
+		F9F4415E0C8BAE6F00BCCD67 /* tclDTrace.d in Sources */ = {isa = PBXBuildFile; fileRef = F9F4415D0C8BAE6F00BCCD67 /* tclDTrace.d */; };
 		F9FC77B80AB29E9100B7077D /* tclUnixCompat.c in Sources */ = {isa = PBXBuildFile; fileRef = F9FC77B70AB29E9100B7077D /* tclUnixCompat.c */; };
 /* End PBXBuildFile section */
 
@@ -908,6 +909,7 @@
 		F9ECB1CB0B26534C00A28025 /* mathop.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = mathop.test; sourceTree = "<group>"; };
 		F9ECB1E10B26543C00A28025 /* platform_shell.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = platform_shell.n; sourceTree = "<group>"; };
 		F9ECB1E20B26543C00A28025 /* platform.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = platform.n; sourceTree = "<group>"; };
+		F9F4415D0C8BAE6F00BCCD67 /* tclDTrace.d */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.dtrace; path = tclDTrace.d; sourceTree = "<group>"; };
 		F9FC77B70AB29E9100B7077D /* tclUnixCompat.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixCompat.c; sourceTree = "<group>"; };
 /* End PBXFileReference section */
 
@@ -1225,6 +1227,7 @@
 				F96D3EEA08F272A7004A47F5 /* tclDate.c */,
 				F96D3EEB08F272A7004A47F5 /* tclDecls.h */,
 				F96D3EEC08F272A7004A47F5 /* tclDictObj.c */,
+				F9F4415D0C8BAE6F00BCCD67 /* tclDTrace.d */,
 				F96D3EED08F272A7004A47F5 /* tclEncoding.c */,
 				F96D3EEE08F272A7004A47F5 /* tclEnv.c */,
 				F96D3EEF08F272A7004A47F5 /* tclEvent.c */,
@@ -2144,6 +2147,7 @@
 				F96D4AD308F272CA004A47F5 /* tclUnixTest.c in Sources */,
 				F96D4AD408F272CA004A47F5 /* tclUnixThrd.c in Sources */,
 				F96D4AD608F272CA004A47F5 /* tclUnixTime.c in Sources */,
+				F9F4415E0C8BAE6F00BCCD67 /* tclDTrace.d in Sources */,
 			);
 			runOnlyForDeploymentPostprocessing = 0;
 		};
Index: unix/Makefile.in
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/Makefile.in,v
retrieving revision 1.219
diff -u -p -r1.219 Makefile.in
--- unix/Makefile.in	12 Sep 2007 16:43:36 -0000	1.219
+++ unix/Makefile.in	13 Sep 2007 04:56:09 -0000
@@ -216,6 +216,7 @@ COMPAT_OBJS		= @LIBOBJS@
 AC_FLAGS		= @DEFS@
 AR			= @AR@
 RANLIB			= @RANLIB@
+DTRACE			= @DTRACE@
 SRC_DIR			= @srcdir@
 TOP_DIR			= $(SRC_DIR)/..
 BUILD_DIR		= @builddir@
@@ -324,8 +325,12 @@ NOTIFY_OBJS = tclUnixNotfy.o
 
 MAC_OSX_OBJS = tclMacOSXBundle.o tclMacOSXFCmd.o tclMacOSXNotify.o
 
-OBJS = ${GENERIC_OBJS} ${TOMMATH_OBJS} ${UNIX_OBJS} ${NOTIFY_OBJS} \
-	${COMPAT_OBJS} @DL_OBJS@ @PLAT_OBJS@
+DTRACE_OBJ = tclDTrace.o
+
+TCL_OBJS = ${GENERIC_OBJS} ${UNIX_OBJS} ${NOTIFY_OBJS} ${COMPAT_OBJS} \
+	@DL_OBJS@ @PLAT_OBJS@
+
+OBJS = ${TCL_OBJS} ${TOMMATH_OBJS} @DTRACE_OBJ@
 
 TCL_DECLS = \
 	$(GENERIC_DIR)/tcl.decls \
@@ -520,6 +525,10 @@ MAC_OSX_SRCS = \
 	$(MAC_OSX_DIR)/tclMacOSXFCmd.c \
 	$(MAC_OSX_DIR)/tclMacOSXNotify.c
 
+DTRACE_HDR = tclDTrace.h
+
+DTRACE_SRC = $(GENERIC_DIR)/tclDTrace.d
+
 # Note: don't include DL_SRCS or MAC_OSX_SRCS in SRCS: most of those files
 # won't compile on the current machine, and they will cause problems for
 # things like "make depend".
@@ -763,7 +772,8 @@ install-libraries: libraries $(INSTALL_T
 	    $(INSTALL_DATA) $$i $(INCLUDE_INSTALL_DIR); \
 	    done;
 	@echo "Installing library files to $(SCRIPT_INSTALL_DIR)";
-	@for i in $(TOP_DIR)/library/*.tcl $(TOP_DIR)/library/tclIndex $(UNIX_DIR)/tclAppInit.c $(UNIX_DIR)/ldAix; \
+	@for i in $(TOP_DIR)/library/*.tcl $(TOP_DIR)/library/tclIndex \
+		$(UNIX_DIR)/tclAppInit.c $(UNIX_DIR)/ldAix @DTRACE_SRC@; \
 	    do \
 	    $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \
 	    done;
@@ -1437,6 +1447,16 @@ tclMacOSXFCmd.o: $(MAC_OSX_DIR)/tclMacOS
 tclMacOSXNotify.o: $(MAC_OSX_DIR)/tclMacOSXNotify.c
 	$(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tclMacOSXNotify.c
 
+# DTrace support
+
+$(TCL_OBJS): @DTRACE_HDR@
+
+$(DTRACE_HDR): $(DTRACE_SRC)
+	$(DTRACE) -h $(DTRACE_SWITCHES) -o $@ -s $(DTRACE_SRC)
+
+$(DTRACE_OBJ): $(DTRACE_SRC) $(TCL_OBJS)
+	$(DTRACE) -G $(DTRACE_SWITCHES) -o $@ -s $(DTRACE_SRC) $(TCL_OBJS)
+
 # The following targets are not completely general. They are provide purely
 # for documentation purposes so people who are interested in the Xt based
 # notifier can modify them to suit their own installation.
Index: unix/configure.in
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/configure.in,v
retrieving revision 1.160
diff -u -p -r1.160 configure.in
--- unix/configure.in	7 Aug 2007 05:06:20 -0000	1.160
+++ unix/configure.in	13 Sep 2007 04:56:12 -0000
@@ -585,6 +585,7 @@ AC_MSG_RESULT([$tcl_ok])
 #	to be installed by Tcl. The default is autodetection, but can
 #	be overriden on the configure command line either way.
 #------------------------------------------------------------------------
+
 AC_MSG_CHECKING([for timezone data])
 AC_ARG_WITH(tzdata,
     AC_HELP_STRING([--with-tzdata],
@@ -629,7 +630,32 @@ then
     AC_MSG_RESULT([supplied by Tcl])
     INSTALL_TZDATA=install-tzdata
 fi
-AC_SUBST(INSTALL_TZDATA)
+
+#--------------------------------------------------------------------
+#	DTrace support
+#--------------------------------------------------------------------
+
+AC_ARG_ENABLE(dtrace,
+    AC_HELP_STRING([--enable-dtrace],
+	[build with DTrace support (default: off)]),
+    [tcl_ok=$enableval], [tcl_ok=no])
+if test $tcl_ok = yes; then
+    AC_CHECK_HEADER(sys/sdt.h, [tcl_ok=yes], [tcl_ok=no])
+fi
+if test $tcl_ok = yes; then
+    AC_PATH_PROG(DTRACE, dtrace,, [$PATH:/usr/sbin])
+    test -z "$ac_cv_path_DTRACE" && tcl_ok=no
+fi
+AC_MSG_CHECKING([whether to enable DTrace support])
+if test $tcl_ok = yes; then
+    AC_DEFINE(USE_DTRACE, 1, [Are we building with DTrace support?])
+    DTRACE_SRC="\${DTRACE_SRC}"
+    DTRACE_HDR="\${DTRACE_HDR}"
+    if test "`uname -s`" != "Darwin" ; then
+	DTRACE_OBJ="\${DTRACE_OBJ}"
+    fi
+fi
+AC_MSG_RESULT([$tcl_ok])
 
 #--------------------------------------------------------------------
 #	The statements below define a collection of symbols related to
@@ -818,6 +844,12 @@ AC_SUBST(TCL_UNSHARED_LIB_SUFFIX)
 
 AC_SUBST(TCL_HAS_LONGLONG)
 
+AC_SUBST(INSTALL_TZDATA)
+
+AC_SUBST(DTRACE_SRC)
+AC_SUBST(DTRACE_HDR)
+AC_SUBST(DTRACE_OBJ)
+
 AC_SUBST(BUILD_DLTEST)
 AC_SUBST(TCL_PACKAGE_PATH)
 AC_SUBST(TCL_MODULE_PATH)
Index: unix/tclConfig.h.in
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclConfig.h.in,v
retrieving revision 1.21
diff -u -p -r1.21 tclConfig.h.in
--- unix/tclConfig.h.in	2 Aug 2007 07:32:46 -0000	1.21
+++ unix/tclConfig.h.in	13 Sep 2007 04:56:12 -0000
@@ -418,6 +418,9 @@
 /* May we include <dirent2.h>? */
 #undef USE_DIRENT2_H
 
+/* Are we building with DTrace support? */
+#undef USE_DTRACE
+
 /* Should we use FIONBIO? */
 #undef USE_FIONBIO
 
