summaryrefslogtreecommitdiffstats
path: root/generic/tclCompCmds.c
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2005-06-20 21:27:03 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2005-06-20 21:27:03 (GMT)
commit0274a89c20d0e377adddaee757e45facd7247d87 (patch)
treea39aeb7142a3410949583a9ba25510d6ed50ef34 /generic/tclCompCmds.c
parent534bef21225845450d07b9de68a8f6add62561f3 (diff)
downloadtcl-0274a89c20d0e377adddaee757e45facd7247d87.zip
tcl-0274a89c20d0e377adddaee757e45facd7247d87.tar.gz
tcl-0274a89c20d0e377adddaee757e45facd7247d87.tar.bz2
Add compilation for TIP#90-style [catch] requiring a new opcode [Bug1219112]
Diffstat (limited to 'generic/tclCompCmds.c')
-rw-r--r--generic/tclCompCmds.c98
1 files changed, 71 insertions, 27 deletions
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index be74f2a..aefd8e3 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.73 2005/06/20 10:01:47 dkf Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.74 2005/06/20 21:27:09 dkf Exp $
*/
#include "tclInt.h"
@@ -264,50 +264,65 @@ TclCompileCatchCmd(interp, parsePtr, envPtr)
CompileEnv *envPtr; /* Holds resulting instructions. */
{
JumpFixup jumpFixup;
- Tcl_Token *cmdTokenPtr, *nameTokenPtr;
+ Tcl_Token *cmdTokenPtr, *resultNameTokenPtr, *optsNameTokenPtr;
CONST char *name;
- int localIndex, nameChars, range, startOffset;
+ int resultIndex, optsIndex, nameChars, range, startOffset;
int savedStackDepth = envPtr->currStackDepth;
/*
* If syntax does not match what we expect for [catch], do not compile.
* Let runtime checks determine if syntax has changed.
*/
- if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
+ if ((parsePtr->numWords < 2) && (parsePtr->numWords > 4)) {
return TCL_ERROR;
}
/*
- * If a variable was specified and the catch command is at global level
+ * If variables were specified and the catch command is at global level
* (not in a procedure), don't compile it inline: the payoff is too small.
*/
- if ((parsePtr->numWords == 3) && (envPtr->procPtr == NULL)) {
+ if ((parsePtr->numWords >= 3) && (envPtr->procPtr == NULL)) {
return TCL_ERROR;
}
/*
- * Make sure the variable name, if any, has no substitutions and just
- * refers to a local scaler.
+ * Make sure the variable names, if any, have no substitutions and just
+ * refer to local scalars.
*/
- localIndex = -1;
+ resultIndex = optsIndex = -1;
cmdTokenPtr = TokenAfter(parsePtr->tokenPtr);
- if (parsePtr->numWords == 3) {
- nameTokenPtr = TokenAfter(cmdTokenPtr);
+ if (parsePtr->numWords >= 3) {
+ resultNameTokenPtr = TokenAfter(cmdTokenPtr);
/* DGP */
- if (nameTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
- name = nameTokenPtr[1].start;
- nameChars = nameTokenPtr[1].size;
+ if (resultNameTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+ name = resultNameTokenPtr[1].start;
+ nameChars = resultNameTokenPtr[1].size;
if (!TclIsLocalScalar(name, nameChars)) {
return TCL_ERROR;
}
- localIndex = TclFindCompiledLocal(nameTokenPtr[1].start,
- nameTokenPtr[1].size, /*create*/ 1, VAR_SCALAR,
+ resultIndex = TclFindCompiledLocal(resultNameTokenPtr[1].start,
+ resultNameTokenPtr[1].size, /*create*/ 1, VAR_SCALAR,
envPtr->procPtr);
} else {
return TCL_ERROR;
}
+ /* DKF */
+ if (parsePtr->numWords == 4) {
+ optsNameTokenPtr = TokenAfter(resultNameTokenPtr);
+ if (optsNameTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ return TCL_ERROR;
+ }
+ name = optsNameTokenPtr[1].start;
+ nameChars = optsNameTokenPtr[1].size;
+ if (!TclIsLocalScalar(name, nameChars)) {
+ return TCL_ERROR;
+ }
+ optsIndex = TclFindCompiledLocal(optsNameTokenPtr[1].start,
+ optsNameTokenPtr[1].size, /*create*/ 1, VAR_SCALAR,
+ envPtr->procPtr);
+ }
}
/*
@@ -346,14 +361,31 @@ TclCompileCatchCmd(interp, parsePtr, 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" result,
- * and jump around the "error case" code.
+ * and jump around the "error case" code. Note that we issue the push of
+ * the return options first so that if alterations happen to the current
+ * interpreter state during the writing of the variable, we won't see
+ * them; this results in a slightly complex instruction issuing flow
+ * (can't exchange, only duplicate and pop).
*/
- if (localIndex != -1) {
- if (localIndex <= 255) {
- TclEmitInstInt1(INST_STORE_SCALAR1, localIndex, envPtr);
+ if (resultIndex != -1) {
+ if (optsIndex != -1) {
+ TclEmitOpcode(INST_PUSH_RETURN_OPTIONS, envPtr);
+ TclEmitInstInt4(INST_OVER, 1, envPtr);
+ }
+ if (resultIndex <= 255) {
+ TclEmitInstInt1(INST_STORE_SCALAR1, resultIndex, envPtr);
} else {
- TclEmitInstInt4(INST_STORE_SCALAR4, localIndex, envPtr);
+ TclEmitInstInt4(INST_STORE_SCALAR4, resultIndex, envPtr);
+ }
+ if (optsIndex != -1) {
+ TclEmitOpcode(INST_POP, envPtr);
+ if (optsIndex <= 255) {
+ TclEmitInstInt1(INST_STORE_SCALAR1, optsIndex, envPtr);
+ } else {
+ TclEmitInstInt4(INST_STORE_SCALAR4, optsIndex, envPtr);
+ }
+ TclEmitOpcode(INST_POP, envPtr);
}
}
TclEmitOpcode(INST_POP, envPtr);
@@ -363,23 +395,35 @@ TclCompileCatchCmd(interp, parsePtr, envPtr)
/*
* The "error case" code: store the body's result into the variable (if
* any), then push the error result code. The initial PC offset here is
- * the catch's error target.
+ * the catch's error target. Note that if we are saving the return
+ * options, we do that first so the preservation cannot get affected by
+ * any intermediate result handling.
*/
envPtr->currStackDepth = savedStackDepth;
envPtr->exceptArrayPtr[range].catchOffset = CurrentOffset(envPtr);
- if (localIndex != -1) {
+ if (resultIndex != -1) {
+ if (optsIndex != -1) {
+ TclEmitOpcode(INST_PUSH_RETURN_OPTIONS, envPtr);
+ }
TclEmitOpcode(INST_PUSH_RESULT, envPtr);
- if (localIndex <= 255) {
- TclEmitInstInt1(INST_STORE_SCALAR1, localIndex, envPtr);
+ if (resultIndex <= 255) {
+ TclEmitInstInt1(INST_STORE_SCALAR1, resultIndex, envPtr);
} else {
- TclEmitInstInt4(INST_STORE_SCALAR4, localIndex, envPtr);
+ TclEmitInstInt4(INST_STORE_SCALAR4, resultIndex, envPtr);
}
TclEmitOpcode(INST_POP, envPtr);
+ if (optsIndex != -1) {
+ if (optsIndex <= 255) {
+ TclEmitInstInt1(INST_STORE_SCALAR1, optsIndex, envPtr);
+ } else {
+ TclEmitInstInt4(INST_STORE_SCALAR4, optsIndex, envPtr);
+ }
+ TclEmitOpcode(INST_POP, envPtr);
+ }
}
TclEmitOpcode(INST_PUSH_RETURN_CODE, envPtr);
-
/*
* Update the target of the jump after the "no errors" code, then emit an
* endCatch instruction at the end of the catch command.