summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2013-06-09 17:38:20 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2013-06-09 17:38:20 (GMT)
commit7585d9a6fde12d67972b07247cb3e527ad224f51 (patch)
tree82fc73732885581506aee020fc38c6ea6e751632
parente78449dde7b7ac8a9457653494d916eda6735a62 (diff)
parent94412474c1700b886d93941b7a424c8e2de9e893 (diff)
downloadtcl-dkf_bytecode_optimizer.zip
tcl-dkf_bytecode_optimizer.tar.gz
tcl-dkf_bytecode_optimizer.tar.bz2
-rw-r--r--ChangeLog9
-rw-r--r--generic/tclCompCmdsSZ.c516
-rw-r--r--generic/tclCompile.c3
-rw-r--r--tests/error.test146
4 files changed, 502 insertions, 172 deletions
diff --git a/ChangeLog b/ChangeLog
index 15bab6e..02f5ffa 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2013-06-09 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCompCmdsSZ.c (TclCompileTryCmd): [Bug 779d38b996]:
+ Rewrote the [try] compiler to generate better code in some cases and
+ to behave correctly in others; when an error happens during the
+ processing of an exception-trap clause or a finally clause, the
+ *original* return options are now captured in a -during option, even
+ when fully compiled.
+
2013-06-05 Donal K. Fellows <dkf@users.sf.net>
* generic/tclExecute.c (INST_EXPAND_DROP): [Bugs 2835313, 3614226]:
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 381703b..5d67166 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -51,17 +51,20 @@ static void IssueSwitchJumpTable(Tcl_Interp *interp,
Tcl_Token *valueTokenPtr, int numWords,
Tcl_Token **bodyToken, int *bodyLines,
int **bodyContLines);
-static int IssueTryFinallyInstructions(Tcl_Interp *interp,
+static int IssueTryClausesInstructions(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,
+ int *optionVarIndices, Tcl_Token **handlerTokens);
+static int IssueTryClausesFinallyInstructions(Tcl_Interp *interp,
CompileEnv *envPtr, Tcl_Token *bodyToken,
int numHandlers, int *matchCodes,
Tcl_Obj **matchClauses, int *resultVarIndices,
- int *optionVarIndices, Tcl_Token **handlerTokens);
+ int *optionVarIndices, Tcl_Token **handlerTokens,
+ Tcl_Token *finallyToken);
+static int IssueTryFinallyInstructions(Tcl_Interp *interp,
+ CompileEnv *envPtr, Tcl_Token *bodyToken,
+ Tcl_Token *finallyToken);
/*
* The structures below define the AuxData types defined in this file.
@@ -89,10 +92,14 @@ const AuxDataType tclJumptableInfoType = {
SetLineInformation((index));CompileBody(envPtr,(token),interp)
#define PUSH(str) \
PushStringLiteral(envPtr, str)
-#define JUMP(var,name) \
- (var) = CurrentOffset(envPtr);TclEmitInstInt4(INST_##name,0,envPtr)
-#define FIXJUMP(var) \
+#define JUMP4(name,var) \
+ (var) = CurrentOffset(envPtr);TclEmitInstInt4(INST_##name##4,0,envPtr)
+#define FIXJUMP4(var) \
TclStoreInt4AtPtr(CurrentOffset(envPtr)-(var),envPtr->codeStart+(var)+1)
+#define JUMP1(name,var) \
+ (var) = CurrentOffset(envPtr);TclEmitInstInt1(INST_##name##1,0,envPtr)
+#define FIXJUMP1(var) \
+ TclStoreInt1AtPtr(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) \
@@ -2223,14 +2230,17 @@ TclCompileTryCmd(
* Issue the bytecode.
*/
- if (finallyToken) {
+ if (!finallyToken) {
+ result = IssueTryClausesInstructions(interp, envPtr, bodyToken,
+ numHandlers, matchCodes, matchClauses, resultVarIndices,
+ optionVarIndices, handlerTokens);
+ } else if (numHandlers == 0) {
result = IssueTryFinallyInstructions(interp, envPtr, bodyToken,
+ finallyToken);
+ } else {
+ result = IssueTryClausesFinallyInstructions(interp, envPtr, bodyToken,
numHandlers, matchCodes, matchClauses, resultVarIndices,
optionVarIndices, handlerTokens, finallyToken);
- } else {
- result = IssueTryInstructions(interp, envPtr, bodyToken, numHandlers,
- matchCodes, matchClauses, resultVarIndices, optionVarIndices,
- handlerTokens);
}
/*
@@ -2256,12 +2266,13 @@ TclCompileTryCmd(
/*
*----------------------------------------------------------------------
*
- * IssueTryInstructions, IssueTryFinallyInstructions --
+ * IssueTryClausesInstructions, IssueTryClausesFinallyInstructions,
+ * 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.
+ * reasons of developer sanity, and also split between no-finally,
+ * just-finally and with-finally cases because so many of the details of
+ * generation vary between the three.
*
* The macros below make the instruction issuing easier to follow.
*
@@ -2269,7 +2280,7 @@ TclCompileTryCmd(
*/
static int
-IssueTryInstructions(
+IssueTryClausesInstructions(
Tcl_Interp *interp,
CompileEnv *envPtr,
Tcl_Token *bodyToken,
@@ -2282,9 +2293,9 @@ IssueTryInstructions(
{
DefineLineInformation; /* TIP #280 */
int range, resultVar, optionsVar;
- int savedStackDepth = envPtr->currStackDepth;
- int i, j, len, forwardsNeedFixing = 0;
+ int i, j, len, forwardsNeedFixing = 0, trapZero = 0, afterBody = 0;
int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource;
+ int *noError;
char buf[TCL_INTEGER_SPACE];
resultVar = AnonymousLocal(envPtr);
@@ -2294,6 +2305,18 @@ IssueTryInstructions(
}
/*
+ * Check if we're supposed to trap a normal TCL_OK completion of the body.
+ * If not, we can handle that case much more efficiently.
+ */
+
+ for (i=0 ; i<numHandlers ; i++) {
+ if (matchCodes[i] == 0) {
+ trapZero = 1;
+ break;
+ }
+ }
+
+ /*
* 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
@@ -2305,9 +2328,16 @@ IssueTryInstructions(
ExceptionRangeStarts(envPtr, range);
BODY( bodyToken, 1);
ExceptionRangeEnds(envPtr, range);
- PUSH( "0");
- OP4( REVERSE, 2);
- OP1( JUMP1, 4);
+ if (!trapZero) {
+ OP( END_CATCH);
+ JUMP4( JUMP, afterBody);
+ TclAdjustStackDepth(-1, envPtr);
+ } else {
+ PUSH( "0");
+ OP4( REVERSE, 2);
+ OP1( JUMP1, 4);
+ TclAdjustStackDepth(-2, envPtr);
+ }
ExceptionRangeTarget(envPtr, range, catchOffset);
OP( PUSH_RETURN_CODE);
OP( PUSH_RESULT);
@@ -2327,13 +2357,15 @@ IssueTryInstructions(
addrsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers);
forwardsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers);
+ noError = TclStackAlloc(interp, sizeof(int)*numHandlers);
for (i=0 ; i<numHandlers ; i++) {
+ noError[i] = -1;
sprintf(buf, "%d", matchCodes[i]);
OP( DUP);
PushLiteral(envPtr, buf, strlen(buf));
OP( EQ);
- JUMP(notCodeJumpSource, JUMP_FALSE4);
+ JUMP4( JUMP_FALSE, notCodeJumpSource);
if (matchClauses[i]) {
const char *p;
Tcl_ListObjLength(NULL, matchClauses[i], &len);
@@ -2350,7 +2382,7 @@ IssueTryInstructions(
p = Tcl_GetStringFromObj(matchClauses[i], &len);
PushLiteral(envPtr, p, len);
OP( STR_EQ);
- JUMP(notECJumpSource, JUMP_FALSE4);
+ JUMP4( JUMP_FALSE, notECJumpSource);
} else {
notECJumpSource = -1; /* LINT */
}
@@ -2374,8 +2406,10 @@ IssueTryInstructions(
}
if (!handlerTokens[i]) {
forwardsNeedFixing = 1;
- JUMP(forwardsToFix[i], JUMP4);
+ JUMP4( JUMP, forwardsToFix[i]);
} else {
+ int dontChangeOptions;
+
forwardsToFix[i] = -1;
if (forwardsNeedFixing) {
forwardsNeedFixing = 0;
@@ -2383,19 +2417,44 @@ IssueTryInstructions(
if (forwardsToFix[j] == -1) {
continue;
}
- FIXJUMP(forwardsToFix[j]);
+ FIXJUMP4(forwardsToFix[j]);
forwardsToFix[j] = -1;
}
}
- envPtr->currStackDepth = savedStackDepth;
+ range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+ OP4( BEGIN_CATCH4, range);
+ ExceptionRangeStarts(envPtr, range);
BODY( handlerTokens[i], 5+i*4);
+ ExceptionRangeEnds(envPtr, range);
+ OP( END_CATCH);
+ JUMP4( JUMP, noError[i]);
+ ExceptionRangeTarget(envPtr, range, catchOffset);
+ TclAdjustStackDepth(-1, envPtr);
+ OP( PUSH_RESULT);
+ OP( PUSH_RETURN_OPTIONS);
+ OP( PUSH_RETURN_CODE);
+ OP( END_CATCH);
+ PUSH( "1");
+ OP( EQ);
+ JUMP1( JUMP_FALSE, dontChangeOptions);
+ LOAD( optionsVar);
+ OP4( REVERSE, 2);
+ STORE( optionsVar);
+ OP( POP);
+ PUSH( "-during");
+ OP4( REVERSE, 2);
+ OP44( DICT_SET, 1, optionsVar);
+ TclAdjustStackDepth(-1, envPtr);
+ FIXJUMP1( dontChangeOptions);
+ OP4( REVERSE, 2);
+ OP( RETURN_STK);
}
- JUMP(addrsToFix[i], JUMP4);
+ JUMP4( JUMP, addrsToFix[i]);
if (matchClauses[i]) {
- FIXJUMP(notECJumpSource);
+ FIXJUMP4( notECJumpSource);
}
- FIXJUMP(notCodeJumpSource);
+ FIXJUMP4( notCodeJumpSource);
}
/*
@@ -2414,17 +2473,23 @@ IssueTryInstructions(
* [try]).
*/
+ if (!trapZero) {
+ FIXJUMP4(afterBody);
+ }
for (i=0 ; i<numHandlers ; i++) {
- FIXJUMP(addrsToFix[i]);
+ FIXJUMP4(addrsToFix[i]);
+ if (noError[i] != -1) {
+ FIXJUMP4(noError[i]);
+ }
}
+ TclStackFree(interp, noError);
TclStackFree(interp, forwardsToFix);
TclStackFree(interp, addrsToFix);
- envPtr->currStackDepth = savedStackDepth + 1;
return TCL_OK;
}
static int
-IssueTryFinallyInstructions(
+IssueTryClausesFinallyInstructions(
Tcl_Interp *interp,
CompileEnv *envPtr,
Tcl_Token *bodyToken,
@@ -2437,8 +2502,8 @@ IssueTryFinallyInstructions(
Tcl_Token *finallyToken) /* Not NULL */
{
DefineLineInformation; /* TIP #280 */
- int savedStackDepth = envPtr->currStackDepth;
int range, resultVar, optionsVar, i, j, len, forwardsNeedFixing = 0;
+ int trapZero = 0, afterBody = 0, finalOK, finalError, noFinalError;
int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource;
char buf[TCL_INTEGER_SPACE];
@@ -2449,6 +2514,18 @@ IssueTryFinallyInstructions(
}
/*
+ * Check if we're supposed to trap a normal TCL_OK completion of the body.
+ * If not, we can handle that case much more efficiently.
+ */
+
+ for (i=0 ; i<numHandlers ; i++) {
+ if (matchCodes[i] == 0) {
+ trapZero = 1;
+ break;
+ }
+ }
+
+ /*
* Compile the body, trapping any error in it so that we can trap on it
* (if any trap matches) and run a finally clause.
*/
@@ -2456,12 +2533,22 @@ IssueTryFinallyInstructions(
range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
OP4( BEGIN_CATCH4, range);
ExceptionRangeStarts(envPtr, range);
- envPtr->currStackDepth = savedStackDepth;
BODY( bodyToken, 1);
ExceptionRangeEnds(envPtr, range);
- PUSH( "0");
- OP4( REVERSE, 2);
- OP1( JUMP1, 4);
+ if (!trapZero) {
+ OP( END_CATCH);
+ STORE( resultVar);
+ OP( POP);
+ PUSH( "-level 0 -code 0");
+ STORE( optionsVar);
+ OP( POP);
+ JUMP4( JUMP, afterBody);
+ } else {
+ PUSH( "0");
+ OP4( REVERSE, 2);
+ OP1( JUMP1, 4);
+ TclAdjustStackDepth(-2, envPtr);
+ }
ExceptionRangeTarget(envPtr, range, catchOffset);
OP( PUSH_RETURN_CODE);
OP( PUSH_RESULT);
@@ -2471,163 +2558,178 @@ IssueTryFinallyInstructions(
OP( POP);
STORE( resultVar);
OP( POP);
- envPtr->currStackDepth = savedStackDepth + 1;
/*
* Now we handle all the registered 'on' and 'trap' handlers in order.
+ *
+ * Slight overallocation, but reduces size of this function.
*/
- 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);
- PushLiteral(envPtr, buf, strlen(buf));
- OP( EQ);
- JUMP(notCodeJumpSource, JUMP_FALSE4);
- if (matchClauses[i]) {
- const char *p;
- Tcl_ListObjLength(NULL, matchClauses[i], &len);
+ addrsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers);
+ forwardsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers);
- /*
- * Match the errorcode according to try/trap rules.
- */
+ for (i=0 ; i<numHandlers ; i++) {
+ int noTrapError, trapError;
+ const char *p;
- LOAD( optionsVar);
- PUSH( "-errorcode");
- OP4( DICT_GET, 1);
- TclAdjustStackDepth(-1, envPtr);
- OP44( LIST_RANGE_IMM, 0, len-1);
- p = Tcl_GetStringFromObj(matchClauses[i], &len);
- PushLiteral(envPtr, p, len);
- OP( STR_EQ);
- JUMP(notECJumpSource, JUMP_FALSE4);
- } else {
- notECJumpSource = -1; /* LINT */
- }
+ sprintf(buf, "%d", matchCodes[i]);
+ OP( DUP);
+ PushLiteral(envPtr, buf, strlen(buf));
+ OP( EQ);
+ JUMP4( JUMP_FALSE, notCodeJumpSource);
+ if (matchClauses[i]) {
+ Tcl_ListObjLength(NULL, matchClauses[i], &len);
/*
- * 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.
+ * Match the errorcode according to try/trap rules.
*/
- if (resultVars[i] >= 0 || handlerTokens[i]) {
- range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
- OP4( BEGIN_CATCH4, range);
- ExceptionRangeStarts(envPtr, range);
- }
- if (resultVars[i] >= 0) {
- LOAD( resultVar);
- STORE( resultVars[i]);
- OP( POP);
- if (optionVars[i] >= 0) {
- LOAD( optionsVar);
- STORE( optionVars[i]);
- OP( POP);
- }
+ LOAD( optionsVar);
+ PUSH( "-errorcode");
+ OP4( DICT_GET, 1);
+ TclAdjustStackDepth(-1, envPtr);
+ OP44( LIST_RANGE_IMM, 0, len-1);
+ p = Tcl_GetStringFromObj(matchClauses[i], &len);
+ PushLiteral(envPtr, p, len);
+ OP( STR_EQ);
+ JUMP4( JUMP_FALSE, notECJumpSource);
+ } else {
+ notECJumpSource = -1; /* LINT */
+ }
+ OP( POP);
- if (!handlerTokens[i]) {
- /*
- * No handler. Will not be the last handler (that is a
- * condition that is checked by the caller). Chain to the
- * next one.
- */
+ /*
+ * 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.
+ */
- ExceptionRangeEnds(envPtr, range);
- OP( END_CATCH);
- forwardsNeedFixing = 1;
- JUMP(forwardsToFix[i], JUMP4);
- goto finishTrapCatchHandling;
- }
- } else if (!handlerTokens[i]) {
+ if (resultVars[i] >= 0 || handlerTokens[i]) {
+ range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+ OP4( BEGIN_CATCH4, range);
+ ExceptionRangeStarts(envPtr, range);
+ }
+ if (resultVars[i] >= 0) {
+ LOAD( resultVar);
+ STORE( resultVars[i]);
+ OP( POP);
+ if (optionVars[i] >= 0) {
+ LOAD( optionsVar);
+ STORE( 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.
+ * No handler. Will not be the last handler (that is a
+ * condition that is checked by the caller). Chain to the next
+ * one.
*/
+ ExceptionRangeEnds(envPtr, range);
+ OP( END_CATCH);
forwardsNeedFixing = 1;
- JUMP(forwardsToFix[i], JUMP4);
- goto endOfThisArm;
+ JUMP4( JUMP, forwardsToFix[i]);
+ goto finishTrapCatchHandling;
}
-
+ } else if (!handlerTokens[i]) {
/*
- * 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.
+ * No handler. Will not be the last handler (that condition is
+ * checked by the caller). Chain to the next one.
*/
- 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);
- }
- envPtr->currStackDepth = savedStackDepth;
- BODY( handlerTokens[i], 5+i*4);
- ExceptionRangeEnds(envPtr, range);
- OP( PUSH_RETURN_OPTIONS);
- OP4( REVERSE, 2);
- OP1( JUMP1, 4);
- 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.
- */
+ forwardsNeedFixing = 1;
+ JUMP4( JUMP, forwardsToFix[i]);
+ goto endOfThisArm;
+ }
- finishTrapCatchHandling:
- ExceptionRangeTarget(envPtr, range, catchOffset);
- OP( PUSH_RETURN_OPTIONS);
- OP( PUSH_RESULT);
- OP( END_CATCH);
- STORE( resultVar);
- OP( POP);
- STORE( optionsVar);
- OP( POP);
+ /*
+ * 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.
+ */
- endOfThisArm:
- if (i+1 < numHandlers) {
- JUMP(addrsToFix[i], JUMP4);
- }
- if (matchClauses[i]) {
- FIXJUMP(notECJumpSource);
+ if (forwardsNeedFixing) {
+ forwardsNeedFixing = 0;
+ OP1( JUMP1, 7);
+ for (j=0 ; j<i ; j++) {
+ if (forwardsToFix[j] == -1) {
+ continue;
+ }
+ FIXJUMP4( forwardsToFix[j]);
+ forwardsToFix[j] = -1;
}
- FIXJUMP(notCodeJumpSource);
+ OP4( BEGIN_CATCH4, range);
}
+ BODY( handlerTokens[i], 5+i*4);
+ ExceptionRangeEnds(envPtr, range);
+ PUSH( "0");
+ OP( PUSH_RETURN_OPTIONS);
+ OP4( REVERSE, 3);
+ OP1( JUMP1, 5);
+ TclAdjustStackDepth(-3, envPtr);
+ forwardsToFix[i] = -1;
/*
- * Fix all the jumps from taken clauses to here (the start of the
- * finally clause).
+ * 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.
*/
- for (i=0 ; i<numHandlers-1 ; i++) {
- FIXJUMP(addrsToFix[i]);
+ finishTrapCatchHandling:
+ ExceptionRangeTarget(envPtr, range, catchOffset);
+ OP( PUSH_RETURN_OPTIONS);
+ OP( PUSH_RETURN_CODE);
+ OP( PUSH_RESULT);
+ OP( END_CATCH);
+ STORE( resultVar);
+ OP( POP);
+ PUSH( "1");
+ OP( EQ);
+ JUMP1( JUMP_FALSE, noTrapError);
+ LOAD( optionsVar);
+ PUSH( "-during");
+ OP4( REVERSE, 3);
+ STORE( optionsVar);
+ OP( POP);
+ OP44( DICT_SET, 1, optionsVar);
+ TclAdjustStackDepth(-1, envPtr);
+ JUMP1( JUMP, trapError);
+ FIXJUMP1( noTrapError);
+ STORE( optionsVar);
+ FIXJUMP1( trapError);
+ /* Skip POP at end; can clean up with subsequent POP */
+ if (i+1 < numHandlers) {
+ OP( POP);
+ } else {
+ TclAdjustStackDepth(-1, envPtr);
+ }
+
+ endOfThisArm:
+ if (i+1 < numHandlers) {
+ JUMP4( JUMP, addrsToFix[i]);
+ }
+ TclAdjustStackDepth(1, envPtr);
+ if (matchClauses[i]) {
+ FIXJUMP4( notECJumpSource);
}
- TclStackFree(interp, forwardsToFix);
- TclStackFree(interp, addrsToFix);
+ FIXJUMP4( notCodeJumpSource);
}
/*
- * Drop the result code.
+ * Drop the result code, and fix all the jumps from taken clauses - which
+ * drop the result code as their first action - to point straight after
+ * (i.e., to the start of the finally clause).
*/
OP( POP);
+ for (i=0 ; i<numHandlers-1 ; i++) {
+ FIXJUMP4( addrsToFix[i]);
+ }
+ TclStackFree(interp, forwardsToFix);
+ TclStackFree(interp, addrsToFix);
/*
* Process the finally clause (at last!) Note that we do not wrap this in
@@ -2637,16 +2739,106 @@ IssueTryFinallyInstructions(
* next command (or some inter-command manipulation).
*/
- envPtr->currStackDepth = savedStackDepth;
+ if (!trapZero) {
+ FIXJUMP4( afterBody);
+ }
+ range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+ OP4( BEGIN_CATCH4, range);
+ ExceptionRangeStarts(envPtr, range);
BODY( finallyToken, 3 + 4*numHandlers);
+ ExceptionRangeEnds(envPtr, range);
+ OP( END_CATCH);
+ OP( POP);
+ JUMP1( JUMP, finalOK);
+ ExceptionRangeTarget(envPtr, range, catchOffset);
+ OP( PUSH_RESULT);
+ OP( PUSH_RETURN_OPTIONS);
+ OP( PUSH_RETURN_CODE);
+ OP( END_CATCH);
+ PUSH( "1");
+ OP( EQ);
+ JUMP1( JUMP_FALSE, noFinalError);
+ LOAD( optionsVar);
+ PUSH( "-during");
+ OP4( REVERSE, 3);
+ STORE( optionsVar);
+ OP( POP);
+ OP44( DICT_SET, 1, optionsVar);
+ TclAdjustStackDepth(-1, envPtr);
+ OP( POP);
+ JUMP1( JUMP, finalError);
+ TclAdjustStackDepth(1, envPtr);
+ FIXJUMP1( noFinalError);
+ STORE( optionsVar);
OP( POP);
+ FIXJUMP1( finalError);
+ STORE( resultVar);
+ OP( POP);
+ FIXJUMP1( finalOK);
LOAD( optionsVar);
LOAD( resultVar);
OP( RETURN_STK);
- envPtr->currStackDepth = savedStackDepth + 1;
return TCL_OK;
}
+
+static int
+IssueTryFinallyInstructions(
+ Tcl_Interp *interp,
+ CompileEnv *envPtr,
+ Tcl_Token *bodyToken,
+ Tcl_Token *finallyToken)
+{
+ DefineLineInformation; /* TIP #280 */
+ int range, jumpOK, jumpSplice;
+
+ /*
+ * Note that this one is simple enough that we can issue it without
+ * needing a local variable table, making it a universal compilation.
+ */
+
+ range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+ OP4( BEGIN_CATCH4, range);
+ ExceptionRangeStarts(envPtr, range);
+ BODY( bodyToken, 1);
+ ExceptionRangeEnds(envPtr, range);
+ OP1( JUMP1, 3);
+ TclAdjustStackDepth(-1, envPtr);
+ ExceptionRangeTarget(envPtr, range, catchOffset);
+ OP( PUSH_RESULT);
+ OP( PUSH_RETURN_OPTIONS);
+ OP( END_CATCH);
+
+ range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+ OP4( BEGIN_CATCH4, range);
+ ExceptionRangeStarts(envPtr, range);
+ BODY( finallyToken, 3);
+ ExceptionRangeEnds(envPtr, range);
+ OP( END_CATCH);
+ OP( POP);
+ JUMP1( JUMP, jumpOK);
+ ExceptionRangeTarget(envPtr, range, catchOffset);
+ OP( PUSH_RESULT);
+ OP( PUSH_RETURN_OPTIONS);
+ OP( PUSH_RETURN_CODE);
+ OP( END_CATCH);
+ PUSH( "1");
+ OP( EQ);
+ JUMP1( JUMP_FALSE, jumpSplice);
+ PUSH( "-during");
+ OP4( OVER, 3);
+ OP4( LIST, 2);
+ OP( LIST_CONCAT);
+ FIXJUMP1( jumpSplice);
+ OP4( REVERSE, 4);
+ OP( POP);
+ OP( POP);
+ OP1( JUMP1, 7);
+ FIXJUMP1( jumpOK);
+ OP4( REVERSE, 2);
+ OP( RETURN_STK);
+ return TCL_OK;
+}
/*
*----------------------------------------------------------------------
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 572f660..c361430 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -383,7 +383,8 @@ InstructionDesc const tclInstructionTable[] = {
/* finds namespace and otherName in stack, links to local variable at
* index op1. Leaves the namespace on stack. */
{"syntax", 9, -1, 2, {OPERAND_INT4, OPERAND_UINT4}},
- /* Compiled bytecodes to signal syntax error. */
+ /* Compiled bytecodes to signal syntax error. Equivalent to returnImm
+ * except for the ERR_ALREADY_LOGGED flag in the interpreter. */
{"reverse", 5, 0, 1, {OPERAND_UINT4}},
/* Reverse the order of the arg elements at the top of stack */
diff --git a/tests/error.test b/tests/error.test
index 97bcc0a..273577a 100644
--- a/tests/error.test
+++ b/tests/error.test
@@ -17,6 +17,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
}
testConstraint memory [llength [info commands memory]]
+customMatch pairwise {apply {{a b} {
+ string equal [lindex $b 0] [lindex $b 1]
+}}}
namespace eval ::tcl::test::error {
if {[testConstraint memory]} {
proc getbytes {} {
@@ -601,21 +604,21 @@ test error-16.7 {try with variable assignment and propagation #2} {
}
list $em [dict get $opts -errorcode]
} {bar FOO}
-test error-16.8 {exception chaining (try=ok, handler=error)} {
+test error-16.8 {exception chaining (try=ok, handler=error)} -body {
#FIXME is the intent of this test correct?
catch {
try { list a b c } on ok {em opts} { throw BAR baz }
} tryem tryopts
- string equal $opts [dict get $tryopts -during]
-} {1}
-test error-16.9 {exception chaining (try=error, handler=error)} {
+ list $opts [dict get $tryopts -during]
+} -match pairwise -result equal
+test error-16.9 {exception chaining (try=error, handler=error)} -body {
# The exception off the handler should chain to the exception off the
# try-body (using the -during option)
catch {
try { throw FOO bar } trap {} {em opts} { throw BAR baz }
} tryem tryopts
- string equal $opts [dict get $tryopts -during]
-} {1}
+ list $opts [dict get $tryopts -during]
+} -match pairwise -result equal
test error-16.10 {no exception chaining when handler is successful} {
catch {
try { throw FOO bar } trap {} {em opts} { list d e f }
@@ -628,6 +631,131 @@ test error-16.11 {no exception chaining when handler is a non-error exception} {
} tryem tryopts
dict exists $tryopts -during
} {0}
+test error-16.12 {compiled try with successfully executed handler} {
+ apply {{} {
+ try { throw FOO bar } trap FOO {} { list a b c }
+ }}
+} {a b c}
+test error-16.13 {compiled try with exception (error) in handler} -body {
+ apply {{} {
+ try { throw FOO bar } trap FOO {} { throw BAR foo }
+ }}
+} -returnCodes error -result {foo}
+test error-16.14 {compiled try with exception (return) in handler} -body {
+ apply {{} {
+ list [catch {
+ try { throw FOO bar } trap FOO {} { return BAR }
+ } msg] $msg
+ }}
+} -result {2 BAR}
+test error-16.15 {compiled try with exception (break) in handler} {
+ apply {{} {
+ for { set i 5 } { $i < 10 } { incr i } {
+ try { throw FOO bar } trap FOO {} { break }
+ }
+ return $i
+ }}
+} {5}
+test error-16.16 {compiled try with exception (continue) in handler} {
+ apply {{} {
+ for { set i 5 } { $i < 10 } { incr i } {
+ try { throw FOO bar } trap FOO {} { continue }
+ incr i 20
+ }
+ return $i
+ }}
+} {10}
+test error-16.17 {compiled try with variable assignment and propagation #1} {
+ # Ensure that the handler variables preserve the exception off the
+ # try-body, and are not modified by the exception off the handler
+ apply {{} {
+ catch {
+ try { throw FOO bar } trap FOO {em} { throw BAR baz }
+ }
+ return $em
+ }}
+} {bar}
+test error-16.18 {compiled try with variable assignment and propagation #2} {
+ apply {{} {
+ catch {
+ try { throw FOO bar } trap FOO {em opts} { throw BAR baz }
+ }
+ list $em [dict get $opts -errorcode]
+ }}
+} {bar FOO}
+test error-16.19 {compiled try exception chaining (try=ok, handler=error)} -body {
+ #FIXME is the intent of this test correct?
+ apply {{} {
+ catch {
+ try { list a b c } on ok {em opts} { throw BAR baz }
+ } tryem tryopts
+ list $opts [dict get $tryopts -during]
+ }}
+} -match pairwise -result equal
+test error-16.20 {compiled try exception chaining (try=error, handler=error)} -body {
+ # The exception off the handler should chain to the exception off the
+ # try-body (using the -during option)
+ apply {{} {
+ catch {
+ try { throw FOO bar } trap {} {em opts} { throw BAR baz }
+ } tryem tryopts
+ list $opts [dict get $tryopts -during]
+ }}
+} -match pairwise -result equal
+test error-16.21 {compiled try exception chaining (try=error, finally=error)} {
+ # The exception off the handler should chain to the exception off the
+ # try-body (using the -during option)
+ apply {{} {
+ catch {
+ try { throw FOO bar } finally { throw BAR baz }
+ } tryem tryopts
+ dict get $tryopts -during -errorcode
+ }}
+} FOO
+test error-16.22 {compiled try: no exception chaining when handler is successful} {
+ apply {{} {
+ catch {
+ try { throw FOO bar } trap {} {em opts} { list d e f }
+ } tryem tryopts
+ dict exists $tryopts -during
+ }}
+} {0}
+test error-16.23 {compiled try: no exception chaining when handler is a non-error exception} {
+ apply {{} {
+ catch {
+ try { throw FOO bar } trap {} {em opts} { break }
+ } tryem tryopts
+ dict exists $tryopts -during
+ }}
+} {0}
+test error-16.24 {compiled try exception chaining (try=ok, handler=error, finally=error)} -body {
+ apply {{} {
+ catch {
+ try {
+ list a b c
+ } on ok {em opts} {
+ throw BAR baz
+ } finally {
+ throw DING dong
+ }
+ } tryem tryopts
+ list $opts [dict get $tryopts -during -during]
+ }}
+} -match pairwise -result equal
+test error-16.25 {compiled try exception chaining (all errors)} -body {
+ apply {{} {
+ catch {
+ try {
+ throw FOO bar
+ } on error {em opts} {
+ throw BAR baz
+ } finally {
+ throw DING dong
+ }
+ } tryem tryopts
+ list $opts [dict get $tryopts -during -during]
+ }}
+} -match pairwise -result equal
# try tests - finally
@@ -709,15 +837,15 @@ test error-18.5 {exception in finally doesn't affect variable assignment} {
}
list $em [dict get $opts -errorcode]
} {bar FOO}
-test error-18.6 {exception chaining in finally (try=ok)} {
+test error-18.6 {exception chaining in finally (try=ok)} -body {
catch {
list a b c
} em expopts
catch {
try { list a b c } finally { throw BAR foo }
} em opts
- string equal $expopts [dict get $opts -during]
-} {1}
+ list $expopts [dict get $opts -during]
+} -match pairwise -result equal
test error-18.7 {exception chaining in finally (try=error)} {
catch {
try { throw FOO bar } finally { throw BAR baz }