Tcl Source Code

Artifact [ed67c2b9d6]
Login

Artifact ed67c2b9d69357e38b430a1dc01c96c9fb39b534:

Attachment "newRange2.diff" to ticket [453709ffff] added by msofer 2002-03-07 06:06:40.
? 0patches
? generic/tclExecute.c.NEW
? generic/tclCompCmds.c.ORIG
? generic/tclExecute.c.ORIG
? generic/tclCompCmds.c.NEW
? tests/for.test.NEW
? tests/compile.test2
? unix/autoMkindex.tcl
? unix/httpd
? unix/ERR
? unix/tclUnixInit.c.NOTES
? unix/tclUnixInit.c2
? unix/pkg
? unix/stwCCKTC
? unix/ERRnew
? unix/tclsh0
? unix/configure.in.ORIG
? unix/TEST
? unix/configure.OLD
? unix/tclUnixInit.ORIG
? unix/ERR2
? unix/tclsh-newRange
? unix/tclsh-peep0
? unix/ERRok
? unix/ERRdiff
Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcl/tcl/ChangeLog,v
retrieving revision 1.896
diff -u -r1.896 ChangeLog
--- ChangeLog	6 Mar 2002 15:20:23 -0000	1.896
+++ ChangeLog	6 Mar 2002 23:04:05 -0000
@@ -1,3 +1,15 @@
+2002-03-06  Miguel Sofer  <[email protected]>
+
+	* generic/tclCompCmds.c:
+	* generic/tclCompile.c:
+	* generic/tclCompile.h: loop rotation optimisation when compiling
+	[foreach]; modification of the compilers tools for handling
+	exception ranges: new functions TclBeginExceptRange and
+	TclEndExceptRange, TclCreateExceptRange is gone.
+	* generic/tclExecute.c (GetExceptRangeForPc): faster exception
+	range lookup algorithm. 
+	[Patch 453709]
+
 2002-03-06  Donal K. Fellows  <[email protected]>
 
 	* generic/tcl.h, tools/tcl.wse.in, unix/configure.in,
Index: generic/tclCompCmds.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompCmds.c,v
retrieving revision 1.27
diff -u -r1.27 tclCompCmds.c
--- generic/tclCompCmds.c	26 Feb 2002 17:26:25 -0000	1.27
+++ generic/tclCompCmds.c	6 Mar 2002 23:04:07 -0000
@@ -242,7 +242,7 @@
     JumpFixup jumpFixup;
     Tcl_Token *cmdTokenPtr, *nameTokenPtr;
     char *name;
-    int localIndex, nameChars, range, startOffset, jumpDist;
+    int localIndex, nameChars, range, jumpDist;
     int code;
     char buffer[32 + TCL_INTEGER_SPACE];
     int savedStackDepth = envPtr->currStackDepth;
@@ -289,17 +289,6 @@
     }
 
     /*
-     * We will compile the catch command. Emit a beginCatch instruction at
-     * the start of the catch body: the subcommand it controls.
-     */
-    
-    envPtr->exceptDepth++;
-    envPtr->maxExceptDepth =
-	TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
-    range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
-    TclEmitInstInt4(INST_BEGIN_CATCH4, range, envPtr);
-
-    /*
      * If the body is a simple word, compile the instructions to
      * eval it. Otherwise, compile instructions to substitute its
      * text without catching, a catch instruction that resets the 
@@ -310,16 +299,23 @@
      */
 
     if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-	startOffset = (envPtr->codeNext - envPtr->codeStart);
+	range = TclBeginExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+	TclEmitInstInt4(INST_BEGIN_CATCH4, range, envPtr)
 	code = TclCompileCmdWord(interp, cmdTokenPtr+1, 1, envPtr);
     } else {
+	/*
+	 * REMARK: this will store an off-by-one stack depth in the
+	 * catchStack, but this is not important: we rely on INST_EVAL_STK
+	 * to pop its argument before going to checkForCatch.
+	 */
+
 	code = TclCompileTokens(interp, cmdTokenPtr+1,
 	        cmdTokenPtr->numComponents, envPtr);
-	startOffset = (envPtr->codeNext - envPtr->codeStart);
+	range = TclBeginExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+	TclEmitInstInt4(INST_BEGIN_CATCH4, range, envPtr)
 	TclEmitOpcode(INST_EVAL_STK, envPtr);
     }
