[Bug 2971921]: Corrected jump so that it doesn't skip into the middle

	of an instruction! Tightened the instruction issuing. Moved endCatch
	calls closer to their point that they guard.

3 files changed, 105 insertions, 67 deletions

diff --git a/ChangeLog b/ChangeLog
index b260099..fc4cc6f 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,43 +1,50 @@
+2010-03-18  Donal K. Fellows  <dkf@users.sf.net>
+
+	* generic/tclCompCmdsSZ.c (IssueTryFinallyInstructions):
+	[Bug 2971921]: Corrected jump so that it doesn't skip into the middle
+	of an instruction! Tightened the instruction issuing. Moved endCatch
+	calls closer to their point that they guard.
+
 2010-03-17  Andreas Kupries  <andreask@activestate.com>
 
-	* generic/tclIORTrans.c (ReflectInput, ReflectOutput,
-	ReflectSeekWide): [Bug 2921116]: Added missing TclEventuallyFree
+	* generic/tclIORTrans.c (ReflectInput, ReflectOutput)
+	(ReflectSeekWide): [Bug 2921116]: Added missing TclEventuallyFree
 	calls for preserved ReflectedTransform* structures. Reworked
-	ReflectInput to preserve the structure for its whole life, not
-	only in InvokeTclMethod.
+	ReflectInput to preserve the structure for its whole life, not only in
+	InvokeTclMethod.
 
-	* generic/tclIO.c (Tcl_GetsObj): [Bug 2921116]: Regenerate
-	topChan, may have been changed by a self-modifying transformation.
+	* generic/tclIO.c (Tcl_GetsObj): [Bug 2921116]: Regenerate topChan,
+	may have been changed by a self-modifying transformation.
 
-	* tests/ioTrans/test (iortrans-4.8, iortrans-4.9, iortrans-5.11,
-	iortrans-7.4, iortrans-8.3): New test cases.
+	* tests/ioTrans/test (iortrans-4.8, iortrans-4.9, iortrans-5.11)
+	(iortrans-7.4, iortrans-8.3): New test cases.
 
 2010-03-16  Jan Nijtmans  <nijtmans@users.sf.net>
 
