2007-07-11 Miguel Sofer <msofer@users.sf.net>

	* generic/tclCompCmds.c (TclCompileWhileCmd):
	* generic/tclCompile.c (TclCompileScript):
	Corrected faulty avoidance of INST_START_CMD when the first opcode
	in a script is within a loop (as produced by 'while 1'), so that
	the corresponding command is properly counted [Bug 1752146].

3 files changed, 36 insertions, 15 deletions

diff --git a/ChangeLog b/ChangeLog
index 4dc8280..0e39af7 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2007-07-11  Miguel Sofer  <msofer@users.sf.net>
+
+	* generic/tclCompCmds.c (TclCompileWhileCmd):
+	* generic/tclCompile.c (TclCompileScript):
+	Corrected faulty avoidance of INST_START_CMD when the first opcode
+	in a script is within a loop (as produced by 'while 1'), so that
+	the corresponding command is properly counted [Bug 1752146].
+
 2007-07-11  Don Porter  <dgp@users.sourceforge.net>
 
 	* generic/tclCompExpr.c:	Added a "parseOnly" flag argument to
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index c50849b..8176295 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.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: tclCompCmds.c,v 1.112 2007/06/28 21:10:38 patthoyts Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.113 2007/07/11 21:27:28 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -4400,6 +4400,12 @@ TclCompileWhileCmd(
 	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpEvalCondFixup);
 	testCodeOffset = 0;	/* Avoid compiler warning. */
     } else {
+	/*
+	 * Make sure that the first command in the body is preceded by an
+	 * INST_START_CMD, and hence counted properly. [Bug 1752146]
+	 */
+
+	envPtr->atCmdStart = 0;
 	testCodeOffset = CurrentOffset(envPtr);
     }
 
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 79d0c5b..d55df75 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.123 2007/06/21 18:41:16 dgp Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.124 2007/07/11 21:27:28 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -870,7 +870,7 @@ TclInitCompileEnv(
     envPtr->cmdMapPtr = envPtr->staticCmdMapSpace;
     envPtr->cmdMapEnd = COMPILEENV_INIT_CMD_MAP_SIZE;
     envPtr->mallocedCmdMap = 0;
-    envPtr->atCmdStart = 0;
+    envPtr->atCmdStart = 1;
 
     /*
      * TIP #280: Set up the extended command location information, based on
@@ -1354,31 +1354,38 @@ TclCompileScript(
 			/*
 			 * Mark the start of the command; the proper bytecode
 			 * length will be updated later. There is no need to
-			 * do this for the first command in the compile env,
+			 * do this for the first bytecode 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)
+			 * TclExecuteByteCode(). Do emit an INST_START_CMD in
+			 * special cases where the first bytecode is in a
+			 * loop, to insure that the corresponding command is
+			 * counted properly. Compilers for commands able to
+			 * produce such a beast (currently 'while 1' only) set
+			 * envPtr->atCmdStart to 0 in order to signal this
+			 * case. [Bug 1752146]
+			 * Note that the environment is initialised with
+			 * atCmdStart=1 to avoid emitting ISC for the first
+			 * command. 
 			 */
 
-			if (savedCodeNext != 0) {
-			    if (envPtr->atCmdStart) {
+			if (envPtr->atCmdStart) {
+			    if (savedCodeNext != 0) {
 				/*
 				 * Increase the number of commands being
 				 * started at the current point. Note that
 				 * this depends on the exact layout of the
 				 * INST_START_CMD's operands, so be careful!
 				 */
-
+				
 				unsigned char *fixPtr = envPtr->codeNext - 4;
-
+				
 				TclStoreInt4AtPtr(TclGetUInt4AtPtr(fixPtr)+1,
 					fixPtr);
-			    } else {
-				TclEmitInstInt4(INST_START_CMD, 0, envPtr);
-				TclEmitInt4(1, envPtr);
-				update = 1;
 			    }
+			} else {
+			    TclEmitInstInt4(INST_START_CMD, 0, envPtr);
+			    TclEmitInt4(1, envPtr);
+			    update = 1;
 			}
 
 			code = (cmdPtr->compileProc)(interp, parsePtr, envPtr);