-    envPtr->exceptArrayPtr[range].codeOffset = startOffset;
-
+ 
     if (code != TCL_OK) {
 	if (code == TCL_ERROR) {
 	    sprintf(buffer, "\n    (\"catch\" body line %d)",
@@ -328,9 +324,8 @@
         }
 	goto done;
     }
-    envPtr->exceptArrayPtr[range].numCodeBytes =
-	    (envPtr->codeNext - envPtr->codeStart) - startOffset;
-		    
+    TclEndExceptRange(range, envPtr);
+
     /*
      * The "no errors" epilogue code: store the body's result into the
      * variable (if any), push "0" (TCL_OK) as the catch's "no error"
@@ -375,16 +370,16 @@
      * an endCatch instruction at the end of the catch command.
      */
 
-    jumpDist = (envPtr->codeNext - envPtr->codeStart)
-	    - jumpFixup.codeOffset;
+    jumpDist = (envPtr->codeNext - envPtr->codeStart) -
+	    jumpFixup.codeOffset;
     if (TclFixupForwardJump(envPtr, &jumpFixup, jumpDist, 127)) {
 	panic("TclCompileCatchCmd: bad jump distance %d\n", jumpDist);
     }
+
     TclEmitOpcode(INST_END_CATCH, envPtr);
 
     done:
     envPtr->currStackDepth = savedStackDepth + 1;
-    envPtr->exceptDepth--;
     return code;
 }
 
@@ -501,7 +496,7 @@
 {
     Tcl_Token *startTokenPtr, *testTokenPtr, *nextTokenPtr, *bodyTokenPtr;
     JumpFixup jumpEvalCondFixup;
-    int testCodeOffset, bodyCodeOffset, nextCodeOffset, jumpDist;
+    int jumpDist;
     int bodyRange, nextRange, code;
     char buffer[32 + TCL_INTEGER_SPACE];
     int savedStackDepth = envPtr->currStackDepth;
@@ -539,18 +534,6 @@
     }
 
     /*
-     * Create ExceptionRange records for the body and the "next" command.
-     * The "next" command's ExceptionRange supports break but not continue
-     * (and has a -1 continueOffset).
-     */
-
-    envPtr->exceptDepth++;
-    envPtr->maxExceptDepth =
-	    TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
-    bodyRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
-    nextRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
-
-    /*
      * Inline compile the initial command.
      */
 
@@ -561,7 +544,7 @@
             Tcl_AddObjErrorInfo(interp,
 	            "\n    (\"for\" initial command)", -1);
         }
-	goto done;
+	return code;
     }
     TclEmitOpcode(INST_POP, envPtr);
    
@@ -580,10 +563,10 @@
     TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpEvalCondFixup);
 
     /*
-     * Compile the loop body.
+     * Compile the loop body. Create an ExceptionRange.
      */
 
-    bodyCodeOffset = (envPtr->codeNext - envPtr->codeStart);
+    bodyRange = TclBeginExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
 
     code = TclCompileCmdWord(interp, bodyTokenPtr+1,
 	    bodyTokenPtr->numComponents, envPtr);
@@ -594,19 +577,19 @@
 		    interp->errorLine);
             Tcl_AddObjErrorInfo(interp, buffer, -1);
         }
-	goto done;
+	return code;
     }
