fix for [Bug 816641] - faulty execution and catch stack management.

FossilOrigin-Name: 1fbbe0dc83be4f67176fe6bd759ff2cb460aab03

3 files changed, 32 insertions, 20 deletions

diff --git a/ChangeLog b/ChangeLog
index eeaa820..3846f76 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2003-10-04  Miguel Sofer <msofer@users.sf.net>
+
+	* generic/tclExecute.c (TEBC):
+	* tests/execute.test (execute-8.2): fix for [Bug 816641] - faulty
+	execution and catch stack management.
+
 2003-10-03  Don Porter  <dgp@users.sourceforge.net>
 
         * generic/tclBasic.c:   Fixed error in ref count management of command
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 79f7ee2..b6bac46 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.109 2003/09/23 18:38:05 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.110 2003/10/04 16:12:12 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -1057,7 +1057,6 @@ TclExecuteByteCode(interp, codePtr)
     Interp *iPtr = (Interp *) interp;
     ExecEnv *eePtr = iPtr->execEnvPtr;
     				/* Points to the execution environment. */
-    long *catchStackPtr;        /* start of the catch stack */
     int catchTop = -1;
     register Tcl_Obj **tosPtr;  /* Cached pointer to top of evaluation stack. */
     register unsigned char *pc = codePtr->codeStart;
@@ -1065,6 +1064,7 @@ TclExecuteByteCode(interp, codePtr)
     int opnd;			/* Current instruction's operand byte(s). */
     int pcAdjustment;		/* Hold pc adjustment after instruction. */
     int initStackTop;           /* Stack top at start of execution. */
+    int initCatchTop;           /* Catch stack top at start of execution. */
     ExceptionRange *rangePtr;	/* Points to closest loop or catch exception
 				 * range enclosing the pc. Used by various
 				 * instructions and processCatch to
@@ -1097,13 +1097,14 @@ TclExecuteByteCode(interp, codePtr)
      * Make sure the execution stack is large enough to execute this ByteCode.
      */
 
-    catchStackPtr = (long *)(eePtr->tosPtr + 1);
-    while ((catchStackPtr + codePtr->maxExceptDepth + codePtr->maxStackDepth) 
-	    > (long *) eePtr->endPtr) {
+    initCatchTop = eePtr->tosPtr - eePtr->stackPtr;
+    catchTop = initCatchTop;
+    tosPtr = eePtr->tosPtr + codePtr->maxExceptDepth;
+
+    while ((tosPtr + codePtr->maxStackDepth) > eePtr->endPtr) {
         GrowEvaluationStack(eePtr); 
-        catchStackPtr = (long *)(eePtr->tosPtr + 1);
+	tosPtr = eePtr->tosPtr + codePtr->maxExceptDepth;
     }
-    tosPtr = (Tcl_Obj **) (catchStackPtr + codePtr->maxExceptDepth - 1);
     initStackTop = tosPtr - eePtr->stackPtr;
 
 #ifdef TCL_COMPILE_DEBUG
@@ -4076,15 +4077,15 @@ TclExecuteByteCode(interp, codePtr)
 	 * equal to the operand. Push the current stack depth onto the
 	 * special catch stack.
 	 */
-	catchStackPtr[++catchTop] = (tosPtr - eePtr->stackPtr);
+	eePtr->stackPtr[++catchTop] = (Tcl_Obj *) (tosPtr - eePtr->stackPtr);
 	TRACE(("%u => catchTop=%d, stackTop=%d\n",
-	       TclGetUInt4AtPtr(pc+1), catchTop, tosPtr - eePtr->stackPtr));
+	       TclGetUInt4AtPtr(pc+1), (catchTop - initCatchTop - 1), tosPtr - eePtr->stackPtr));
 	NEXT_INST_F(5, 0, 0);
 
     case INST_END_CATCH:
 	catchTop--;
 	result = TCL_OK;
-	TRACE(("=> catchTop=%d\n", catchTop));
+	TRACE(("=> catchTop=%d\n", (catchTop - initCatchTop - 1)));
 	NEXT_INST_F(1, 0, 0);
 	    
     case INST_PUSH_RESULT:
@@ -4236,7 +4237,7 @@ TclExecuteByteCode(interp, codePtr)
 	    iPtr->flags |= ERR_ALREADY_LOGGED;
 	}
     }
-    if (catchTop == -1) {
+    if (catchTop == initCatchTop) {
 #ifdef TCL_COMPILE_DEBUG
 	if (traceInstructions) {
 	    fprintf(stdout, "   ... no enclosing catch, returning %s\n",
@@ -4271,14 +4272,15 @@ TclExecuteByteCode(interp, codePtr)
      */
 
  processCatch:
-    while (tosPtr > catchStackPtr[catchTop] + eePtr->stackPtr) {
+    while (tosPtr > (int) (eePtr->stackPtr[catchTop]) + eePtr->stackPtr) {
 	valuePtr = POP_OBJECT();
 	TclDecrRefCount(valuePtr);
     }
 #ifdef TCL_COMPILE_DEBUG
     if (traceInstructions) {
 	fprintf(stdout, "  ... found catch at %d, catchTop=%d, unwound to %d, new pc %u\n",
-	        rangePtr->codeOffset, catchTop, (int) catchStackPtr[catchTop],
+	        rangePtr->codeOffset, (catchTop - initCatchTop - 1), 
+		(int) eePtr->stackPtr[catchTop],
 	        (unsigned int)(rangePtr->catchOffset));
     }
 #endif	
@@ -4308,13 +4310,8 @@ TclExecuteByteCode(interp, codePtr)
 		    (unsigned int) initStackTop);
 	    panic("TclExecuteByteCode execution failure: end stack top < start stack top");
 	}
+	eePtr->tosPtr = initTosPtr - codePtr->maxExceptDepth;
     }
-	
-    /*
-     * Free the catch stack array if malloc'ed storage was used.
-     */
-	    
-    eePtr->tosPtr = (Tcl_Obj **) (catchStackPtr - 1);
     return result;
 }
 
diff --git a/tests/execute.test b/tests/execute.test
index 80b65ab..66e96a9 100644
--- a/tests/execute.test
+++ b/tests/execute.test
@@ -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: execute.test,v 1.14 2003/09/19 18:09:41 msofer Exp $
+# RCS: @(#) $Id: execute.test,v 1.15 2003/10/04 16:12:12 msofer Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -721,6 +721,15 @@ test execute-8.1 {Stack protection} {
     catch {expr {1+9/0}}
 } 1
 
+test execute-8.2 {Stack restoration} {
+    # Test for [Bug #816641], correct restoration
+    # of the stack top after the stack is grown
+     proc f {args} { f bee bop }
+     catch f msg
+     set msg
+ } {too many nested evaluations (infinite loop?)}
+
+
 # cleanup
 if {[info commands testobj] != {}} {
    testobj freeallvars