* generic/tclCompCmds.c (TclCompileReturnCmd): Alternative fix for

        * generic/tclCompile.c (INST_RETURN):   [Bug 633204] that uses a new
        * generic/tclCompile.h (INST_RETURN):   bytecode INST_RETURN to
        * generic/tclExecute.c (INST_RETURN):   properly bytecode the
        [return] command to something that returns TCL_RETURN.

6 files changed, 24 insertions, 27 deletions

diff --git a/ChangeLog b/ChangeLog
index a245767..3b1a388 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2003-03-19  Don Porter  <dgp@users.sourceforge.net>
+
+	* generic/tclCompCmds.c (TclCompileReturnCmd):  Alternative fix for
+	* generic/tclCompile.c (INST_RETURN):	[Bug 633204] that uses a new
+	* generic/tclCompile.h (INST_RETURN):	bytecode INST_RETURN to
+	* generic/tclExecute.c (INST_RETURN):	properly bytecode the
+	[return] command to something that returns TCL_RETURN.
+
 2003-03-18  Mo DeJong  <mdejong@users.sourceforge.net>
 
 	* win/configure: Regen.
@@ -1120,7 +1128,7 @@
 	
 2003-01-09  Don Porter  <dgp@users.sourceforge.net>
 
-	* generic/tclCompCmds.c (TclCompilerReturnCmd):  Corrected off-by-one
+	* generic/tclCompCmds.c (TclCompileReturnCmd):  Corrected off-by-one
 	problem with recent commit.  [Bug 633204]
 
 2003-01-09  Vince Darley  <vincentdarley@users.sourceforge.net>
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 44f6109..fdd339b 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.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: tclCompCmds.c,v 1.42 2003/03/13 02:48:52 dgp Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.43 2003/03/19 16:51:42 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -2371,7 +2371,6 @@ TclCompileReturnCmd(interp, parsePtr, envPtr)
 {
     Tcl_Token *varTokenPtr;
     int code;
-    int index = envPtr->exceptArrayNext - 1;
 
     /*
      * If we're not in a procedure, don't compile.
@@ -2381,22 +2380,6 @@ TclCompileReturnCmd(interp, parsePtr, envPtr)
 	return TCL_OUT_LINE_COMPILE;
     }
 
-    /*
-     * Look back through the ExceptionRanges of the current CompileEnv,
-     * from exceptArrayPtr[(exceptArrayNext - 1)] down to 
-     * exceptArrayPtr[0] to see if any of them is an enclosing [catch].
-     * If there's an enclosing [catch], don't compile.
-     */
-
-    while (index >= 0) {
-	ExceptionRange range = envPtr->exceptArrayPtr[index];
-	if ((range.type == CATCH_EXCEPTION_RANGE) 
-		&& (range.catchOffset == -1)) {
-	    return TCL_OUT_LINE_COMPILE;
-	}
-	index--;
-    }
-
     switch (parsePtr->numWords) {
 	case 1: {
 	    /*
@@ -2448,11 +2431,11 @@ TclCompileReturnCmd(interp, parsePtr, envPtr)
     }
 
     /*
-     * The INST_DONE opcode actually causes the branching out of the
+     * The INST_RETURN opcode triggers the branching out of the
      * subroutine, and takes the top stack item as the return result
      * (which is why we pushed the value above).
      */
-    TclEmitOpcode(INST_DONE, envPtr);
+    TclEmitOpcode(INST_RETURN, envPtr);
     return TCL_OK;
 }
 
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index c98348f..6812331 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.44 2003/03/13 02:48:52 dgp Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.45 2003/03/19 16:51:42 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -269,6 +269,8 @@ InstructionDesc tclInstructionTable[] = {
 	 * stacked objs: stktop is old value, next is new element value, next 
 	 * come (operand-2) indices; pushes the new value.
 	 */
+    {"return",		  1,   -1,          0,   {OPERAND_NONE}},
+	/* return TCL_RETURN code. */
     {0}
 };
 
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index bdd9ecc..993bfd4 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -8,7 +8,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.h,v 1.35 2003/03/13 02:48:53 dgp Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.36 2003/03/19 16:51:42 dgp Exp $
  */
 
 #ifndef _TCLCOMPILATION
@@ -522,8 +522,10 @@ typedef struct ByteCode {
 #define INST_LSET_LIST			96
 #define INST_LSET_FLAT                  97
 
+#define INST_RETURN			98
+
 /* The last opcode */
-#define LAST_INST_OPCODE        	97
+#define LAST_INST_OPCODE        	98
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 2496126..40e211d 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.95 2003/03/13 02:48:53 dgp Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.96 2003/03/19 16:51:43 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -1224,6 +1224,8 @@ TclExecuteByteCode(interp, codePtr)
     iPtr->stats.instructionCount[*pc]++;
 #endif
     switch (*pc) {
+    case INST_RETURN:
+	result = TCL_RETURN;
     case INST_DONE:
 	if (stackTop <= initStackTop) {
 	    stackTop--;
diff --git a/tests/compile.test b/tests/compile.test
index e31da81..6369313 100644
--- a/tests/compile.test
+++ b/tests/compile.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: compile.test,v 1.24 2003/01/08 00:34:59 dgp Exp $
+# RCS: @(#) $Id: compile.test,v 1.25 2003/03/19 16:51:43 dgp Exp $
 
 package require tcltest 2
 namespace import -force ::tcltest::*
@@ -331,7 +331,7 @@ test compile-14.1 {testing errors in element name; segfault?} {} {
      list $msg1 $msg2
 } {{wrong # args: should be "error message ?errorInfo? ?errorCode?"} {can't read "abba": no such variable}}
 
-# Next 4 tests cover Tcl Bug 633204
+# Tests compile-15.* cover Tcl Bug 633204
 test compile-15.1 {proper TCL_RETURN code from [return]} {
     proc p {} {catch return}
     set result [p]