-    envPtr->exceptArrayPtr[bodyRange].numCodeBytes =
-	    (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
+    TclEndExceptRange(bodyRange, envPtr);
     TclEmitOpcode(INST_POP, envPtr);
 
-
     /*
-     * Compile the "next" subcommand.
+     * Compile the "next" subcommand. Create an ExceptionRange that 
+     * supports break but not continue (and has a -1 continueOffset).
      */
 
-    nextCodeOffset = (envPtr->codeNext - envPtr->codeStart);
-
+    nextRange = TclBeginExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
+    envPtr->exceptArrayPtr[bodyRange].continueOffset = 
+	    (envPtr->codeNext - envPtr->codeStart);
     envPtr->currStackDepth = savedStackDepth;
     code = TclCompileCmdWord(interp, nextTokenPtr+1,
 	    nextTokenPtr->numComponents, envPtr);
@@ -616,27 +599,19 @@
 	    Tcl_AddObjErrorInfo(interp,
 	            "\n    (\"for\" loop-end command)", -1);
 	}
-	goto done;
+	return code;
     }
-    envPtr->exceptArrayPtr[nextRange].numCodeBytes =
-	    (envPtr->codeNext - envPtr->codeStart)
-	    - nextCodeOffset;
+    TclEndExceptRange(nextRange, envPtr);
     TclEmitOpcode(INST_POP, envPtr);
     envPtr->currStackDepth = savedStackDepth;
 
     /*
-     * Compile the test expression then emit the conditional jump that
-     * terminates the for.
+     * Compile the test expression.
      */
 
-    testCodeOffset = (envPtr->codeNext - envPtr->codeStart);
-
-    jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset;
-    if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) {
-	bodyCodeOffset += 3;
-	nextCodeOffset += 3;
-	testCodeOffset += 3;
-    }
+    jumpDist = (envPtr->codeNext - envPtr->codeStart)
+	    - jumpEvalCondFixup.codeOffset;
+    (void) TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127);
     
     envPtr->currStackDepth = savedStackDepth;
     code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
@@ -645,11 +620,16 @@
 	    Tcl_AddObjErrorInfo(interp,
 				"\n    (\"for\" test expression)", -1);
 	}
-	goto done;
+	return code;
     }
     envPtr->currStackDepth = savedStackDepth + 1;
-    
-    jumpDist = (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
+
+    /* 
+     * Emit the conditional jump that terminates the for.
+     */
+
+    jumpDist = (envPtr->codeNext - envPtr->codeStart) - 
+	    envPtr->exceptArrayPtr[bodyRange].codeOffset;
     if (jumpDist > 127) {
 	TclEmitInstInt4(INST_JUMP_TRUE4, -jumpDist, envPtr);
     } else {
@@ -657,14 +637,9 @@
     }
     
     /*
-     * Set the loop's offsets and break target.
+     * Set the loop's break target.
      */
 
-    envPtr->exceptArrayPtr[bodyRange].codeOffset = bodyCodeOffset;
-    envPtr->exceptArrayPtr[bodyRange].continueOffset = nextCodeOffset;
-
-    envPtr->exceptArrayPtr[nextRange].codeOffset = nextCodeOffset;
-
     envPtr->exceptArrayPtr[bodyRange].breakOffset =
             envPtr->exceptArrayPtr[nextRange].breakOffset =
 	    (envPtr->codeNext - envPtr->codeStart);
@@ -675,11 +650,7 @@
 
     envPtr->currStackDepth = savedStackDepth;
     TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr);
-    code = TCL_OK;
-
-    done:
-    envPtr->exceptDepth--;
-    return code;
+    return TCL_OK;
 }
 
 /*
@@ -722,9 +693,8 @@
 				 * iteration count. */
     Tcl_Token *tokenPtr, *bodyTokenPtr;
     char *varList;
-    unsigned char *jumpPc;
-    JumpFixup jumpFalseFixup;
-    int jumpDist, jumpBackDist, jumpBackOffset, infoIndex, range;
+    JumpFixup jumpFixup;
+    int jumpDist, infoIndex, range;
     int numWords, numLists, numVars, loopIndex, tempVar, i, j, code;
     char savedChar;
     char buffer[32 + TCL_INTEGER_SPACE];
@@ -891,8 +861,6 @@
      * Evaluate then store each value list in the associated temporary.
      */
 
