* 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/GNUmakefile:		  enable DTrace support.
	* macosx/Tcl-Common.xcconfig:
	* macosx/Tcl.xcodeproj/project.pbxproj:

	* unix/configure: autoconf-2.59
	* unix/tclConfig.h.in: autoheader-2.59

1 files changed, 31 insertions, 1 deletions

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index d2bec9b..584c747 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -8,11 +8,12 @@
  * 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.
  *
- * RCS: @(#) $Id: tclExecute.c,v 1.335 2007/09/11 14:47:43 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.336 2007/09/13 15:27:07 das Exp $
  */
 
 #include "tclInt.h"
@@ -318,6 +319,28 @@ VarHashCreateVar(TclVarHashTable *tablePtr, Tcl_Obj *key, int *newPtr)
 #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);