From f128a74c542e5d4cfa1795c5d9cea8a3b154e7ce Mon Sep 17 00:00:00 2001
From: dkf <dkf@noemail.net>
Date: Tue, 9 Feb 2010 20:51:52 +0000
Subject: Compilation of [try] now enabled!

FossilOrigin-Name: f2617b69aa7b76a63a06444769939de4d39984e9
---
 ChangeLog             |  12 +-
 generic/tclBasic.c    |   4 +-
 generic/tclCompCmds.c | 641 +++++++++++++++++++++++++++++++++++++++++++++++++-
 generic/tclInt.h      |   5 +-
 4 files changed, 657 insertions(+), 5 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 0664c23..695fb0d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,6 +1,16 @@
+2010-02-09  Donal K. Fellows  <dkf@users.sf.net>
+
+	* generic/tclCompCmds.c (TclCompileTryCmd, IssueTryInstructions)
+	(IssueTryFinallyInstructions): Added compiler for the [try] command.
+	It is split into three pieces that handle the parsing of the tokens,
+	the issuing of instructions for finally-free [try], and the issuing of
+	instructions for [try] with finally; there are enough differences
+	between the all cases that it was easier to split the code rather than
+	have a single function do the whole thing.
+
 2010-02-09  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>
 
-	* tools/genStubs.tcl: remove  dependency  on 8.5+  idiom "in"  in
+	* tools/genStubs.tcl: Remove dependency on 8.5+ idiom "in" in
 	expressions.
 
 2010-02-08  Donal K. Fellows  <dkf@users.sf.net>
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 7eb8359..97b4a5c 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -16,7 +16,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclBasic.c,v 1.442 2010/02/05 22:39:44 dkf Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.443 2010/02/09 20:51:54 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -240,7 +240,7 @@ static const CmdInfo builtInCmds[] = {
     {"tailcall",	NULL,			NULL,			TclNRTailcallObjCmd,	1},
     {"throw",		Tcl_ThrowObjCmd,	NULL,			NULL,	1},
     {"trace",		Tcl_TraceObjCmd,	NULL,			NULL,	1},
-    {"try",		Tcl_TryObjCmd,		NULL,			TclNRTryObjCmd,	1},
+    {"try",		Tcl_TryObjCmd,		TclCompileTryCmd,	TclNRTryObjCmd,	1},
     {"unset",		Tcl_UnsetObjCmd,	TclCompileUnsetCmd,	NULL,	1},
     {"uplevel",		Tcl_UplevelObjCmd,	NULL,			TclNRUplevelObjCmd,	1},
     {"upvar",		Tcl_UpvarObjCmd,	TclCompileUpvarCmd,	NULL,	1},
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 2b59d5c..6183039 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.159 2010/02/05 22:39:44 dkf Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.160 2010/02/09 20:51:54 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -182,6 +182,17 @@ static int		CompileUnaryOpCmd(Tcl_Interp *interp,
 static void		CompileReturnInternal(CompileEnv *envPtr,
 			    unsigned char op, int code, int level,
 			    Tcl_Obj *returnOpts);
+static int		IssueTryFinallyInstructions(Tcl_Interp *interp,
+			    CompileEnv *envPtr, Tcl_Token *bodyToken,
+			    int numHandlers, int *matchCodes,
+			    Tcl_Obj **matchClauses, int *resultVarIndices,
+			    int *optionVarIndices, Tcl_Token **handlerTokens,
+			    Tcl_Token *finallyToken);
+static int		IssueTryInstructions(Tcl_Interp *interp,
+			    CompileEnv *envPtr, Tcl_Token *bodyToken,
+			    int numHandlers, int *matchCodes,
+			    Tcl_Obj **matchClauses, int *resultVarIndices,
+			    int *optionVarIndices, Tcl_Token **handlerTokens);
 
 #define PushVarNameWord(i,v,e,f,l,s,sc,word) \
     PushVarName(i,v,e,f,l,s,sc,						\
@@ -5064,6 +5075,634 @@ PrintJumptableInfo(
 /*
  *----------------------------------------------------------------------
  *
+ * TclCompileTryCmd --
+ *
+ *	Procedure called to compile the "try" command.
+ *
+ * Results:
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the "try" command at
+ *	runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileTryCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    int numWords = parsePtr->numWords, numHandlers, result = TCL_ERROR;
+    Tcl_Token *bodyToken, *finallyToken, *tokenPtr;
+    Tcl_Token **handlerTokens = NULL;
+    Tcl_Obj **matchClauses = NULL;
+    int *matchCodes=NULL, *resultVarIndices=NULL, *optionVarIndices=NULL;
+    int i;
+
+    if (numWords < 2) {
+	return TCL_ERROR;
+    }
+
+    bodyToken = TokenAfter(parsePtr->tokenPtr);
+
+    if (numWords == 2) {
+	/*
+	 * No handlers or finally; do nothing beyond evaluating the body.
+	 */
+
+	DefineLineInformation;	/* TIP #280 */
+	SetLineInformation(1);
+	CompileBody(envPtr, bodyToken, interp);
+	return TCL_OK;
+    }
+
+    numWords -= 2;
+    tokenPtr = TokenAfter(bodyToken);
+
+    /*
+     * Extract information about what handlers there are.
+     */
+
+    numHandlers = numWords >> 2;
+    numWords -= numHandlers * 4;
+    if (numHandlers > 0) {
+	handlerTokens = TclStackAlloc(interp, sizeof(Tcl_Token*)*numHandlers);
+	matchClauses = TclStackAlloc(interp, sizeof(Tcl_Obj *) * numHandlers);
+	memset(matchClauses, 0, sizeof(Tcl_Obj *) * numHandlers);
+	matchCodes = TclStackAlloc(interp, sizeof(int) * numHandlers);
+	resultVarIndices = TclStackAlloc(interp, sizeof(int) * numHandlers);
+	optionVarIndices = TclStackAlloc(interp, sizeof(int) * numHandlers);
+
+	for (i=0 ; i<numHandlers ; i++) {
+	    Tcl_Obj *tmpObj, **objv;
+	    int objc;
+
+	    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+		goto failedToCompile;
+	    }
+	    if (tokenPtr[1].size == 4
+		    && !strncmp(tokenPtr[1].start, "trap", 4)) {
+		/*
+		 * Parse the list of errorCode words to match against.
+		 */
+
+		matchCodes[i] = TCL_ERROR;
+		tokenPtr = TokenAfter(tokenPtr);
+		TclNewObj(tmpObj);
+		Tcl_IncrRefCount(tmpObj);
+		if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)
+			|| Tcl_ListObjLength(NULL, tmpObj, &objc) != TCL_OK
+			|| (objc == 0)) {
+		    TclDecrRefCount(tmpObj);
+		    goto failedToCompile;
+		}
+		Tcl_ListObjReplace(NULL, tmpObj, 0, 0, 0, NULL);
+		matchClauses[i] = tmpObj;
+	    } else if (tokenPtr[1].size == 2
+		    && !strncmp(tokenPtr[1].start, "on", 2)) {
+		int code;
+		static const char *codes[] = {
+		    "ok", "error", "return", "break", "continue", NULL
+		};
+
+		/*
+		 * Parse the result code to look for.
+		 */
+
+		tokenPtr = TokenAfter(tokenPtr);
+		TclNewObj(tmpObj);
+		Tcl_IncrRefCount(tmpObj);
+		if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)) {
+		    TclDecrRefCount(tmpObj);
+		    goto failedToCompile;
+		}
+		if (Tcl_GetIntFromObj(NULL, tmpObj, &code) != TCL_OK
+			&& Tcl_GetIndexFromObj(NULL, tmpObj, codes, "",
+				TCL_EXACT, &code) != TCL_OK) {
+		    TclDecrRefCount(tmpObj);
+		    goto failedToCompile;
+		}
+		matchCodes[i] = code;
+		TclDecrRefCount(tmpObj);
+	    } else {
+		goto failedToCompile;
+	    }
+
+	    /*
+	     * Parse the variable binding.
+	     */
+
+	    tokenPtr = TokenAfter(tokenPtr);
+	    TclNewObj(tmpObj);
+	    Tcl_IncrRefCount(tmpObj);
+	    if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)) {
+		TclDecrRefCount(tmpObj);
+		goto failedToCompile;
+	    }
+	    if (Tcl_ListObjGetElements(NULL, tmpObj, &objc, &objv) != TCL_OK
+		    || (objc > 2)) {
+		TclDecrRefCount(tmpObj);
+		goto failedToCompile;
+	    }
+	    if (objc > 0) {
+		int len;
+		const char *varname = Tcl_GetStringFromObj(objv[0], &len);
+
+		if (!TclIsLocalScalar(varname, len)) {
+		    TclDecrRefCount(tmpObj);
+		    goto failedToCompile;
+		}
+		resultVarIndices[i] =
+			TclFindCompiledLocal(varname, len, 1, envPtr);
+	    } else {
+		resultVarIndices[i] = -1;
+	    }
+	    if (objc == 2) {
+		int len;
+		const char *varname = Tcl_GetStringFromObj(objv[1], &len);
+
+		if (!TclIsLocalScalar(varname, len)) {
+		    TclDecrRefCount(tmpObj);
+		    goto failedToCompile;
+		}
+		optionVarIndices[i] =
+			TclFindCompiledLocal(varname, len, 1, envPtr);
+	    } else {
+		optionVarIndices[i] = -1;
+	    }
+	    TclDecrRefCount(tmpObj);
+
+	    /*
+	     * Extract the body for this handler.
+	     */
+
+	    tokenPtr = TokenAfter(tokenPtr);
+	    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+		goto failedToCompile;
+	    }
+	    if (tokenPtr[1].size == 1 && tokenPtr[1].start[0] == '-') {
+		handlerTokens[i] = NULL;
+	    } else {
+		handlerTokens[i] = tokenPtr;
+	    }
+
+	    tokenPtr = TokenAfter(tokenPtr);
+	}
+
+	if (handlerTokens[numHandlers-1] == NULL) {
+	    goto failedToCompile;
+	}
+    }
+
+    /*
+     * Parse the finally clause
+     */
+
+    if (numWords == 0) {
+	finallyToken = NULL;
+    } else if (numWords == 2) {
+	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || tokenPtr[1].size != 7
+		|| strncmp(tokenPtr[1].start, "finally", 7)) {
+	    goto failedToCompile;
+	}
+	finallyToken = TokenAfter(tokenPtr);
+    } else {
+	goto failedToCompile;
+    }
+
+    /*
+     * Issue the bytecode.
+     */
+
+    if (finallyToken) {
+	result = IssueTryFinallyInstructions(interp, envPtr, bodyToken,
+		numHandlers, matchCodes, matchClauses, resultVarIndices,
+		optionVarIndices, handlerTokens, finallyToken);
+    } else {
+	result = IssueTryInstructions(interp, envPtr, bodyToken, numHandlers,
+		matchCodes, matchClauses, resultVarIndices, optionVarIndices,
+		handlerTokens);
+    }
+
+    /*
+     * Delete any temporary state and finish off.
+     */
+
+  failedToCompile:
+    if (numHandlers > 0) {
+	for (i=0 ; i<numHandlers ; i++) {
+	    if (matchClauses[i]) {
+		TclDecrRefCount(matchClauses[i]);
+	    }
+	}
+	TclStackFree(interp, optionVarIndices);
+	TclStackFree(interp, resultVarIndices);
+	TclStackFree(interp, matchCodes);
+	TclStackFree(interp, matchClauses);
+	TclStackFree(interp, handlerTokens);
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * IssueTryInstructions, IssueTryFinallyInstructions --
+ *
+ *	The code generators for [try]. Split from the parsing engine for
+ *	reasons of developer sanity, and also split between no-finally and
+ *	with-finally cases because so many of the details of generation vary
+ *	between the two.
+ *
+ *	The macros below make the instruction issuing easier to follow.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#define OP(name)	TclEmitOpcode(INST_##name, envPtr)
+#define OP1(name,val)	TclEmitInstInt1(INST_##name,(val),envPtr)
+#define OP4(name,val)	TclEmitInstInt4(INST_##name,(val),envPtr)
+#define OP44(name,val1,val2) \
+    TclEmitInstInt4(INST_##name,(val1),envPtr);TclEmitInt4((val2),envPtr)
+#define BODY(token,index) \
+    SetLineInformation((index));CompileBody(envPtr,(token),interp)
+#define PUSH(str) \
+    PushLiteral(envPtr,(str),strlen(str))
+#define JUMP(var,name) \
+    (var) = CurrentOffset(envPtr);TclEmitInstInt4(INST_##name,0,envPtr)
+#define FIXJUMP(var) \
+    TclStoreInt4AtPtr(CurrentOffset(envPtr)-(var),envPtr->codeStart+(var)+1)
+
+static int
+IssueTryInstructions(
+    Tcl_Interp *interp,
+    CompileEnv *envPtr,
+    Tcl_Token *bodyToken,
+    int numHandlers,
+    int *matchCodes,
+    Tcl_Obj **matchClauses,
+    int *resultVars,
+    int *optionVars,
+    Tcl_Token **handlerTokens)
+{
+    DefineLineInformation;	/* TIP #280 */
+    int range, resultVar, optionsVar;
+    int i, j, len, forwardsNeedFixing = 0;
+    int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource;
+    char buf[TCL_INTEGER_SPACE];
+
+    resultVar = TclFindCompiledLocal(NULL, 0, 1, envPtr);
+    optionsVar = TclFindCompiledLocal(NULL, 0, 1, envPtr);
+    if (resultVar < 0 || optionsVar < 0) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Compile the body, trapping any error in it so that we can trap on it
+     * and/or run a finally clause. Note that there must be at least one
+     * on/trap clause; when none is present, this whole function is not called
+     * (and it's never called when there's a finally clause).
+     */
+
+    range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
+    OP4(				BEGIN_CATCH4, range);
+    ExceptionRangeStarts(envPtr, range);
+    BODY(				bodyToken, 1);
+    ExceptionRangeEnds(envPtr, range);
+    OP1(				JUMP1, 3);
+    ExceptionRangeTarget(envPtr, range, catchOffset);
+    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);
+
+    /*
+     * Now we handle all the registered 'on' and 'trap' handlers in order.
+     * For us to be here, there must be at least one handler.
+     *
+     * Slight overallocation, but reduces size of this function.
+     */
+
+    addrsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers);
+    forwardsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers);
+
+    for (i=0 ; i<numHandlers ; i++) {
+	sprintf(buf, "%d", matchCodes[i]);
+	OP(				DUP);
+	PUSH(				buf);
+	OP(				EQ);
+	JUMP(notCodeJumpSource,		JUMP_FALSE4);
+	if (matchClauses[i]) {
+	    Tcl_ListObjLength(NULL, matchClauses[i], &len);
+
+	    /*
+	     * Match the errorcode according to try/trap rules.
+	     */
+
+	    OP4(			LOAD_SCALAR4, optionsVar);
+	    PUSH(			"-errorcode");
+	    OP4(			DICT_GET, 1);
+	    OP44(			LIST_RANGE_IMM, 0, len-1);
+	    PUSH(			TclGetString(matchClauses[i]));
+	    OP(				STR_EQ);
+	    JUMP(notECJumpSource,	JUMP_FALSE4);
+	} else {
+	    notECJumpSource = -1; /* LINT */
+	}
+	OP(				POP);
+
+	/*
+	 * There is no finally clause, so we can avoid wrapping a catch
+	 * context around the handler. That simplifies what instructions need
+	 * to be issued a lot since we can let errors just fall through.
+	 */
+
+	if (resultVars[i] >= 0) {
+	    OP4(			LOAD_SCALAR4, resultVar);
+	    OP4(			STORE_SCALAR4, resultVars[i]);
+	    OP(				POP);
+	    if (optionVars[i] >= 0) {
+		OP4(			LOAD_SCALAR4, optionsVar);
+		OP4(			STORE_SCALAR4, optionVars[i]);
+		OP(			POP);
+	    }
+	}
+	if (!handlerTokens[i]) {
+	    forwardsNeedFixing = 1;
+	    JUMP(forwardsToFix[i],	JUMP4);
+	} else {
+	    forwardsToFix[i] = -1;
+	    if (forwardsNeedFixing) {
+		forwardsNeedFixing = 0;
+		for (j=0 ; j<i ; j++) {
+		    if (forwardsToFix[j] == -1) {
+			continue;
+		    }
+		    FIXJUMP(forwardsToFix[j]);
+		    forwardsToFix[j] = -1;
+		}
+	    }
+	    BODY(			handlerTokens[i], 5+i*4);
+	}
+
+	JUMP(addrsToFix[i],		JUMP4);
+	if (matchClauses[i]) {
+	    FIXJUMP(notECJumpSource);
+	}
+	FIXJUMP(notCodeJumpSource);
+    }
+
+    /*
+     * Drop the result code since it didn't match any clause, and reissue the
+     * exception. Note also that INST_RETURN_STK can proceed to the next
+     * instruction.
+     */
+
+    OP(					POP);
+    OP4(				LOAD_SCALAR4, optionsVar);
+    OP4(				LOAD_SCALAR4, resultVar);
+    OP(					RETURN_STK);
+
+    /*
+     * Fix all the jumps from taken clauses to here (which is the end of the
+     * [try]).
+     */
+
+    for (i=0 ; i<numHandlers ; i++) {
+	FIXJUMP(addrsToFix[i]);
+    }
+    TclStackFree(interp, forwardsToFix);
+    TclStackFree(interp, addrsToFix);
+    return TCL_OK;
+}
+
+static int
+IssueTryFinallyInstructions(
+    Tcl_Interp *interp,
+    CompileEnv *envPtr,
+    Tcl_Token *bodyToken,
+    int numHandlers,
+    int *matchCodes,
+    Tcl_Obj **matchClauses,
+    int *resultVars,
+    int *optionVars,
+    Tcl_Token **handlerTokens,
+    Tcl_Token *finallyToken)	/* Not NULL */
+{
+    DefineLineInformation;	/* TIP #280 */
+    int savedStackDepth = envPtr->currStackDepth;
+    int range, resultVar, optionsVar, i, j, len, forwardsNeedFixing = 0;
+    int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource;
+    char buf[TCL_INTEGER_SPACE];
+
+    resultVar = TclFindCompiledLocal(NULL, 0, 1, envPtr);
+    optionsVar = TclFindCompiledLocal(NULL, 0, 1, envPtr);
+    if (resultVar < 0 || optionsVar < 0) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Compile the body, trapping any error in it so that we can trap on it
+     * (if any trap matches) and run a finally clause.
+     */
+
+    range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
+    OP4(				BEGIN_CATCH4, range);
+    ExceptionRangeStarts(envPtr, range);
+    BODY(				bodyToken, 1);
+    ExceptionRangeEnds(envPtr, range);
+    OP1(				JUMP1, 3);
+    ExceptionRangeTarget(envPtr, range, catchOffset);
+    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);
+    envPtr->currStackDepth = savedStackDepth + 1;
+
+    /*
+     * Now we handle all the registered 'on' and 'trap' handlers in order.
+     */
+
+    if (numHandlers) {
+	/*
+	 * Slight overallocation, but reduces size of this function.
+	 */
+
+	addrsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers);
+	forwardsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers);
+
+	for (i=0 ; i<numHandlers ; i++) {
+	    sprintf(buf, "%d", matchCodes[i]);
+	    OP(				DUP);
+	    PUSH(			buf);
+	    OP(				EQ);
+	    JUMP(notCodeJumpSource,	JUMP_FALSE4);
+	    if (matchClauses[i]) {
+		Tcl_ListObjLength(NULL, matchClauses[i], &len);
+
+		/*
+		 * Match the errorcode according to try/trap rules.
+		 */
+
+		OP4(			LOAD_SCALAR4, optionsVar);
+		PUSH(			"-errorcode");
+		OP4(			DICT_GET, 1);
+		OP44(			LIST_RANGE_IMM, 0, len-1);
+		PUSH(			TclGetString(matchClauses[i]));
+		OP(			STR_EQ);
+		JUMP(notECJumpSource,	JUMP_FALSE4);
+	    } else {
+		notECJumpSource = -1; /* LINT */
+	    }
+
+	    /*
+	     * There is a finally clause, so we need a fairly complex sequence
+	     * of instructions to deal with an on/trap handler because we must
+	     * call the finally handler *and* we need to substitute the result
+	     * from a failed trap for the result from the main script.
+	     */
+
+	    if (resultVars[i] >= 0 || handlerTokens[i]) {
+		range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
+		OP4(			BEGIN_CATCH4, range);
+		ExceptionRangeStarts(envPtr, range);
+	    }
+	    if (resultVars[i] >= 0) {
+		OP4(			LOAD_SCALAR4, resultVar);
+		OP4(			STORE_SCALAR4, resultVars[i]);
+		OP(			POP);
+		if (optionVars[i] >= 0) {
+		    OP4(		LOAD_SCALAR4, optionsVar);
+		    OP4(		STORE_SCALAR4, optionVars[i]);
+		    OP(			POP);
+		}
+	    }
+	    if (!handlerTokens[i]) {
+		/*
+		 * No handler. Will not be the last handler (that condition is
+		 * checked by the caller). Chain to the next one.
+		 */
+
+		ExceptionRangeEnds(envPtr, range);
+		forwardsNeedFixing = 1;
+		JUMP(forwardsToFix[i],	JUMP4);
+		if (resultVars[i] >= 0) {
+		    goto finishTrapCatchHandling;
+		}
+	    } else {
+		/*
+		 * Got a handler. Make sure that any pending patch-up actions
+		 * from previous unprocessed handlers are dealt with now that
+		 * we know where they are to jump to.
+		 */
+
+		if (forwardsNeedFixing) {
+		    forwardsNeedFixing = 0;
+		    OP1(		JUMP1, 7);
+		    for (j=0 ; j<i ; j++) {
+			if (forwardsToFix[j] == -1) {
+			    continue;
+			}
+			FIXJUMP(forwardsToFix[j]);
+			forwardsToFix[j] = -1;
+		    }
+		    OP4(		BEGIN_CATCH4, range);
+		}
+		BODY(			handlerTokens[i], 5+i*4);
+		ExceptionRangeEnds(envPtr, range);
+		OP(			POP);
+		OP1(			JUMP1, 6);
+		forwardsToFix[i] = -1;
+
+		/*
+		 * Error in handler or setting of variables; replace the
+		 * stored exception with the new one. Note that we only push
+		 * this if we have either a body or some variable setting
+		 * here. Otherwise this code is unreachable.
+		 */
+
+	    finishTrapCatchHandling:
+		ExceptionRangeTarget(envPtr, range, catchOffset);
+		OP(			PUSH_RESULT);
+		OP4(			STORE_SCALAR4, resultVar);
+		OP(			POP);
+		OP(			PUSH_RETURN_OPTIONS);
+		OP4(			STORE_SCALAR4, optionsVar);
+		OP(			POP);
+		OP(			END_CATCH);
+	    }
+	    if (i+1 < numHandlers) {
+		JUMP(addrsToFix[i],	JUMP4);
+	    }
+	    if (matchClauses[i]) {
+		FIXJUMP(notECJumpSource);
+	    }
+	    FIXJUMP(notCodeJumpSource);
+	}
+
+	/*
+	 * Fix all the jumps from taken clauses to here (the start of the
+	 * finally clause).
+	 */
+
+	for (i=0 ; i<numHandlers-1 ; i++) {
+	    FIXJUMP(addrsToFix[i]);
+	}
+	TclStackFree(interp, forwardsToFix);
+	TclStackFree(interp, addrsToFix);
+    }
+
+    /*
+     * Drop the result code.
+     */
+
+    OP(					POP);
+    envPtr->currStackDepth = savedStackDepth;
+
+    /*
+     * Process the finally clause (at last!) Note that we do not wrap this in
+     * error handlers because we would just rethrow immediately anyway. Then
+     * (on normal success) we reissue the exception. Note also that
+     * INST_RETURN_STK can proceed to the next instruction; that'll be the
+     * next command (or some inter-command manipulation).
+     */
+
+    BODY(				finallyToken, 3 + 4*numHandlers);
+    OP(					POP);
+    OP4(				LOAD_SCALAR4, optionsVar);
+    OP4(				LOAD_SCALAR4, resultVar);
+    OP(					RETURN_STK);
+
+    return TCL_OK;
+}
+
+#undef OP
+#undef OP1
+#undef OP4
+#undef OP44
+#undef BODY
+#undef PUSH
+#undef JUMP
+#undef FIXJUMP
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TclCompileUnsetCmd --
  *
  *	Procedure called to compile the "unset" command.
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 0e98299..bccb5a8 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -15,7 +15,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInt.h,v 1.459 2010/02/05 22:39:44 dkf Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.460 2010/02/09 20:51:54 dkf Exp $
  */
 
 #ifndef _TCLINT
@@ -3396,6 +3396,9 @@ MODULE_SCOPE int	TclCompileSubstCmd(Tcl_Interp *interp,
 MODULE_SCOPE int	TclCompileSwitchCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileTryCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclCompileUnsetCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
-- 
cgit v0.12