-    range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
-    
     loopIndex = 0;
     for (i = 0, tokenPtr = parsePtr->tokenPtr;
 	    i < numWords-1;
@@ -922,21 +890,20 @@
     TclEmitInstInt4(INST_FOREACH_START4, infoIndex, envPtr);
     
     /*
-     * Top of loop code: assign each loop variable and check whether
-     * to terminate the loop.
+     * END OF LOOP INITIALIZATION, START OF ACTUAL LOOP CODE.
+     * 
+     * Jump to the assignement and test at the end of the loop,
+     * using the loop rotation algorithm (see comments in the 
+     * code for [while].
      */
 
-    envPtr->exceptArrayPtr[range].continueOffset =
-	    (envPtr->codeNext - envPtr->codeStart);
-    TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex, envPtr);
-    TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);
-    
+    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
+
     /*
      * Inline compile the loop body.
      */
 
-    envPtr->exceptArrayPtr[range].codeOffset =
-	    (envPtr->codeNext - envPtr->codeStart);
+    range = TclBeginExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
     code = TclCompileCmdWord(interp, bodyTokenPtr+1,
 	    bodyTokenPtr->numComponents, envPtr);
     envPtr->currStackDepth = savedStackDepth + 1;
@@ -948,53 +915,37 @@
         }
 	goto done;
     }
-    envPtr->exceptArrayPtr[range].numCodeBytes =
-	    (envPtr->codeNext - envPtr->codeStart)
-	    - envPtr->exceptArrayPtr[range].codeOffset;
+    TclEndExceptRange(range, envPtr);
     TclEmitOpcode(INST_POP, envPtr);
-	
+
     /*
-     * Jump back to the test at the top of the loop. Generate a 4 byte jump
-     * if the distance to the test is > 120 bytes. This is conservative and
-     * ensures that we won't have to replace this jump if we later need to
-     * replace the ifFalse jump with a 4 byte jump.
+     * Fixup the initial jump.
      */
 
-    jumpBackOffset = (envPtr->codeNext - envPtr->codeStart);
-    jumpBackDist =
-	(jumpBackOffset - envPtr->exceptArrayPtr[range].continueOffset);
-    if (jumpBackDist > 120) {
-	TclEmitInstInt4(INST_JUMP4, -jumpBackDist, envPtr);
-    } else {
-	TclEmitInstInt1(INST_JUMP1, -jumpBackDist, envPtr);
-    }
+    jumpDist = (envPtr->codeNext - envPtr->codeStart) -
+	    jumpFixup.codeOffset;
+    (void) TclFixupForwardJump(envPtr, &jumpFixup, jumpDist, 127);
 
     /*
-     * Fix the target of the jump after the foreach_step test.
+     * Assign each loop variable and check whether to terminate 
+     * the loop, then jump back to the top of the loop if INST_FOREACH_STEP 
+     * says so.
+     *
+     * FUTURE: let INST_FOREACH_STEP do this jump, we do not need the 
+     * extra operations: create a TCL_OBJ, push it, instruction to test it
+     * and jump. Not done now for backwards compatibility with .tbc
      */
 
-    jumpDist = (envPtr->codeNext - envPtr->codeStart)
-	    - jumpFalseFixup.codeOffset;
-    if (TclFixupForwardJump(envPtr, &jumpFalseFixup, jumpDist, 127)) {
-	/*
-	 * Update the loop body's starting PC offset since it moved down.
-	 */
-
-	envPtr->exceptArrayPtr[range].codeOffset += 3;
-
-	/*
-	 * Update the jump back to the test at the top of the loop since it
-	 * also moved down 3 bytes.
-	 */
+    envPtr->exceptArrayPtr[range].continueOffset = 
+	    (envPtr->codeNext - envPtr->codeStart);
+    TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex, envPtr);
 
