* generic/tclBasic.c: Split TEOv in two, by separating a

	processor for non-TCL_OK returns. Also spli TEOvI in a full
	version that handles non-existing and traced commands, and a
	separate shorter version for the regular case.

	* generic/tclBasic.c:   Moved the generation of command strings	for
	* generic/tclTrace.c:   traces: previously in Tcl_EvalObjv(), now
	in TclCheck[Interp|Execution]Traces(). Also insured that the
	strings are properly nul terminated at the correct length
	[Bug 1693986]

	* generic/tclBasic.c:   Extend usage of TclLimitReady() and
	* generic/tclExecute.c: (new) TclLimitExceeded() macros.
	* generic/tclInt.h:
	* generic/tclInterp.c:

	* generic/tclInt.h:     New TclCleanupCommandMacro for core usage.
	* generic/tclBasic.c:
	* generic/tclExecute.c:
	* generic/tclObj.c:

1 files changed, 249 insertions, 107 deletions

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 06cc63e..61b662b 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.246 2007/06/05 17:57:06 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.247 2007/06/09 20:12:54 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -91,6 +91,12 @@ static int	ExprWideFunc(ClientData clientData, Tcl_Interp *interp,
 static void	MathFuncWrongNumArgs(Tcl_Interp* interp, int expected,
 		    int actual, Tcl_Obj *const *objv);
 
+static int      FullEvalObjvInternal(Tcl_Interp *interp, int objc,
+	            Tcl_Obj *const objv[], const char *command,
+	            int length, int flags);
+static int      ProcessEvalObjvReturn(Tcl_Interp *interp, int objc,
+	            Tcl_Obj *const objv[], int flags, int code); 
+
 extern TclStubs tclStubs;
 
 /*
@@ -2271,7 +2277,7 @@ TclRenameCommand(
      * deleted by invocation of rename traces.
      */
 
-    TclCleanupCommand(cmdPtr);
+    TclCleanupCommandMacro(cmdPtr);
     result = TCL_OK;
 
   done:
@@ -2756,7 +2762,7 @@ Tcl_DeleteCommandFromToken(
      * looks up the command in the command hashtable).
      */
 
-    TclCleanupCommand(cmdPtr);
+    TclCleanupCommandMacro(cmdPtr);
     return 0;
 }
 
