summaryrefslogtreecommitdiffstats
path: root/generic/tclExecute.c
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2004-01-13 23:15:02 (GMT)
committerdgp <dgp@users.sourceforge.net>2004-01-13 23:15:02 (GMT)
commitc9bd8ac5b1219903842bb5ad5e3f52220aa60701 (patch)
treef2698cb54a86867e9b452e99687cf78e827059d2 /generic/tclExecute.c
parent09c3e3c827f50de5bf0960ebae0ba665da9a0a77 (diff)
downloadtcl-c9bd8ac5b1219903842bb5ad5e3f52220aa60701.zip
tcl-c9bd8ac5b1219903842bb5ad5e3f52220aa60701.tar.gz
tcl-c9bd8ac5b1219903842bb5ad5e3f52220aa60701.tar.bz2
Patch 876451: restores performance of [return]. Also allows forms
such as [return -code error $msg] to be bytecompiled. * generic/tclInt.h: Factored Tcl_ReturnObjCmd() into two pieces: * generic/tclCmdMZ.c: TclMergeReturnOptions(), which can parse the options to [return], check their validity, and create the corresponding return options dictionary, and TclProcessReturn(), which takes that return options dictionary and performs the [return] operation. * generic/tclCompCmds.c: Rewrote TclCompileReturnCmd() to call TclMergeReturnOptions() at compile time so the return options dictionary is computed at compile time (when it is fully known). The dictionary is pushed on the stack along with the result, and the code and level values are included in the bytecode as operands. Also supports optimized compilation of un-[catch]ed [return]s from procs with default options into the INST_DONE instruction. * generic/tclExecute.c: Rewrote INST_RETURN instruction to retrieve the code and level operands, pop the return options from the stack, and call TclProcessReturn() to perform the [return] operation. * generic/tclCompile.h: New utilities include TclEmitInt4 macro * generic/tclCompile.c: and TclWordKnownAtCompileTime().
Diffstat (limited to 'generic/tclExecute.c')
-rw-r--r--generic/tclExecute.c23
1 files changed, 17 insertions, 6 deletions
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 61d444b..84e5aee 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclExecute.c,v 1.119 2004/01/12 03:23:31 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.120 2004/01/13 23:15:03 dgp Exp $
*/
#include "tclInt.h"
@@ -1231,12 +1231,23 @@ TclExecuteByteCode(interp, codePtr)
switch (*pc) {
case INST_RETURN:
- if (iPtr->returnOpts != iPtr->defaultReturnOpts) {
- Tcl_DecrRefCount(iPtr->returnOpts);
- iPtr->returnOpts = iPtr->defaultReturnOpts;
- Tcl_IncrRefCount(iPtr->returnOpts);
+ {
+ int code = TclGetInt4AtPtr(pc+1);
+ int level = TclGetUInt4AtPtr(pc+5);
+ Tcl_Obj *returnOpts = POP_OBJECT();
+
+ DECACHE_STACK_INFO();
+ Tcl_ResetResult(interp);
+ result = TclProcessReturn(interp, code, level, returnOpts);
+ CACHE_STACK_INFO();
+ Tcl_DecrRefCount(returnOpts);
+ if (result != TCL_OK) {
+ Tcl_SetObjResult(interp, *tosPtr);
+ cleanup = 1;
+ goto processExceptionReturn;
+ }
+ NEXT_INST_F(9, 0, 0);
}
- result = TCL_RETURN;
case INST_DONE:
if (tosPtr <= eePtr->stackPtr + initStackTop) {