-	jumpBackOffset += 3;
-	jumpPc = (envPtr->codeStart + jumpBackOffset);
-	jumpBackDist += 3;
-	if (jumpBackDist > 120) {
-	    TclUpdateInstInt4AtPc(INST_JUMP4, -jumpBackDist, jumpPc);
-	} else {
-	    TclUpdateInstInt1AtPc(INST_JUMP1, -jumpBackDist, jumpPc);
-	}
+    jumpDist = (envPtr->codeNext - envPtr->codeStart) -
+	    envPtr->exceptArrayPtr[range].codeOffset;
+    if (jumpDist > 120) {
+	TclEmitInstInt4(INST_JUMP_TRUE4, -jumpDist, envPtr);
+    } else {
+	TclEmitInstInt1(INST_JUMP_TRUE1, -jumpDist, envPtr);
     }
 
     /*
@@ -1022,7 +973,6 @@
 	ckfree((char *) varcList);
         ckfree((char *) varvList);
     }
-    envPtr->exceptDepth--;
     return code;
 }
 
@@ -2880,7 +2830,7 @@
 {
     Tcl_Token *testTokenPtr, *bodyTokenPtr;
     JumpFixup jumpEvalCondFixup;
-    int testCodeOffset, bodyCodeOffset, jumpDist;
+    int testCodeOffset, jumpDist;
     int range, code;
     char buffer[32 + TCL_INTEGER_SPACE];
     int savedStackDepth = envPtr->currStackDepth;
@@ -2952,16 +2902,6 @@
 	Tcl_ResetResult(interp);	
     }
     *savedPos = savedChar;
-	
-    /* 
-     * Create a ExceptionRange record for the loop body. This is used to
-     * implement break and continue.
-     */
-
-    envPtr->exceptDepth++;
-    envPtr->maxExceptDepth =
-	TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
-    range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
 
     /*
      * Jump to the evaluation of the condition. This code uses the "loop
@@ -2989,7 +2929,7 @@
      * Compile the loop body.
      */
 
-    bodyCodeOffset = (envPtr->codeNext - envPtr->codeStart);
+    range = TclBeginExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
     code = TclCompileCmdWord(interp, bodyTokenPtr+1,
 	    bodyTokenPtr->numComponents, envPtr);
     envPtr->currStackDepth = savedStackDepth + 1;
@@ -2999,10 +2939,9 @@
 		    interp->errorLine);
             Tcl_AddObjErrorInfo(interp, buffer, -1);
         }
-	goto error;
+	return code;
     }
-    envPtr->exceptArrayPtr[range].numCodeBytes =
-	    (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
+    TclEndExceptRange(range, envPtr);
     TclEmitOpcode(INST_POP, envPtr);
 
     /*
@@ -3014,7 +2953,6 @@
 	testCodeOffset = (envPtr->codeNext - envPtr->codeStart);
 	jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset;
 	if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) {
-	    bodyCodeOffset += 3;
 	    testCodeOffset += 3;
 	}
 	envPtr->currStackDepth = savedStackDepth;
@@ -3024,18 +2962,19 @@
 		Tcl_AddObjErrorInfo(interp,
 				    "\n    (\"while\" test expression)", -1);
 	    }
-	    goto error;
+	    return code;
 	}
 	envPtr->currStackDepth = savedStackDepth + 1;
-    
-	jumpDist = (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
+	jumpDist = (envPtr->codeNext - envPtr->codeStart) -
+	        envPtr->exceptArrayPtr[range].codeOffset;
 	if (jumpDist > 127) {
 	    TclEmitInstInt4(INST_JUMP_TRUE4, -jumpDist, envPtr);
 	} else {
 	    TclEmitInstInt1(INST_JUMP_TRUE1, -jumpDist, envPtr);
 	}
     } else {
-	jumpDist = (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
+	jumpDist = (envPtr->codeNext - envPtr->codeStart) -
+	        envPtr->exceptArrayPtr[range].codeOffset;
 	if (jumpDist > 127) {
 	    TclEmitInstInt4(INST_JUMP4, -jumpDist, envPtr);
 	} else {
@@ -3045,11 +2984,10 @@
 
 
     /*
-     * Set the loop's body, continue and break offsets.
+     * Set the loop's continue and break offsets.
      */
 
     envPtr->exceptArrayPtr[range].continueOffset = testCodeOffset;
-    envPtr->exceptArrayPtr[range].codeOffset = bodyCodeOffset;
     envPtr->exceptArrayPtr[range].breakOffset =
 	    (envPtr->codeNext - envPtr->codeStart);
     
@@ -3060,12 +2998,7 @@
     pushResult:
     envPtr->currStackDepth = savedStackDepth;
     TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr);
