diff options
Diffstat (limited to 'generic/tclProc.c')
| -rw-r--r-- | generic/tclProc.c | 33 |
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; } |