@@ -3392,15 +3398,18 @@ TclInterpReady(
  * Side effects:
  *	Depends on the command.
  *
- * Note to maintainers:
- *      This function has to be kept in sync with the shortcut version in
+ * Notes to maintainers:
+ *    * This function has to be kept in sync with the shortcut version in
  *      TclExecuteByteCode (INST_INVOKE).
+ *    * This function has been split in two: a full version that processes
+ *      unknown an traced commands too, and a shorter one that handles the
+ *      normal case. They have to be kept in sync.
  *
  *----------------------------------------------------------------------
  */
 
-int
-TclEvalObjvInternal(
+static int
+FullEvalObjvInternal(
     Tcl_Interp *interp,		/* Interpreter in which to evaluate the
 				 * command. Also used for error reporting. */
     int objc,			/* Number of words in command. */
@@ -3408,10 +3417,9 @@ TclEvalObjvInternal(
 				 * the words that make up the command. */
     const char *command,	/* Points to the beginning of the string
 				 * representation of the command; this is used
-				 * for traces. If the string representation of
-				 * the command is unknown, an empty string
-				 * should be supplied. If it is NULL, no
-				 * traces will be called. */
+				 * for traces. NULL if the string
+				 * representation of the command is unknown is
+				 * to be generated from (objc,objv).*/
     int length,			/* Number of bytes in command; if -1, all
 				 * characters up to the first null byte are
 				 * used. */
@@ -3429,17 +3437,10 @@ TclEvalObjvInternal(
     int code = TCL_OK;
     int traceCode = TCL_OK;
     int checkTraces = 1;
+    int haveTraces;
     Namespace *savedNsPtr = NULL;
     Namespace *lookupNsPtr = iPtr->lookupNsPtr;
 
-    if (TclInterpReady(interp) == TCL_ERROR) {
-	return TCL_ERROR;
-    }
-
-    if (objc == 0) {
-	return TCL_OK;
-    }
-
     /*
      * If any execution traces rename or delete the current command, we may
      * need (at most) two passes here.
@@ -3451,18 +3452,20 @@ TclEvalObjvInternal(
      * Configure evaluation context to match the requested flags.
      */
 
-    if ((flags & TCL_EVAL_GLOBAL) && (varFramePtr != iPtr->rootFramePtr)
-	    && !savedVarFramePtr) {
-	varFramePtr = iPtr->rootFramePtr;
-	savedVarFramePtr = iPtr->varFramePtr;
-	iPtr->varFramePtr = varFramePtr;
-    } else if (flags & TCL_EVAL_INVOKE) {
-	savedNsPtr = varFramePtr->nsPtr;
-	if (lookupNsPtr) {
-	    varFramePtr->nsPtr = lookupNsPtr;
-	    iPtr->lookupNsPtr = NULL;
-	} else {
-	    varFramePtr->nsPtr = iPtr->globalNsPtr;
+    if (flags) {
+	if (flags & TCL_EVAL_INVOKE) {
+	    savedNsPtr = varFramePtr->nsPtr;
+	    if (lookupNsPtr) {
+		varFramePtr->nsPtr = lookupNsPtr;
+		iPtr->lookupNsPtr = NULL;
+	    } else {
+		varFramePtr->nsPtr = iPtr->globalNsPtr;
+	    }
+	} else if ((flags & TCL_EVAL_GLOBAL) && (varFramePtr != iPtr->rootFramePtr)
+		&& !savedVarFramePtr) {
+	    varFramePtr = iPtr->rootFramePtr;
+	    savedVarFramePtr = iPtr->varFramePtr;
+	    iPtr->varFramePtr = varFramePtr;
 	}
     }
 
@@ -3567,7 +3570,8 @@ TclEvalObjvInternal(
      * Call trace functions if needed.
      */
 
-    if (checkTraces && (command != NULL)) {
+    haveTraces = (iPtr->tracePtr != NULL) || (cmdPtr->flags & CMD_HAS_EXEC_TRACES);
+    if (haveTraces && checkTraces) {
 	int cmdEpoch = cmdPtr->cmdEpoch;
 	int newEpoch;
 
@@ -3587,7 +3591,7 @@ TclEvalObjvInternal(
 		    cmdPtr, code, TCL_TRACE_ENTER_EXEC, objc, objv);
 	}
 	newEpoch = cmdPtr->cmdEpoch;
-	TclCleanupCommand(cmdPtr);
+	TclCleanupCommandMacro(cmdPtr);
 
 	/*
 	 * If the traces modified/deleted the command or any existing traces,
@@ -3609,7 +3613,7 @@ TclEvalObjvInternal(
 
     cmdPtr->refCount++;
     iPtr->cmdCount++;
-    if (code == TCL_OK && traceCode == TCL_OK && !Tcl_LimitExceeded(interp)) {
+    if (code == TCL_OK && traceCode == TCL_OK && !TclLimitExceeded(iPtr->limit)) {
 	if (!(flags & TCL_EVAL_INVOKE) &&
 		(iPtr->ensembleRewrite.sourceObjs != NULL)) {
 	    iPtr->ensembleRewrite.sourceObjs = NULL;
@@ -3619,7 +3623,7 @@ TclEvalObjvInternal(
     if (Tcl_AsyncReady()) {
 	code = Tcl_AsyncInvoke(interp, code);
     }
-    if (code == TCL_OK && Tcl_LimitReady(interp)) {
+    if (code == TCL_OK && TclLimitReady(iPtr->limit)) {
 	code = Tcl_LimitCheck(interp);
     }
 
@@ -3627,33 +3631,164 @@ TclEvalObjvInternal(
      * Call 'leave' command traces
      */
 
-    if (!(cmdPtr->flags & CMD_IS_DELETED)) {
-	if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && (traceCode == TCL_OK)) {
-	    traceCode = TclCheckExecutionTraces(interp, command, length,
-		    cmdPtr, code, TCL_TRACE_LEAVE_EXEC, objc, objv);
+    if (haveTraces) {
+	if (!(cmdPtr->flags & CMD_IS_DELETED)) {
+	    if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && (traceCode == TCL_OK)) {
+		traceCode = TclCheckExecutionTraces(interp, command, length,
+			cmdPtr, code, TCL_TRACE_LEAVE_EXEC, objc, objv);
+	    }
+	    if (iPtr->tracePtr != NULL && traceCode == TCL_OK) {
+		traceCode = TclCheckInterpTraces(interp, command, length,
+			cmdPtr, code, TCL_TRACE_LEAVE_EXEC, objc, objv);
+	    }
 	}
-	if (iPtr->tracePtr != NULL && traceCode == TCL_OK) {
-	    traceCode = TclCheckInterpTraces(interp, command, length,
-		    cmdPtr, code, TCL_TRACE_LEAVE_EXEC, objc, objv);
+
+	/*
+	 * If one of the trace invocation resulted in error, then change the 
+	 * result code accordingly. Note, that the interp->result should
+	 * already be set correctly by the call to TraceExecutionProc.
+	 */
+	
+	if (traceCode != TCL_OK) {
+	    code = traceCode;
 	}
-    }
 
+    }
+    
     /*
      * Decrement the reference count of cmdPtr and deallocate it if it has
      * dropped to zero.
      */
 
-    TclCleanupCommand(cmdPtr);
+    TclCleanupCommandMacro(cmdPtr);
 
     /*
-     * If one of the trace invocation resulted in error, then change the
-     * result code accordingly. Note, that the interp->result should already
-     * be set correctly by the call to TraceExecutionProc.
+     * If the interpreter has a non-empty string result, the result object is
+     * either empty or stale because some function set interp->result
+     * directly. If so, move the string result to the result object, then
+     * reset the string result.
      */
 
-    if (traceCode != TCL_OK) {
-	code = traceCode;
+    if (*(iPtr->result) != 0) {
+	(void) Tcl_GetObjResult(interp);
+    }
+
+  done:
+    if (savedVarFramePtr) {
+	iPtr->varFramePtr = savedVarFramePtr;
     }
+    return code;
+}
+
+int
+TclEvalObjvInternal(
+    Tcl_Interp *interp,		/* Interpreter in which to evaluate the
+				 * command. Also used for error reporting. */
+    int objc,			/* Number of words in command. */
+    Tcl_Obj *const objv[],	/* An array of pointers to objects that are
+				 * the words that make up the command. */
+    const char *command,	/* Points to the beginning of the string
+				 * 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).*/
+    int length,			/* Number of bytes in command; if -1, all
+				 * characters up to the first null byte are
+				 * used. */
+    int flags)			/* Collection of OR-ed bits that control the
+				 * evaluation of the script. Only
+				 * TCL_EVAL_GLOBAL and TCL_EVAL_INVOKE are
+				 * currently supported. */
+{
+    Command *cmdPtr;
+    Interp *iPtr = (Interp *) interp;
+    CallFrame *savedVarFramePtr = NULL;
+    CallFrame *varFramePtr = iPtr->varFramePtr;
+    int code = TCL_OK;
+    Namespace *savedNsPtr = NULL;
+    Namespace *lookupNsPtr = iPtr->lookupNsPtr;
+
+    if (TclInterpReady(interp) == TCL_ERROR) {
+	return TCL_ERROR;
+    }
+
+    if (objc == 0) {
+	return TCL_OK;
+    }
+
+    /*
+     * Configure evaluation context to match the requested flags.
+     */
+
+    if (flags) {
+	if (flags & TCL_EVAL_INVOKE) {
+	    savedNsPtr = varFramePtr->nsPtr;
+	    if (lookupNsPtr) {
+		varFramePtr->nsPtr = lookupNsPtr;
+		iPtr->lookupNsPtr = NULL;
+	    } else {
+		varFramePtr->nsPtr = iPtr->globalNsPtr;
+	    }
+	} else if ((flags & TCL_EVAL_GLOBAL) && (varFramePtr != iPtr->rootFramePtr)
+		&& !savedVarFramePtr) {
+	    varFramePtr = iPtr->rootFramePtr;
+	    savedVarFramePtr = iPtr->varFramePtr;
+	    iPtr->varFramePtr = varFramePtr;
+	}
+    }
+
+    /*
+     * Find the function to execute this command. If there isn't one, or if
+     * there are traces, delegate to the full version.
+     */
+
+    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]);
+    if (savedNsPtr) {
+	varFramePtr->nsPtr = savedNsPtr;
+    }
+    
+    if ((cmdPtr == NULL) || (iPtr->tracePtr != NULL) ||
+	        (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {
+	/*
+	 * Need the full version: command is either unknown or traced
+	 */
+	
+	if (savedVarFramePtr) {
+	    iPtr->varFramePtr = savedVarFramePtr;
+	}
+	if (lookupNsPtr) {
+	    iPtr->lookupNsPtr = lookupNsPtr;
+	}
+	return FullEvalObjvInternal(interp, objc, objv, command, length, flags);
+    }
+	    
+    /*
+     * Finally, invoke the command's Tcl_ObjCmdProc.
+     */
+
+    cmdPtr->refCount++;
+    iPtr->cmdCount++;
+
+    if (!TclLimitExceeded(iPtr->limit)) {
+	if (!(flags & TCL_EVAL_INVOKE) &&
+		(iPtr->ensembleRewrite.sourceObjs != NULL)) {
+	    iPtr->ensembleRewrite.sourceObjs = NULL;
+	}
+	code = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
+    }
+    if (Tcl_AsyncReady()) {
+	code = Tcl_AsyncInvoke(interp, code);
+    }
+    if (code == TCL_OK && TclLimitReady(iPtr->limit)) {
+	code = Tcl_LimitCheck(interp);
+    }
+
+    /*
+     * Decrement the reference count of cmdPtr and deallocate it if it has
+     * dropped to zero.
+     */
+
+    TclCleanupCommandMacro(cmdPtr);
 
     /*
      * If the interpreter has a non-empty string result, the result object is
@@ -3666,7 +3801,6 @@ TclEvalObjvInternal(
 	(void) Tcl_GetObjResult(interp);
     }
 
-  done:
     if (savedVarFramePtr) {
 	iPtr->varFramePtr = savedVarFramePtr;
     }
@@ -3676,77 +3810,44 @@ TclEvalObjvInternal(
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_EvalObjv --
+ * ProcessEvalObjvReturn --
  *
- *	This function evaluates a Tcl command that has already been parsed
- *	into words, with one Tcl_Obj holding each word.
+ *	This function does special handling for non TCL_OK returns from
+ *	Tcl_EvalObjv. 
  *
  * Results:
  *	The return value is a standard Tcl completion code such as TCL_OK or
  *	TCL_ERROR. A result or error message is left in interp's result.
  *
  * Side effects:
- *	Depends on the command.
+ *	May alter the return code and/or generate an error log.
  *
  *----------------------------------------------------------------------
  */
 
-int
-Tcl_EvalObjv(
+static int
+ProcessEvalObjvReturn(
     Tcl_Interp *interp,		/* Interpreter in which to evaluate the
 				 * command. Also used for error reporting. */
     int objc,			/* Number of words in command. */
     Tcl_Obj *const objv[],	/* An array of pointers to objects that are
 				 * the words that make up the command. */
-    int flags)			/* Collection of OR-ed bits that control the
-				 * evaluation of the script. Only
-				 * TCL_EVAL_GLOBAL and TCL_EVAL_INVOKE are
-				 * currently supported. */
+    int flags,
+    int code)                   /* The return code to be processed */
 {
     Interp *iPtr = (Interp *) interp;
-    Trace *tracePtr;
-    Tcl_DString cmdBuf;
-    const char *cmdString = "";	/* A command string is only necessary for
-				 * command traces or error logs; it will be
-				 * generated to replace this default value if
-				 * necessary. */
-    int cmdLen = 0;		/* A non-zero value indicates that a command
-				 * string was generated. */
-    int code = TCL_OK;
-    int i;
     int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
-
-    for (tracePtr = iPtr->tracePtr; tracePtr; tracePtr = tracePtr->nextPtr) {
-	if ((tracePtr->level == 0) || (iPtr->numLevels <= tracePtr->level)) {
-	    /*
-	     * The command may be needed for an execution trace. Generate a
-	     * command string.
-	     */
-
-	    Tcl_DStringInit(&cmdBuf);
-	    for (i = 0; i < objc; i++) {
-		Tcl_DStringAppendElement(&cmdBuf, Tcl_GetString(objv[i]));
-	    }
-	    cmdString = Tcl_DStringValue(&cmdBuf);
-	    cmdLen = Tcl_DStringLength(&cmdBuf);
-	    break;
-	}
-    }
-
-    iPtr->numLevels++;
-    code = TclEvalObjvInternal(interp, objc, objv, cmdString, cmdLen, flags);
-    iPtr->numLevels--;
-
+    
     /*
      * If we are again at the top level, process any unusual return code
      * returned by the evaluated code.
      */
-
+    
     if (iPtr->numLevels == 0) {
 	if (code == TCL_RETURN) {
 	    code = TclUpdateReturnInfo(iPtr);
 	}
-	if ((code != TCL_OK) && (code != TCL_ERROR) && !allowExceptions) {
+	if ((code != TCL_ERROR) && !allowExceptions) {
 	    ProcessUnexpectedResult(interp, code);
 	    code = TCL_ERROR;
 	}
@@ -3755,29 +3856,70 @@ Tcl_EvalObjv(
     if ((code == TCL_ERROR) && !(flags & TCL_EVAL_INVOKE)) {
 	/*
 	 * If there was an error, a command string will be needed for the
-	 * error log: generate it now if it was not done previously.
+	 * error log: generate it now. Do not worry too much about doing
+	 * it expensively.
 	 */
-
-	if (cmdLen == 0) {
-	    Tcl_DStringInit(&cmdBuf);
-	    for (i = 0; i < objc; i++) {
-		Tcl_DStringAppendElement(&cmdBuf, Tcl_GetString(objv[i]));
-	    }
-	    cmdString = Tcl_DStringValue(&cmdBuf);
-	    cmdLen = Tcl_DStringLength(&cmdBuf);
-	}
+	
+	Tcl_Obj *listPtr;
+	char *cmdString;
+	int cmdLen;
+	
+	listPtr = Tcl_NewListObj(objc, objv);
+	cmdString = Tcl_GetStringFromObj(listPtr, &cmdLen);
 	Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen);
+	Tcl_DecrRefCount(listPtr);
     }
 
-    if (cmdLen != 0) {
-	Tcl_DStringFree(&cmdBuf);
-    }
     return code;
 }
 
 /*
  *----------------------------------------------------------------------
  *
+ * Tcl_EvalObjv --
+ *
+ *	This function evaluates a Tcl command that has already been parsed
+ *	into words, with one Tcl_Obj holding each word.
+ *
+ * Results:
+ *	The return value is a standard Tcl completion code such as TCL_OK or
+ *	TCL_ERROR. A result or error message is left in interp's result.
+ *
+ * Side effects:
+ *	Depends on the command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_EvalObjv(
+    Tcl_Interp *interp,		/* Interpreter in which to evaluate the
+				 * command. Also used for error reporting. */
+    int objc,			/* Number of words in command. */
+    Tcl_Obj *const objv[],	/* An array of pointers to objects that are
+				 * the words that make up the command. */
+    int flags)			/* Collection of OR-ed bits that control the
+				 * evaluation of the script. Only
+				 * TCL_EVAL_GLOBAL and TCL_EVAL_INVOKE are
+				 * currently supported. */
+{
+    Interp *iPtr = (Interp *) interp;
+    int code = TCL_OK;
+
+    iPtr->numLevels++;
+    code = TclEvalObjvInternal(interp, objc, objv, NULL, 0, flags);
+    iPtr->numLevels--;
+
+    if (code == TCL_OK) {
+	return code;
+    } else {
+	return ProcessEvalObjvReturn(interp, objc, objv, flags, code);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_EvalTokensStandard --
  *
  *	Given an array of tokens parsed from a Tcl command (e.g., the tokens