-    envPtr->exceptDepth--;
     return TCL_OK;
-
-    error:
-    envPtr->exceptDepth--;
-    return code;
 }
 
 /*
Index: generic/tclCompile.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.c,v
retrieving revision 1.31
diff -u -r1.31 tclCompile.c
--- generic/tclCompile.c	25 Jan 2002 20:40:55 -0000	1.31
+++ generic/tclCompile.c	6 Mar 2002 23:04:09 -0000
@@ -2074,7 +2074,7 @@
 /*
  *----------------------------------------------------------------------
  *
- * TclCreateExceptRange --
+ * TclBeginExceptRange --
  *
  *	Procedure that allocates and initializes a new ExceptionRange
  *	structure of the specified kind in a CompileEnv.
@@ -2088,12 +2088,14 @@
  *	allocated, if envPtr->mallocedExceptArray is non-zero the old
  *	array is freed, and ExceptionRange entries are copied from the old
  *	array to the new one.
+ *      The codeOffset field of the ExceptionRange is initialized to
+ *      the current position, the compilation environment's exceptDepth 
+ *      and maxExceptDepth are updated.
  *
  *----------------------------------------------------------------------
  */
 
-int
-TclCreateExceptRange(type, envPtr)
+int TclBeginExceptRange(type, envPtr)
     ExceptionRangeType type;	/* The kind of ExceptionRange desired. */
     register CompileEnv *envPtr;/* Points to CompileEnv for which to
 				 * create a new ExceptionRange structure. */
@@ -2131,16 +2133,49 @@
 	envPtr->mallocedExceptArray = 1;
     }
     envPtr->exceptArrayNext++;
+    envPtr->exceptDepth++;
+    envPtr->maxExceptDepth =
+	TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
     
     rangePtr = &(envPtr->exceptArrayPtr[index]);
     rangePtr->type = type;
     rangePtr->nestingLevel = envPtr->exceptDepth;
-    rangePtr->codeOffset = -1;
+    rangePtr->codeOffset = (envPtr->codeNext - envPtr->codeStart);
     rangePtr->numCodeBytes = -1;
     rangePtr->breakOffset = -1;
     rangePtr->continueOffset = -1;
     rangePtr->catchOffset = -1;
     return index;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclEndExceptRange --
+ *
+ *
+ *	Procedure that closes an existing ExceptionRange.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *      The numCodeBytes field of the ExceptionRange is initialized to
+ *      reflect the current position, the compilation environment's 
+ *      exceptDepth is updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void TclEndExceptRange(index, envPtr)
+    int index;	        /* The index of the exception range. */
+    CompileEnv *envPtr;/* CompileEnv for this exceptionRange.*/
+{
+    register ExceptionRange *rangePtr = &(envPtr->exceptArrayPtr[index]);
+
+    rangePtr->numCodeBytes = 
+        (envPtr->codeNext - envPtr->codeStart) - rangePtr->codeOffset;
+    envPtr->exceptDepth--;
 }
 
 /*
Index: generic/tclCompile.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.h,v
retrieving revision 1.25
diff -u -r1.25 tclCompile.h
--- generic/tclCompile.h	15 Feb 2002 14:28:48 -0000	1.25
+++ generic/tclCompile.h	6 Mar 2002 23:04:09 -0000
@@ -757,6 +757,8 @@
  *----------------------------------------------------------------
  */
 
