Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.75.2.26
diff -u -p -r1.75.2.26 tclBasic.c
--- generic/tclBasic.c	28 Nov 2006 22:19:59 -0000	1.75.2.26
+++ generic/tclBasic.c	13 Sep 2007 04:55:48 -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.
@@ -52,6 +53,11 @@ static int            EvalTokensStandard
 
 #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, 
         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, 
 	(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, patchLeve
         *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
Index: generic/tclCompile.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.h,v
retrieving revision 1.33.2.1
diff -u -p -r1.33.2.1 tclCompile.h
--- generic/tclCompile.h	28 Nov 2006 22:20:00 -0000	1.33.2.1
+++ generic/tclCompile.h	13 Sep 2007 04:55:48 -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.
@@ -1082,6 +1083,80 @@ EXTERN int		TclCompileVariableCmd _ANSI_
 #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_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_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_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_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)
+
+#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_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_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_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_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) {}
+
+#endif /* USE_DTRACE */
+
 # undef TCL_STORAGE_CLASS
 # define TCL_STORAGE_CLASS DLLIMPORT
 
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:55:48 -0000
@@ -0,0 +1,185 @@
+/*
+ * 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);
+
+    /***************************** 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);
+
+    /***************************** 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;
+    } 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.94.2.21
diff -u -p -r1.94.2.21 tclExecute.c
--- generic/tclExecute.c	13 Mar 2007 16:26:32 -0000	1.94.2.21
+++ generic/tclExecute.c	13 Sep 2007 04:55:50 -0000
@@ -259,6 +259,31 @@ long		tclObjsShared[TCL_MAX_SHARED_OBJ_S
 #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, stackTop - initStackTop,\
+		    stackPtr + stackTop);\
+	}\
+	curInstName = tclInstructionTable[*pc].name;\
+	if (TCL_DTRACE_INST_START_ENABLED()) {\
+	    TCL_DTRACE_INST_START(curInstName, stackTop - initStackTop,\
+		    stackPtr + stackTop);\
+	}\
+    } else if (TCL_DTRACE_INST_START_ENABLED()) {\
+	TCL_DTRACE_INST_START(tclInstructionTable[*pc].name,\
+		stackTop - initStackTop, stackPtr + stackTop);\
+    }
+#define TCL_DTRACE_INST_LAST() \
+    if (TCL_DTRACE_INST_DONE_ENABLED() && curInstName) {\
+	TCL_DTRACE_INST_DONE(curInstName, stackTop - initStackTop,\
+		stackPtr + stackTop);\
+    }
+
+/*
  * Macro to read a string containing either a wide or an int and
  * decide which it is while decoding it at the same time.  This
  * enforces the policy that integer constants between LONG_MIN and
@@ -1115,6 +1140,7 @@ TclExecuteByteCode(interp, codePtr)
     int traceInstructions = (tclTraceExec == 3);
     char cmdNameBuf[21];
 #endif
+    char *curInstName = NULL;
 
     /*
      * This procedure uses a stack to hold information about catch commands.
@@ -1259,6 +1285,9 @@ TclExecuteByteCode(interp, codePtr)
 #ifdef TCL_COMPILE_STATS    
     iPtr->stats.instructionCount[*pc]++;
 #endif
+
+     TCL_DTRACE_INST_NEXT();
+
     switch (*pc) {
     case INST_DONE:
 	if (stackTop <= initStackTop) {
@@ -4035,6 +4064,7 @@ TclExecuteByteCode(interp, codePtr)
 	 */
 
 	pc += 5;
+	TCL_DTRACE_INST_NEXT();
 #else
 	NEXT_INST_F(5, 0, 0);
 #endif	
@@ -4390,6 +4420,7 @@ TclExecuteByteCode(interp, codePtr)
      */
 
  abnormalReturn:
+    TCL_DTRACE_INST_LAST();
     while (stackTop > initStackTop) {
 	valuePtr = POP_OBJECT();
 	TclDecrRefCount(valuePtr);
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.118.2.29
diff -u -p -r1.118.2.29 tclInt.h
--- generic/tclInt.h	23 Aug 2007 00:27:21 -0000	1.118.2.29
+++ generic/tclInt.h	13 Sep 2007 04:55:51 -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.
@@ -2300,6 +2301,19 @@ EXTERN Tcl_Obj *TclPtrIncrVar _ANSI_ARGS
  *----------------------------------------------------------------
  */
 
+/*
+ * 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++
@@ -2316,7 +2330,8 @@ EXTERN Tcl_Obj *TclPtrIncrVar _ANSI_ARGS
     (objPtr)->refCount = 0; \
     (objPtr)->bytes    = tclEmptyStringRep; \
     (objPtr)->length   = 0; \
-    (objPtr)->typePtr  = NULL
+    (objPtr)->typePtr  = NULL; \
+    TCL_DTRACE_OBJ_CREATE(objPtr)
 
 
 #ifdef TCL_MEM_DEBUG
@@ -2325,6 +2340,7 @@ EXTERN Tcl_Obj *TclPtrIncrVar _ANSI_ARGS
 #else
 #   define TclDecrRefCount(objPtr) \
     if (--(objPtr)->refCount <= 0) { \
+	TCL_DTRACE_OBJ_FREE(objPtr); \
 	if (((objPtr)->typePtr != NULL) \
 		&& ((objPtr)->typePtr->freeIntRepProc != NULL)) { \
 	    (objPtr)->typePtr->freeIntRepProc(objPtr); \
@@ -2356,7 +2372,9 @@ EXTERN Tcl_Obj *TclPtrIncrVar _ANSI_ARGS
        (objPtr)->bytes    = tclEmptyStringRep; \
        (objPtr)->length   = 0; \
        (objPtr)->typePtr  = NULL; \
-       TclIncrObjsAllocated()
+       TclIncrObjsAllocated(); \
+       TCL_DTRACE_OBJ_CREATE(objPtr)
+
      
 #elif defined(PURIFY)
 
Index: generic/tclObj.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclObj.c,v
retrieving revision 1.42.2.14
diff -u -p -r1.42.2.14 tclObj.c
--- generic/tclObj.c	29 Nov 2005 14:02:04 -0000	1.42.2.14
+++ generic/tclObj.c	13 Sep 2007 04:55:52 -0000
@@ -7,6 +7,7 @@
  * Copyright (c) 1995-1997 Sun Microsystems, Inc.
  * Copyright (c) 1999 by Scriptics Corporation.
  * Copyright (c) 2001 by ActiveState Corporation.
+ * 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.
@@ -674,6 +675,7 @@ TclFreeObj(objPtr)
     }
 #endif /* TCL_MEM_DEBUG */
 
+    TCL_DTRACE_OBJ_FREE(objPtr);
     if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
 	typePtr->freeIntRepProc(objPtr);
     }
@@ -698,9 +700,7 @@ TclFreeObj(objPtr)
     Tcl_MutexUnlock(&tclObjMutex);
 #endif /* TCL_MEM_DEBUG */
 
-#ifdef TCL_COMPILE_STATS
-    tclObjsFreed++;
-#endif /* TCL_COMPILE_STATS */
+    TclIncrObjsFreed();
 }
 
 /*
Index: generic/tclProc.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclProc.c,v
retrieving revision 1.44.2.6
diff -u -p -r1.44.2.6 tclProc.c
--- generic/tclProc.c	28 Nov 2006 22:20:02 -0000	1.44.2.6
+++ generic/tclProc.c	13 Sep 2007 04:55:52 -0000
@@ -6,6 +6,7 @@
  *
  * Copyright (c) 1987-1993 The Regents of the University of California.
  * Copyright (c) 1994-1998 Sun Microsystems, Inc.
+ * 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.
@@ -1158,8 +1159,23 @@ TclObjInterpProc(clientData, interp, obj
     }
 #endif /*TCL_COMPILE_DEBUG*/
 
