Optimisations for INST_START_CMD [Bug 926164].

	* generic/tclCompile.c (TclCompileScript): avoid emitting
	INST_START_CMD as the first instruction in a bytecoded Tcl_Obj. It
	is not needed, as the checks are done before calling TEBC.
	* generic/tclExecute.c (TclExecuteByteCode): runtime peephole
	optimisation: check at INST_POP if the next instruction is
	INST_START_CMD, in which case we fall through.

3 files changed, 65 insertions, 38 deletions

diff --git a/ChangeLog b/ChangeLog
index ff9b232..ac64483 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2004-05-12  Miguel Sofer <msofer@users.sf.net>
+
+	Optimisations for INST_START_CMD [Bug 926164].
+	* generic/tclCompile.c (TclCompileScript): avoid emitting
+	INST_START_CMD as the first instruction in a bytecoded Tcl_Obj. It
+	is not needed, as the checks are done before calling TEBC.
+	* generic/tclExecute.c (TclExecuteByteCode): runtime peephole
+	optimisation: check at INST_POP if the next instruction is
+	INST_START_CMD, in which case we fall through.
+	
 2004-05-11  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
 
 	* doc/split.n, doc/join.n: Updated examples and added more.
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index e75a5a4..c918c5d 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.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: tclCompile.c,v 1.64 2004/05/04 02:44:23 msofer Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.65 2004/05/12 17:43:54 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -1057,28 +1057,36 @@ TclCompileScript(interp, script, numBytes, envPtr)
 			        && !(iPtr->flags & DONT_COMPILE_CMDS_INLINE)) {
 			    int savedNumCmds = envPtr->numCommands;
 			    unsigned int savedCodeNext =
-				    envPtr->codeNext - envPtr->codeStart;
+				    envPtr->codeNext - envPtr->codeStart;			    
 
 			    /*
 			     * Mark the start of the command; the proper
-			     * bytecode length will be updated later.
+			     * bytecode length will be updated later. There
+			     * is no need to do this for the first command
+			     * in the compile env, as the check is done before
+			     * calling TclExecuteByteCode(). Remark that we
+			     * are compiling the first cmd in the environment
+			     * exactly when (savedCodeNext == 0)
 			     */
-			    
-			    TclEmitInstInt4(INST_START_CMD, 0, envPtr);
+
+			    if (savedCodeNext != 0) {
+				TclEmitInstInt4(INST_START_CMD, 0, envPtr);				
+			    }
 			    
 			    code = (*(cmdPtr->compileProc))(interp, &parse,
 			            envPtr);
 			    
 			    if (code == TCL_OK) {
-				/*
-				 * Fix the bytecode length.
-				 */
-				unsigned char *fixPtr = envPtr->codeStart + savedCodeNext + 1;
-				unsigned int fixLen = envPtr->codeNext - envPtr->codeStart
-				        - savedCodeNext;
-				
-				TclStoreInt4AtPtr(fixLen, fixPtr);
+				if (savedCodeNext != 0) {
+				    /*
+				     * Fix the bytecode length.
+				     */
+				    unsigned char *fixPtr = envPtr->codeStart + savedCodeNext + 1;
+				    unsigned int fixLen = envPtr->codeNext - envPtr->codeStart
+				            - savedCodeNext;
 				
+				    TclStoreInt4AtPtr(fixLen, fixPtr);
+				}				
 				goto finishCommand;
 			    } else if (code == TCL_OUT_LINE_COMPILE) {
 				/*
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index daa560c..6182a51 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.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: tclExecute.c,v 1.124 2004/04/06 22:25:50 dgp Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.125 2004/05/12 17:43:55 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -1239,29 +1239,6 @@ TclExecuteByteCode(interp, codePtr)
     }
 
     switch (*pc) {
-    case INST_START_CMD:
-	if ((!(iPtr->flags & DELETED)
-		    && (codeCompileEpoch == iPtr->compileEpoch)
-		    && (codeNsEpoch == namespacePtr->resolverEpoch))
-		|| codePrecompiled) {
-	    NEXT_INST_F(5, 0, 0);
-	} else {
-	    bytes = GetSrcInfoForPc(pc, codePtr, &length);
-	    result = Tcl_EvalEx(interp, bytes, length, 0);
-	    if (result != TCL_OK) {
-		goto checkForCatch;
-	    }
-	    opnd = TclGetUInt4AtPtr(pc+1);
-	    objResultPtr = Tcl_GetObjResult(interp);
-	    {
-		Tcl_Obj *newObjResultPtr;
-		TclNewObj(newObjResultPtr);
-		Tcl_IncrRefCount(newObjResultPtr);
-		iPtr->objResultPtr = newObjResultPtr;
-	    }
-	    NEXT_INST_V(opnd, 0, -1);
-	}
-	
     case INST_RETURN:
 	{
 	    int code = TclGetInt4AtPtr(pc+1);
@@ -1319,7 +1296,39 @@ TclExecuteByteCode(interp, codePtr)
 	TRACE_WITH_OBJ(("=> discarding "), *tosPtr);
 	valuePtr = POP_OBJECT();
 	TclDecrRefCount(valuePtr);
-	NEXT_INST_F(1, 0, 0);
+
+	/*
+	 * Runtime peephole optimisation: an INST_POP is scheduled
+	 * at the end of most commands. If the next instruction is an
+	 * INST_START_CMD, fall through to it.
+	 */
+	pc++;
+	if (*pc != INST_START_CMD) {	
+	    NEXT_INST_F(0, 0, 0);
+	}
+	
+    case INST_START_CMD:
+	if ((!(iPtr->flags & DELETED)
+		    && (codeCompileEpoch == iPtr->compileEpoch)
+		    && (codeNsEpoch == namespacePtr->resolverEpoch))
+		|| codePrecompiled) {
+	    NEXT_INST_F(5, 0, 0);
+	} else {
+	    bytes = GetSrcInfoForPc(pc, codePtr, &length);
+	    result = Tcl_EvalEx(interp, bytes, length, 0);
+	    if (result != TCL_OK) {
+		goto checkForCatch;
+	    }
+	    opnd = TclGetUInt4AtPtr(pc+1);
+	    objResultPtr = Tcl_GetObjResult(interp);
+	    {
+		Tcl_Obj *newObjResultPtr;
+		TclNewObj(newObjResultPtr);
+		Tcl_IncrRefCount(newObjResultPtr);
+		iPtr->objResultPtr = newObjResultPtr;
+	    }
+	    NEXT_INST_V(opnd, 0, -1);
+	}
 	
     case INST_DUP:
 	objResultPtr = *tosPtr;