+EXTERN int		TclBeginExceptRange _ANSI_ARGS_((
+			    ExceptionRangeType type, CompileEnv *envPtr));
 EXTERN void		TclCleanupByteCode _ANSI_ARGS_((ByteCode *codePtr));
 EXTERN int		TclCompileCmdWord _ANSI_ARGS_((Tcl_Interp *interp,
 			    Tcl_Token *tokenPtr, int count,
@@ -775,14 +777,14 @@
 			    CompileEnv *envPtr));
 EXTERN int		TclCreateAuxData _ANSI_ARGS_((ClientData clientData,
 			    AuxDataType *typePtr, CompileEnv *envPtr));
-EXTERN int		TclCreateExceptRange _ANSI_ARGS_((
-			    ExceptionRangeType type, CompileEnv *envPtr));
 EXTERN ExecEnv *	TclCreateExecEnv _ANSI_ARGS_((Tcl_Interp *interp));
 EXTERN void		TclDeleteExecEnv _ANSI_ARGS_((ExecEnv *eePtr));
 EXTERN void		TclDeleteLiteralTable _ANSI_ARGS_((
 			    Tcl_Interp *interp, LiteralTable *tablePtr));
 EXTERN void		TclEmitForwardJump _ANSI_ARGS_((CompileEnv *envPtr,
 			    TclJumpType jumpType, JumpFixup *jumpFixupPtr));
+EXTERN void		TclEndExceptRange _ANSI_ARGS_((
+			    int index, CompileEnv *envPtr));
 EXTERN ExceptionRange *	TclGetExceptionRangeForPc _ANSI_ARGS_((
 			    unsigned char *pc, int catchOnly,
 			    ByteCode* codePtr));
Index: generic/tclExecute.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclExecute.c,v
retrieving revision 1.49
diff -u -r1.49 tclExecute.c
--- generic/tclExecute.c	28 Feb 2002 13:03:53 -0000	1.49
+++ generic/tclExecute.c	6 Mar 2002 23:04:12 -0000
@@ -1467,6 +1467,12 @@
 	    }
 	    
 	case INST_EVAL_STK:
+	    /*
+	     * Note to maintainers: it is important that INST_EVAL_STK
+	     * pop its argument from the stack before jumping to
+	     * checkForCatch! DO NOT OPTIMISE!
+	     */
+
 	    objPtr = POP_OBJECT();
 	    DECACHE_STACK_INFO();
 	    result = TclCompEvalObj(interp, objPtr, /* engineCall */ 1);
@@ -4830,25 +4836,28 @@
     int numRanges = codePtr->numExceptRanges;
     register ExceptionRange *rangePtr;
     int pcOffset = (pc - codePtr->codeStart);
-    register int i, level;
+    register int start;
 
     if (numRanges == 0) {
 	return NULL;
     }
-    rangeArrayPtr = codePtr->exceptArrayPtr;
 
-    for (level = codePtr->maxExceptDepth;  level >= 0;  level--) {
-	for (i = 0;  i < numRanges;  i++) {
-	    rangePtr = &(rangeArrayPtr[i]);
-	    if (rangePtr->nestingLevel == level) {
-		int start = rangePtr->codeOffset;
-		int end   = (start + rangePtr->numCodeBytes);
-		if ((start <= pcOffset) && (pcOffset < end)) {
-		    if ((!catchOnly)
-			    || (rangePtr->type == CATCH_EXCEPTION_RANGE)) {
-			return rangePtr;
-		    }
-		}
+    /* 
+     * This exploits peculiarities of our compiler: nested ranges
+     * are always *after* their containing ranges, so that by scanning
+     * backwards we are sure that the first matching range is indeed
+     * the deepest.
+     */
+
+    rangeArrayPtr = codePtr->exceptArrayPtr;
+    rangePtr = rangeArrayPtr + numRanges;
+    while (--rangePtr >= rangeArrayPtr) {
+	start = rangePtr->codeOffset;
+	if ((start <= pcOffset) &&
+	        (pcOffset < (start + rangePtr->numCodeBytes))) {
+	    if ((!catchOnly)
+		    || (rangePtr->type == CATCH_EXCEPTION_RANGE)) {
+		return rangePtr;
 	    }
 	}
     }