summaryrefslogtreecommitdiffstats
path: root/generic/tclCompCmds.c
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2013-12-12 09:13:39 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2013-12-12 09:13:39 (GMT)
commit6665e28f718ef3c403652ca551b6cadd3a3318aa (patch)
tree0452907d177676bbc3258a647e4f3a616961101a /generic/tclCompCmds.c
parent66b561ac5eb7ff1750f8003c6a14a2c7ae52963b (diff)
parent2b1bafdd8a2fca08d2d7b57f68cc803f83dba72e (diff)
downloadtcl-6665e28f718ef3c403652ca551b6cadd3a3318aa.zip
tcl-6665e28f718ef3c403652ca551b6cadd3a3318aa.tar.gz
tcl-6665e28f718ef3c403652ca551b6cadd3a3318aa.tar.bz2
merge trunk; document added instructions
Diffstat (limited to 'generic/tclCompCmds.c')
-rw-r--r--generic/tclCompCmds.c91
1 files changed, 18 insertions, 73 deletions
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 3542838..d027f1c 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -589,11 +589,7 @@ TclCompileCatchCmd(
/*
* We will compile the catch command. Declare the exception range that it
* uses.
- */
-
- range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
-
- /*
+ *
* If the body is a simple word, compile a BEGIN_CATCH instruction,
* followed by the instructions to eval the body.
* Otherwise, compile instructions to substitute the body text before
@@ -606,6 +602,7 @@ TclCompileCatchCmd(
* begin by undeflowing the stack below the mark set by BEGIN_CATCH4.
*/
+ range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr);
ExceptionRangeStarts(envPtr, range);
@@ -617,37 +614,11 @@ TclCompileCatchCmd(
ExceptionRangeStarts(envPtr, range);
TclEmitOpcode( INST_DUP, envPtr);
TclEmitInvoke(envPtr, INST_EVAL_STK);
- }
- /* Stack at this point:
- * nonsimple: script <mark> result
- * simple: <mark> result
- */
-
- if (resultIndex == -1) {
- /*
- * Special case when neither result nor options are being saved. In
- * that case, we can skip quite a bit of the command epilogue; all we
- * have to do is drop the result and push the return code (and, of
- * course, finish the catch context).
- */
-
+ /* drop the script */
+ TclEmitInstInt4( INST_REVERSE, 2, envPtr);
TclEmitOpcode( INST_POP, envPtr);
- PushStringLiteral(envPtr, "0");
- TclEmitInstInt1( INST_JUMP1, 3, envPtr);
- TclAdjustStackDepth(-1, envPtr);
- ExceptionRangeTarget(envPtr, range, catchOffset);
- TclEmitOpcode( INST_PUSH_RETURN_CODE, envPtr);
- ExceptionRangeEnds(envPtr, range);
- TclEmitOpcode( INST_END_CATCH, envPtr);
-
- /*
- * Stack at this point:
- * nonsimple: script <mark> returnCode
- * simple: <mark> returnCode
- */
-
- goto dropScriptAtEnd;
}
+ ExceptionRangeEnds(envPtr, range);
/*
* Emit the "no errors" epilogue: push "0" (TCL_OK) as the catch result,
@@ -656,7 +627,6 @@ TclCompileCatchCmd(
PushStringLiteral(envPtr, "0");
TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
- /* Stack at this point: ?script? <mark> result TCL_OK */
/*
* Emit the "error case" epilogue. Push the interpreter result and the
@@ -665,22 +635,20 @@ TclCompileCatchCmd(
TclAdjustStackDepth(-2, envPtr);
ExceptionRangeTarget(envPtr, range, catchOffset);
- /* Stack at this point: ?script? */
+ /* Stack at this point is empty */
TclEmitOpcode( INST_PUSH_RESULT, envPtr);
TclEmitOpcode( INST_PUSH_RETURN_CODE, envPtr);
- /*
- * Update the target of the jump after the "no errors" code.
- */
+ /* Stack at this point on both branches: result returnCode */
- /* Stack at this point: ?script? result returnCode */
if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
Tcl_Panic("TclCompileCatchCmd: bad jump distance %d",
(int)(CurrentOffset(envPtr) - jumpFixup.codeOffset));
}
/*
- * Push the return options if the caller wants them.
+ * Push the return options if the caller wants them. This needs to happen
+ * before INST_END_CATCH
*/
if (optsIndex != -1) {
@@ -691,52 +659,29 @@ TclCompileCatchCmd(
* End the catch
*/
- ExceptionRangeEnds(envPtr, range);
TclEmitOpcode( INST_END_CATCH, envPtr);
/*
- * At this point, the top of the stack is inconveniently ordered:
- * ?script? result returnCode ?returnOptions?
- * Reverse the stack to bring the result to the top.
- */
-
- if (optsIndex != -1) {
- TclEmitInstInt4( INST_REVERSE, 3, envPtr);
- } else {
- TclEmitInstInt4( INST_REVERSE, 2, envPtr);
- }
-
- /*
- * Store the result and remove it from the stack.
- */
-
- Emit14Inst( INST_STORE_SCALAR, resultIndex, envPtr);
- TclEmitOpcode( INST_POP, envPtr);
-
- /*
- * Stack is now ?script? ?returnOptions? returnCode.
- * If the options dict has been requested, it is buried on the stack under
- * the return code. Reverse the stack to bring it to the top, store it and
- * remove it from the stack.
+ * Save the result and return options if the caller wants them. This needs
+ * to happen after INST_END_CATCH (compile-3.6/7).
*/
if (optsIndex != -1) {
- TclEmitInstInt4( INST_REVERSE, 2, envPtr);
Emit14Inst( INST_STORE_SCALAR, optsIndex, envPtr);
TclEmitOpcode( INST_POP, envPtr);
}
- dropScriptAtEnd:
-
/*
- * Stack is now ?script? result. Get rid of the subst'ed script if it's
- * hanging arond.
+ * At this point, the top of the stack is inconveniently ordered:
+ * result returnCode
+ * Reverse the stack to store the result.
*/
- if (cmdTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- TclEmitInstInt4( INST_REVERSE, 2, envPtr);
- TclEmitOpcode( INST_POP, envPtr);
+ TclEmitInstInt4( INST_REVERSE, 2, envPtr);
+ if (resultIndex != -1) {
+ Emit14Inst( INST_STORE_SCALAR, resultIndex, envPtr);
}
+ TclEmitOpcode( INST_POP, envPtr);
return TCL_OK;
}