* generic/tclBasic.c (TEOvI, GetCommandSource):

	* generic/tclExecute.c (TEBC, TclGetSrcInfoForCmd):
	* generic/tclInt.h:
	* generic/tclTrace.c (TclCheck(Interp|Execution)Traces):
	Removed the need for TEBC to inspect the command before calling
	TEOvI, leveraging the TIP 282 infrastructure. Moved the generation
	of a correct nul-terminated command string away from the trace
	code, back into TEOvI/GetCommandSource.

5 files changed, 80 insertions, 73 deletions

diff --git a/ChangeLog b/ChangeLog
index 494c538..c0d1a5c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2007-07-24  Miguel Sofer  <msofer@users.sf.net>
+
+	* generic/tclBasic.c (TEOvI, GetCommandSource):
+	* generic/tclExecute.c (TEBC, TclGetSrcInfoForCmd):
+	* generic/tclInt.h:    
+	Removed the need for TEBC to inspect the command before calling
+	TEOvI, leveraging the TIP 282 infrastructure. 
+
 2007-07-20  Andreas Kupries  <andreask@activestate.com>
 
 	* library/platform/platform.tcl: Fixed bug in 'platform::patterns'
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 760a92c..3f7c983 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -13,7 +13,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.262 2007/06/29 03:16:01 das Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.263 2007/07/24 03:05:53 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -54,6 +54,8 @@ static char *	CallCommandTraces(Interp *iPtr, Command *cmdPtr,
 static int	CheckDoubleResult(Tcl_Interp *interp, double dResult);
 static void	DeleteInterpProc(Tcl_Interp *interp);
 static void	DeleteOpCmdClientData(ClientData clientData);
+static Tcl_Obj *GetCommandSource(Interp *iPtr, const char *command,
+	            int numChars, int objc, Tcl_Obj *const objv[]);
 static void	ProcessUnexpectedResult(Tcl_Interp *interp, int returnCode);
 static int	OldMathFuncProc(ClientData clientData, Tcl_Interp *interp,
 		    int argc, Tcl_Obj *const *objv);
@@ -2863,6 +2865,40 @@ CallCommandTraces(
     Tcl_Release((ClientData) iPtr);
     return result;
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetCommandSource --
+ *
+ *	This function returns a Tcl_Obj with the full source string for the
+ *	command. This insures that traces get a correct nul-terminated command
+ *	string. 
+ *
+ */
+
+static Tcl_Obj *
+GetCommandSource(
+    Interp *iPtr,
+    const char *command,
+    int numChars, 
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Tcl_Obj *commandPtr;
+    
+    if (!command) {
+	commandPtr = Tcl_NewListObj(objc, objv);
+    } else {
+	if (command == (char *) -1) {
+	    command = TclGetSrcInfoForCmd(iPtr, &numChars);
+	}
+	commandPtr = Tcl_NewStringObj(command, numChars);
+    }
+
+    return commandPtr;
+}
+
 
 /*
  *----------------------------------------------------------------------
@@ -3358,7 +3394,9 @@ TclEvalObjvInternal(
 				 * representation of the command; this is used
 				 * for traces. NULL if the string
 				 * representation of the command is unknown is
-				 * to be generated from (objc,objv).*/
+				 * to be generated from (objc,objv), -1 if it
+				 * is to be generated from bytecode
+				 * source. This is only needed the traces. */
     int length,			/* Number of bytes in command; if -1, all
 				 * characters up to the first null byte are
 				 * used. */
@@ -3378,7 +3416,7 @@ TclEvalObjvInternal(
     int checkTraces = 1, traced;
     Namespace *savedNsPtr = NULL;
     Namespace *lookupNsPtr = iPtr->lookupNsPtr;
-    
+    Tcl_Obj *commandPtr = NULL;
     
     if (TclInterpReady(interp) == TCL_ERROR) {
 	return TCL_ERROR;
@@ -3449,6 +3487,14 @@ TclEvalObjvInternal(
 	int newEpoch;
 
 	/*
+	 * Insure that we have a correct nul-terminated command string for the
+	 * trace code.
+	 */
+
+	commandPtr = GetCommandSource(iPtr, command, length, objc, objv);
+	command = Tcl_GetStringFromObj(commandPtr, &length);
+	
+	/*
 	 * Execute any command or execution traces. Note that we bump up the
 	 * command's reference count for the duration of the calling of the
 	 * traces so that the structure doesn't go away underneath our feet.
@@ -3521,6 +3567,9 @@ TclEvalObjvInternal(
 	if (traceCode != TCL_OK) {
 	    code = traceCode;
 	}
+	if (commandPtr) {
+	    Tcl_DecrRefCount(commandPtr);
+	}
     }
     
     /*
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 63096ec..fb4570e 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -12,7 +12,7 @@
  * 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.305 2007/06/28 21:24:56 dgp Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.306 2007/07/24 03:05:53 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -1975,7 +1975,6 @@ TclExecuteByteCode(
     doInvocation:
 	{
 	    Tcl_Obj **objv = &OBJ_AT_DEPTH(objc-1);
-	    Command *cmdPtr;
 
 #ifdef TCL_COMPILE_DEBUG
 	    if (tclTraceExec >= 2) {
@@ -2014,37 +2013,8 @@ TclExecuteByteCode(
 	    bcFramePtr->data.tebc.pc = (char *) pc;
 	    iPtr->cmdFramePtr = bcFramePtr;
 	    DECACHE_STACK_INFO();
-	    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]);
-
-	    if (cmdPtr 
-		    && !((cmdPtr->flags & CMD_HAS_EXEC_TRACES) || iPtr->tracePtr)
-		    && !(checkInterp && (codePtr->compileEpoch != iPtr->compileEpoch))
-		) {
-		cmdPtr->refCount++;
-		iPtr->cmdCount++;
-		result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
-		
-		if (Tcl_AsyncReady()) {
-		    result = Tcl_AsyncInvoke(interp, result);
-		}
-		if (result == TCL_OK && TclLimitReady(iPtr->limit)) {
-		    result = Tcl_LimitCheck(interp);
-		}
-		TclCleanupCommandMacro(cmdPtr);
-	    } else {
-		/*
-		 * If trace procedures will be called, we need a command
-		 * string to pass to TclEvalObjvInternal; note that a copy of
-		 * the string will be made there to include the ending \0.
-		 */
-		int length;
-		const char *bytes;
-
-		bytes = GetSrcInfoForPc(pc, codePtr, &length);
-		result = TclEvalObjvInternal(interp, objc, objv, bytes,
-			length, 0);
-	    }
-
+	    result = TclEvalObjvInternal(interp, objc, objv,
+		    /* call from TEBC */(char *) -1, -1, 0);
 	    CACHE_STACK_INFO();
 	    iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
 
@@ -6858,7 +6828,7 @@ IllegalExprOperandType(
 /*
  *----------------------------------------------------------------------
  *
- * TclGetSrcInfoForPc, GetSrcInfoForPc --
+ * TclGetSrcInfoForPc, GetSrcInfoForPc, TclGetSrcInfoForCmd --
  *
  *	Given a program counter value, finds the closest command in the
  *	bytecode code unit's CmdLocation array and returns information about
@@ -6879,6 +6849,18 @@ IllegalExprOperandType(
  *----------------------------------------------------------------------
  */
 
+const char *
+TclGetSrcInfoForCmd(
+    Interp *iPtr,
+    int *lenPtr)
+{
+    CmdFrame *cfPtr = iPtr->cmdFramePtr;
+    ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr;
+
+    return GetSrcInfoForPc((unsigned char *) cfPtr->data.tebc.pc,
+	    codePtr, lenPtr);
+}
+
 void
 TclGetSrcInfoForPc(
     CmdFrame *cfPtr)
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 435f6bd..7ab0750 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInt.h,v 1.323 2007/07/02 17:32:09 dgp Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.324 2007/07/24 03:05:53 msofer Exp $
  */
 
 #ifndef _TCLINT
@@ -2289,6 +2289,7 @@ MODULE_SCOPE int	TclGetOpenModeEx(Tcl_Interp *interp,
 			    CONST char *modeString, int *seekFlagPtr,
 			    int *binaryPtr);
 MODULE_SCOPE Tcl_Obj *	TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr);
+MODULE_SCOPE const char *TclGetSrcInfoForCmd(Interp *iPtr, int *lenPtr);
 MODULE_SCOPE int	TclGlob(Tcl_Interp *interp, char *pattern,
 			    Tcl_Obj *unquotedPrefix, int globFlags,
 			    Tcl_GlobTypeData *types);
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index 638893f..a0c777c 100644
--- a/generic/tclTrace.c
+++ b/generic/tclTrace.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclTrace.c,v 1.41 2007/06/28 21:10:38 patthoyts Exp $
+ * RCS: @(#) $Id: tclTrace.c,v 1.42 2007/07/24 03:05:53 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -1413,24 +1413,11 @@ TclCheckExecutionTraces(
     int traceCode = TCL_OK;
     TraceCommandInfo* tcmdPtr;
     Tcl_InterpState state = NULL;
-    Tcl_Obj *commandPtr = NULL;
 
     if (cmdPtr->tracePtr == NULL) {
 	return traceCode;
     }
 
-    /*
-     * Insure that we have a nul-terminated command string
-     */
-    
-    if (!command) {
-	commandPtr = Tcl_NewListObj(objc, objv);
-	command = Tcl_GetStringFromObj(commandPtr, &numChars);
-    } else if ((numChars != -1) && (command[numChars] != '\0')) {
-	commandPtr = Tcl_NewStringObj(command, numChars);
-	command = TclGetString(commandPtr);
-    }
-    
     curLevel = iPtr->varFramePtr->level;
 
     active.nextPtr = iPtr->activeCmdTracePtr;
@@ -1482,9 +1469,6 @@ TclCheckExecutionTraces(
 	(void) Tcl_RestoreInterpState(interp, state);
     }
 
-    if (commandPtr) {
-	Tcl_DecrRefCount(commandPtr);
-    }
     return(traceCode);
 }
 
@@ -1515,8 +1499,7 @@ int
 TclCheckInterpTraces(
     Tcl_Interp *interp,		/* The current interpreter. */
     CONST char *command,	/* Pointer to beginning of the current command
-				 * string. If NULL, the string will be
-				 * generated from (objc,objv) */
+				 * string. */
     int numChars,		/* The number of characters in 'command' which
 				 * are part of the command string. */
     Command *cmdPtr,		/* Points to command's Command struct. */
@@ -1531,25 +1514,12 @@ TclCheckInterpTraces(
     int curLevel;
     int traceCode = TCL_OK;
     Tcl_InterpState state = NULL;
-    Tcl_Obj *commandPtr = NULL;
 
     if ((iPtr->tracePtr == NULL)
 	    || (iPtr->flags & INTERP_TRACE_IN_PROGRESS)) {
 	return(traceCode);
     }
 
-    /*
-     * Insure that we have a nul-terminated command string
-     */
-    
-    if (!command) {
-	commandPtr = Tcl_NewListObj(objc, objv);
-	command = Tcl_GetStringFromObj(commandPtr, &numChars);
-    } else if ((numChars != -1) && (command[numChars] != '\0')) {
-	commandPtr = Tcl_NewStringObj(command, numChars);
-	command = TclGetString(commandPtr);
-    }
-    
     curLevel = iPtr->numLevels;
 
     active.nextPtr = iPtr->activeInterpTracePtr;
@@ -1648,9 +1618,6 @@ TclCheckInterpTraces(
 	}
     }
 
-    if (commandPtr) {
-	Tcl_DecrRefCount(commandPtr);
-    }
     return(traceCode);
 }