* generic/tclBasic.c (Tcl_CreateInterp,Tcl_DeleteInterp):

        * generic/tclCmdAH.c (Tcl_CatchObjCmd):
        * generic/tclCmdMZ.c (TclMergeReturnOptions,TclProcessReturn):
        * generic/tclCompCmds.c (TclCompileReturnCmd):
        * generic/tclExecute.c (TclCompEvalObj):
        * generic/tclInt.h (Interp):
        * generic/tclProc.c (TclUpdateReturnInfo):
        Place primary storage of the -level and -code information in private
        fields of the Interp struct, rather than in a DictObj.  This should
        significantly improve performance of TclUpdateReturnInfo.

1 files changed, 10 insertions, 23 deletions

diff --git a/generic/tclProc.c b/generic/tclProc.c
index 3756024..9ce8706 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclProc.c,v 1.61 2004/10/15 21:02:36 dgp Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.62 2004/10/18 21:15:42 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -1430,16 +1430,15 @@ TclProcCleanupProc(procPtr)
  * TclUpdateReturnInfo --
  *
  *	This procedure is called when procedures return, and at other
- *	points where the TCL_RETURN code is used.  It examines values
- *	stored in the iPtr->returnOpts dictionary and modifies
- *	the real return status accordingly.
+ *	points where the TCL_RETURN code is used.  It examines the
+ *	returnLevel and returnCode to determine the real return status.
  *
  * Results:
  *	The return value is the true completion code to use for
- *	the procedure, instead of TCL_RETURN.
+ *	the procedure or script, instead of TCL_RETURN.
  *
  * Side effects:
- *	The errorInfo and errorCode fields may get set.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
@@ -1449,27 +1448,15 @@ TclUpdateReturnInfo(iPtr)
     Interp *iPtr;		/* Interpreter for which TCL_RETURN
 				 * exception is being processed. */
 {
-    int level, code = TCL_RETURN;
-    Tcl_Obj *valuePtr;
+    int code = TCL_RETURN;
 
-    Tcl_DictObjGet(NULL, iPtr->returnOpts, iPtr->returnLevelKey, &valuePtr);
-    Tcl_GetIntFromObj(NULL, valuePtr, &level);
-    level--;
-    if (level < 0) {
+    iPtr->returnLevel--;
+    if (iPtr->returnLevel < 0) {
 	Tcl_Panic("TclUpdateReturnInfo: negative return level");
     }
-    if (Tcl_IsShared(iPtr->returnOpts)) {
-	Tcl_DecrRefCount(iPtr->returnOpts);
-	iPtr->returnOpts = Tcl_DuplicateObj(iPtr->returnOpts);
-	Tcl_IncrRefCount(iPtr->returnOpts);
-    }
-    Tcl_DictObjPut(NULL, iPtr->returnOpts,
-	    iPtr->returnLevelKey, Tcl_NewIntObj(level));
-
-    if (level == 0) {
+    if (iPtr->returnLevel == 0) {
 	/* Now we've reached the level to return the requested -code */
-	Tcl_DictObjGet(NULL, iPtr->returnOpts, iPtr->returnCodeKey, &valuePtr);
-	Tcl_GetIntFromObj(NULL, valuePtr, &code);
+	return iPtr->returnCode;
     }
     return code;
 }