+    if (TCL_DTRACE_PROC_ARGS_ENABLED()) {
+	char *a[10];
+	int i = 0;
+
+	while (i < 10) {
+	    a[i] = i < objc ? TclGetString(objv[i]) : NULL; i++;
+	}
+	TCL_DTRACE_PROC_ARGS(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7],
+		a[8], a[9]);
+    }
+
     iPtr->returnCode = TCL_OK;
     procPtr->refCount++;
+    if (TCL_DTRACE_PROC_ENTRY_ENABLED()) {
+	TCL_DTRACE_PROC_ENTRY(TclGetString(objv[0]), objc - 1,
+		(Tcl_Obj **)(objv + 1));
+    }
 #ifndef TCL_TIP280
     result = TclCompEvalObj(interp, procPtr->bodyPtr);
 #else
@@ -1169,6 +1185,9 @@ TclObjInterpProc(clientData, interp, obj
 
     result = TclCompEvalObj(interp, procPtr->bodyPtr, NULL, 0);
 #endif
+    if (TCL_DTRACE_PROC_RETURN_ENABLED()) {
+	TCL_DTRACE_PROC_RETURN(TclGetString(objv[0]), result);
+    }
     procPtr->refCount--;
     if (procPtr->refCount <= 0) {
 	TclProcCleanupProc(procPtr);
@@ -1178,6 +1197,14 @@ TclObjInterpProc(clientData, interp, obj
 	result = ProcessProcResultCode(interp, procName, nameLen, result);
     }
     
+    if (TCL_DTRACE_PROC_RESULT_ENABLED()) {
+	Tcl_Obj *r;
+
+	r = Tcl_GetObjResult(interp);
+	TCL_DTRACE_PROC_RESULT(TclGetString(objv[0]), result,
+		TclGetString(r), r);
+    }
+
     /*
      * Pop and free the call frame for this procedure invocation, then
      * free the compiledLocals array if malloc'ed storage was used.
Index: macosx/Makefile
===================================================================
RCS file: /cvsroot/tcl/tcl/macosx/Attic/Makefile,v
retrieving revision 1.5.2.17
diff -u -p -r1.5.2.17 Makefile
--- macosx/Makefile	29 Apr 2007 02:21:33 -0000	1.5.2.17
+++ macosx/Makefile	13 Sep 2007 04:55:52 -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 \
 	--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: unix/Makefile.in
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/Makefile.in,v
retrieving revision 1.121.2.22
diff -u -p -r1.121.2.22 Makefile.in
--- unix/Makefile.in	7 Aug 2007 05:06:41 -0000	1.121.2.22
+++ unix/Makefile.in	13 Sep 2007 04:55:53 -0000
@@ -254,6 +254,7 @@ COMPAT_OBJS		= @LIBOBJS@
 AC_FLAGS		= @DEFS@
 AR			= @AR@
 RANLIB			= @RANLIB@
+DTRACE			= @DTRACE@
 SRC_DIR			= @srcdir@
 TOP_DIR			= $(SRC_DIR)/..
 GENERIC_DIR		= $(TOP_DIR)/generic
@@ -288,7 +289,7 @@ DDD			= ddd
 # either.
 #----------------------------------------------------------------
 
-STUB_CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \
+STUB_CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} -I. \
 -I${GENERIC_DIR} -I${SRC_DIR} ${AC_FLAGS} ${MATH_FLAGS} ${GENERIC_FLAGS} \
 ${PROTO_FLAGS} ${MEM_DEBUG_FLAGS} ${COMPILE_DEBUG_FLAGS} ${ENV_FLAGS} \
 -DTCL_SHLIB_EXT=\"${SHLIB_SUFFIX}\" @EXTRA_CC_SWITCHES@
@@ -330,9 +331,13 @@ STUB_LIB_OBJS = tclStubLib.o ${COMPAT_OB
 
 MAC_OSX_OBJS = tclMacOSXBundle.o tclMacOSXNotify.o
 
-OBJS = ${GENERIC_OBJS} ${UNIX_OBJS} ${NOTIFY_OBJS} ${COMPAT_OBJS} \
+DTRACE_OBJ = tclDTrace.o
+
+TCL_OBJS = ${GENERIC_OBJS} ${UNIX_OBJS} ${NOTIFY_OBJS} ${COMPAT_OBJS} \
         @DL_OBJS@ @PLAT_OBJS@
 
+OBJS = ${TCL_OBJS} @DTRACE_OBJ@
+
 TCL_DECLS = \
 	$(GENERIC_DIR)/tcl.decls \
 	$(GENERIC_DIR)/tclInt.decls
@@ -452,6 +457,10 @@ MAC_OSX_SRCS = \
 	$(MAC_OSX_DIR)/tclMacOSXBundle.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".
@@ -670,7 +679,8 @@ install-libraries: libraries
 	    $(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;
@@ -1092,6 +1102,16 @@ tclMacOSXBundle.o: $(MAC_OSX_DIR)/tclMac
 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.106.2.38
diff -u -p -r1.106.2.38 configure.in
--- unix/configure.in	7 Aug 2007 05:06:44 -0000	1.106.2.38
+++ unix/configure.in	13 Sep 2007 04:55:55 -0000
@@ -530,6 +530,31 @@ fi
 SC_BLOCKING_STYLE
 
 #--------------------------------------------------------------------
+#	DTrace support
+#--------------------------------------------------------------------
+
+AC_ARG_ENABLE(dtrace,
+    [  --enable-dtrace         build with DTrace support [--disable-dtrace]],
+    [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)
+    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
 #	building libtcl as a shared library instead of a static library.
 #--------------------------------------------------------------------
@@ -718,6 +743,10 @@ AC_SUBST(TCL_UNSHARED_LIB_SUFFIX)
 
 AC_SUBST(TCL_HAS_LONGLONG)
 
+AC_SUBST(DTRACE_SRC)
+AC_SUBST(DTRACE_HDR)
+AC_SUBST(DTRACE_OBJ)
+
 AC_SUBST(BUILD_DLTEST)
 AC_SUBST(TCL_PACKAGE_PATH)
 