-	* compat/zlib/*           Upgrade zlib to version 1.2.4
-	* win/makefile.vc
-	* unix/Makefile.in
-	* win/tclWinChan.c        don't cast away "const" without reason.
+	* compat/zlib/*:	Upgrade zlib to version 1.2.4.
+	* win/makefile.vc:
+	* unix/Makefile.in:
+	* win/tclWinChan.c:	Don't cast away "const" without reason.
 
 2010-03-12  Jan Nijtmans  <nijtmans@users.sf.net>
 
-	* win/makefile.vc         Fix [Bug 2967340]: Static build failure
-	* win/.cvsignore
+	* win/makefile.vc: [Bug 2967340]: Static build was failing.
+	* win/.cvsignore:
 
 2010-03-10  Jan Nijtmans  <nijtmans@users.sf.net>
 
-	* generic/tclTest.c       Remove unnecessary '&' decoration for function
-	* generic/tclIOUtil.c     pointers
-	* win/tclWin32Dll.c       Double declaration of TclNativeDupInternalRep
-	* unix/tclIOUtil.c
-	* unix/dltest/.cvsignore Ignore *.so here
+	* generic/tclTest.c:	Remove unnecessary '&' decoration for
+	* generic/tclIOUtil.c:	function pointers
+	* win/tclWin32Dll.c:	Double declaration of TclNativeDupInternalRep
+	* unix/tclIOUtil.c:
+	* unix/dltest/.cvsignore: Ignore *.so here
 
 2010-03-09  Andreas Kupries  <andreask@activestate.com>
 
 	* generic/tclIORChan.c: [Bug 2936225]: Thanks to Alexandre Ferrieux
-	* doc/refchan.n: <ferrieux@users.sourceforge.net> for debugging and fixing
-	* tests/ioCmd.test: the problem. It is the write-side equivalent
-	to the bug fixed 2009-08-06.
+	* doc/refchan.n:    <ferrieux@users.sourceforge.net> for debugging and
+	* tests/ioCmd.test: fixing the problem. It is the write-side
+	equivalent to the bug fixed 2009-08-06.
 
 2010-03-09  Don Porter  <dgp@users.sourceforge.net>
 
@@ -55,20 +62,22 @@
 
 2010-03-07  Jan Nijtmans  <nijtmans@users.sf.net>
 
-	* generic/tclTest.c       test that tclOO stubs are present in stub library
-	* generic/tclOOMethod.c   Applied missing part of [Patch 2961556]
-	* win/tclWinInt.h         Change all tclWinProcs signatures to use
-	* win/tclWin32Dll.c       TCHAR* in stead of WCHAR*. This is meant
-	* win/tclWinDde.c         as preparation to make [Enh 2965056]
-	* win/tclWinFCmd.c        possible at all.
-	* win/tclWinFile.c
-	* win/tclWinPipe.c
-	* win/tclWinSock.c
+	* generic/tclTest.c:	  Test that tclOO stubs are present in stub
+				  library
+	* generic/tclOOMethod.c:  Applied missing part of [Patch 2961556]
+	* win/tclWinInt.h:	  Change all tclWinProcs signatures to use
+	* win/tclWin32Dll.c:	  TCHAR* in stead of WCHAR*. This is meant
+	* win/tclWinDde.c:	  as preparation to make [Enh 2965056]
+	* win/tclWinFCmd.c:	  possible at all.
+	* win/tclWinFile.c:
+	* win/tclWinPipe.c:
+	* win/tclWinSock.c:
 
 2010-03-06  Jan Nijtmans  <nijtmans@users.sf.net>
 
-	* generic/tclStubLib.c  remove presence of tclTomMathStubsPtr here
-	* generic/tclTest.c     test that tommath stubs are present in stub library
+	* generic/tclStubLib.c:	Remove presence of tclTomMathStubsPtr here.
+	* generic/tclTest.c:	Test that tommath stubs are present in stub
+				library.
 
 2010-03-05  Donal K. Fellows  <dkf@users.sf.net>
 
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index fb34f66..b55367c 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -14,7 +14,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCompCmdsSZ.c,v 1.2 2010/03/05 14:34:03 dkf Exp $
+ * RCS: @(#) $Id: tclCompCmdsSZ.c,v 1.3 2010/03/18 10:59:48 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -145,6 +145,10 @@ const AuxDataType tclJumptableInfoType = {
     (var) = CurrentOffset(envPtr);TclEmitInstInt4(INST_##name,0,envPtr)
 #define FIXJUMP(var) \
     TclStoreInt4AtPtr(CurrentOffset(envPtr)-(var),envPtr->codeStart+(var)+1)
+#define LOAD(idx) \
+    if ((idx)<256) {OP1(LOAD_SCALAR1,(idx));} else {OP4(LOAD_SCALAR4,(idx));}
+#define STORE(idx) \
+    if ((idx)<256) {OP1(STORE_SCALAR1,(idx));} else {OP4(STORE_SCALAR4,(idx));}
 
 /*
  *----------------------------------------------------------------------
@@ -2072,16 +2076,17 @@ IssueTryInstructions(
     ExceptionRangeStarts(envPtr, range);
     BODY(				bodyToken, 1);
     ExceptionRangeEnds(envPtr, range);
-    OP1(				JUMP1, 3);
+    PUSH(				"0");
+    OP1(				JUMP1, 4);
     ExceptionRangeTarget(envPtr, range, catchOffset);
+    OP(					PUSH_RETURN_CODE);
     OP(					PUSH_RESULT);
-    OP4(				STORE_SCALAR4, resultVar);
-    OP(					POP);
     OP(					PUSH_RETURN_OPTIONS);
-    OP4(				STORE_SCALAR4, optionsVar);
-    OP(					POP);
-    OP(					PUSH_RETURN_CODE);
     OP(					END_CATCH);
+    STORE(				optionsVar);
+    OP(					POP);
+    STORE(				resultVar);
+    OP(					POP);
 
     /*
      * Now we handle all the registered 'on' and 'trap' handlers in order.
@@ -2106,7 +2111,7 @@ IssueTryInstructions(
 	     * Match the errorcode according to try/trap rules.
 	     */
 
-	    OP4(			LOAD_SCALAR4, optionsVar);
+	    LOAD(			optionsVar);
 	    PUSH(			"-errorcode");
 	    OP4(			DICT_GET, 1);
 	    OP44(			LIST_RANGE_IMM, 0, len-1);
