diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2013-12-12 09:13:39 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2013-12-12 09:13:39 (GMT) |
commit | 6665e28f718ef3c403652ca551b6cadd3a3318aa (patch) | |
tree | 0452907d177676bbc3258a647e4f3a616961101a /generic/tclCompCmds.c | |
parent | 66b561ac5eb7ff1750f8003c6a14a2c7ae52963b (diff) | |
parent | 2b1bafdd8a2fca08d2d7b57f68cc803f83dba72e (diff) | |
download | tcl-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.c | 91 |
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; } |