@@ -2125,12 +2130,12 @@ IssueTryInstructions(
 	 */
 
 	if (resultVars[i] >= 0) {
-	    OP4(			LOAD_SCALAR4, resultVar);
-	    OP4(			STORE_SCALAR4, resultVars[i]);
+	    LOAD(			resultVar);
+	    STORE(			resultVars[i]);
 	    OP(				POP);
 	    if (optionVars[i] >= 0) {
-		OP4(			LOAD_SCALAR4, optionsVar);
-		OP4(			STORE_SCALAR4, optionVars[i]);
+		LOAD(			optionsVar);
+		STORE(			optionVars[i]);
 		OP(			POP);
 	    }
 	}
@@ -2166,8 +2171,8 @@ IssueTryInstructions(
      */
 
     OP(					POP);
-    OP4(				LOAD_SCALAR4, optionsVar);
-    OP4(				LOAD_SCALAR4, resultVar);
+    LOAD(				optionsVar);
+    LOAD(				resultVar);
     OP(					RETURN_STK);
 
     /*
@@ -2218,16 +2223,17 @@ IssueTryFinallyInstructions(
     ExceptionRangeStarts(envPtr, range);
     BODY(				bodyToken, 1);
     ExceptionRangeEnds(envPtr, range);
-    OP1(				JUMP1, 3);
+    PUSH(				"0");
+    OP1(				JUMP1, 4);
     ExceptionRangeTarget(envPtr, range, catchOffset);
+    OP(					PUSH_RETURN_CODE);
     OP(					PUSH_RESULT);
-    OP4(				STORE_SCALAR4, resultVar);
-    OP(					POP);
     OP(					PUSH_RETURN_OPTIONS);
-    OP4(				STORE_SCALAR4, optionsVar);
-    OP(					POP);
-    OP(					PUSH_RETURN_CODE);
     OP(					END_CATCH);
+    STORE(				optionsVar);
+    OP(					POP);
+    STORE(				resultVar);
+    OP(					POP);
     envPtr->currStackDepth = savedStackDepth + 1;
 
     /*
@@ -2255,7 +2261,7 @@ IssueTryFinallyInstructions(
 		 * Match the errorcode according to try/trap rules.
 		 */
 
-		OP4(			LOAD_SCALAR4, optionsVar);
+		LOAD(			optionsVar);
 		PUSH(			"-errorcode");
 		OP4(			DICT_GET, 1);
 		OP44(			LIST_RANGE_IMM, 0, len-1);
@@ -2279,12 +2285,12 @@ IssueTryFinallyInstructions(
 		ExceptionRangeStarts(envPtr, range);
 	    }
 	    if (resultVars[i] >= 0) {
-		OP4(			LOAD_SCALAR4, resultVar);
-		OP4(			STORE_SCALAR4, resultVars[i]);
+		LOAD(			resultVar);
+		STORE(			resultVars[i]);
 		OP(			POP);
 		if (optionVars[i] >= 0) {
-		    OP4(		LOAD_SCALAR4, optionsVar);
-		    OP4(		STORE_SCALAR4, optionVars[i]);
+		    LOAD(		optionsVar);
+		    STORE(		optionVars[i]);
 		    OP(			POP);
 		}
 	    }
@@ -2321,8 +2327,9 @@ IssueTryFinallyInstructions(
 		}
 		BODY(			handlerTokens[i], 5+i*4);
 		ExceptionRangeEnds(envPtr, range);
-		OP(			POP);
-		OP1(			JUMP1, 6);
+		OP(			PUSH_RETURN_OPTIONS);
+		OP4(			REVERSE, 2);
+		OP1(			JUMP1, 4);
 		forwardsToFix[i] = -1;
 
 		/*
@@ -2334,13 +2341,13 @@ IssueTryFinallyInstructions(
 
 	    finishTrapCatchHandling:
 		ExceptionRangeTarget(envPtr, range, catchOffset);
+		OP(			PUSH_RETURN_OPTIONS);
 		OP(			PUSH_RESULT);
-		OP4(			STORE_SCALAR4, resultVar);
+		OP(			END_CATCH);
+		STORE(			resultVar);
 		OP(			POP);
-		OP(			PUSH_RETURN_OPTIONS);
-		OP4(			STORE_SCALAR4, optionsVar);
+		STORE(			optionsVar);
 		OP(			POP);
-		OP(			END_CATCH);
 	    }
 	    if (i+1 < numHandlers) {
 		JUMP(addrsToFix[i],	JUMP4);
@@ -2380,8 +2387,8 @@ IssueTryFinallyInstructions(
 
     BODY(				finallyToken, 3 + 4*numHandlers);
     OP(					POP);
-    OP4(				LOAD_SCALAR4, optionsVar);
-    OP4(				LOAD_SCALAR4, resultVar);
+    LOAD(				optionsVar);
+    LOAD(				resultVar);
     OP(					RETURN_STK);
 
     return TCL_OK;
diff --git a/tests/error.test b/tests/error.test
index 8f0c0f0..86e52c2 100644
--- a/tests/error.test
+++ b/tests/error.test
@@ -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: error.test,v 1.25 2009/12/07 15:08:47 dkf Exp $
+# RCS: @(#) $Id: error.test,v 1.26 2010/03/18 10:59:48 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -803,6 +803,28 @@ test error-19.5 {multiple unrelated fallthroughs #2} {
     } 
     set RES
 } {err}
+test error-19.6 {compiled try executes all clauses} -setup {
+    proc addmsg msg {
+	variable RES
+	lappend RES $msg
+    }
+    set RES {}
+} -body {
+    apply {{} {
+	try {
+	    addmsg a
+	    throw bar hello
+	} trap bar {res opt} {
+	    addmsg b
+	} finally {
+	    addmsg c
+	}
+	addmsg d
+    } ::tcl::test::error}
+} -cleanup {
+    rename addmsg {}
+    unset RES
+} -result {a b c d}
 
 # FIXME test what vars get set on fallthough ... what is the correct behavior?
 # It would seem appropriate to set at least those for the matching handler and