diff options
| -rw-r--r-- | ChangeLog | 12 | ||||
| -rw-r--r-- | generic/tclBasic.c | 18 | ||||
| -rw-r--r-- | generic/tclExecute.c | 10 | ||||
| -rw-r--r-- | generic/tclInt.h | 4 | ||||
| -rw-r--r-- | generic/tclProc.c | 13 |
5 files changed, 41 insertions, 16 deletions
@@ -1,5 +1,17 @@ 2002-07-15 Miguel Sofer <msofer@users.sourceforge.net> + * generic/tclBasic.c (Tcl_AddObjErrorInfo): + * generic/tclExecute.c (TclUpdateReturnInfo): + * generic/tclInt.h: + * generic/tclProc.c: + Added two Tcl_Obj to the ExecEnv structure to hold the fully + qualified names "::errorInfo" and "::errorCode" to cache the + addresses of the corresponding variables. The two most frequent + setters of these variables now profit from the new variable name + caching. + +2002-07-15 Miguel Sofer <msofer@users.sourceforge.net> + * generic/tclVar.c: refactorisation to reuse already looked-up Var pointers; definition of three new Tcl_Obj types to cache variable name parsing and lookup for later reuse; modification of internal diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 578b26f..b60a6c3 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclBasic.c,v 1.62 2002/06/20 16:41:30 msofer Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.63 2002/07/16 01:12:50 msofer Exp $ */ #include "tclInt.h" @@ -5084,11 +5084,11 @@ Tcl_AddObjErrorInfo(interp, message, length) iPtr->flags |= ERR_IN_PROGRESS; if (iPtr->result[0] == 0) { - (void) Tcl_SetVar2Ex(interp, "errorInfo", NULL, iPtr->objResultPtr, - TCL_GLOBAL_ONLY); + Tcl_ObjSetVar2(interp, iPtr->execEnvPtr->errorInfo, NULL, + iPtr->objResultPtr, TCL_GLOBAL_ONLY); } else { /* use the string result */ - Tcl_SetVar2(interp, "errorInfo", (char *) NULL, interp->result, - TCL_GLOBAL_ONLY); + Tcl_ObjSetVar2(interp, iPtr->execEnvPtr->errorInfo, NULL, + Tcl_NewStringObj(interp->result, -1), TCL_GLOBAL_ONLY); } /* @@ -5097,8 +5097,8 @@ Tcl_AddObjErrorInfo(interp, message, length) */ if (!(iPtr->flags & ERROR_CODE_SET)) { - (void) Tcl_SetVar2(interp, "errorCode", (char *) NULL, "NONE", - TCL_GLOBAL_ONLY); + Tcl_ObjSetVar2(interp, iPtr->execEnvPtr->errorCode, NULL, + Tcl_NewStringObj("NONE", -1), TCL_GLOBAL_ONLY); } } @@ -5109,8 +5109,8 @@ Tcl_AddObjErrorInfo(interp, message, length) if (length != 0) { messagePtr = Tcl_NewStringObj(message, length); Tcl_IncrRefCount(messagePtr); - Tcl_SetVar2Ex(interp, "errorInfo", NULL, messagePtr, - (TCL_GLOBAL_ONLY | TCL_APPEND_VALUE)); + Tcl_ObjSetVar2(interp, iPtr->execEnvPtr->errorInfo, NULL, + messagePtr, (TCL_GLOBAL_ONLY | TCL_APPEND_VALUE)); Tcl_DecrRefCount(messagePtr); /* free msg object appended above */ } } diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 1375b20..024509e 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.76 2002/07/10 08:25:59 dkf Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.77 2002/07/16 01:12:50 msofer Exp $ */ #include "tclInt.h" @@ -514,6 +514,12 @@ TclCreateExecEnv(interp) eePtr->stackTop = -1; eePtr->stackEnd = (TCL_STACK_INITIAL_SIZE - 1); + eePtr->errorInfo = Tcl_NewStringObj("::errorInfo", -1); + Tcl_IncrRefCount(eePtr->errorInfo); + + eePtr->errorCode = Tcl_NewStringObj("::errorCode", -1); + Tcl_IncrRefCount(eePtr->errorCode); + Tcl_MutexLock(&execMutex); if (!execInitialized) { TclInitAuxDataTypeTable(); @@ -548,6 +554,8 @@ TclDeleteExecEnv(eePtr) ExecEnv *eePtr; /* Execution environment to free. */ { Tcl_EventuallyFree((ClientData)eePtr->stackPtr, TCL_DYNAMIC); + TclDecrRefCount(eePtr->errorInfo); + TclDecrRefCount(eePtr->errorCode); ckfree((char *) eePtr); } diff --git a/generic/tclInt.h b/generic/tclInt.h index 5604129..6a891e0 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInt.h,v 1.98 2002/07/15 22:18:04 msofer Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.99 2002/07/16 01:12:50 msofer Exp $ */ #ifndef _TCLINT @@ -910,6 +910,8 @@ typedef struct ExecEnv { int stackTop; /* Index of current top of stack; -1 when * the stack is empty. */ int stackEnd; /* Index of last usable item in stack. */ + Tcl_Obj *errorInfo; + Tcl_Obj *errorCode; } ExecEnv; /* diff --git a/generic/tclProc.c b/generic/tclProc.c index 91d6714..4c656b4 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.38 2002/07/11 12:39:16 msofer Exp $ + * RCS: @(#) $Id: tclProc.c,v 1.39 2002/07/16 01:12:50 msofer Exp $ */ #include "tclInt.h" @@ -1421,17 +1421,20 @@ TclUpdateReturnInfo(iPtr) * exception is being processed. */ { int code; + char *errorCode; code = iPtr->returnCode; iPtr->returnCode = TCL_OK; if (code == TCL_ERROR) { - Tcl_SetVar2((Tcl_Interp *) iPtr, "errorCode", (char *) NULL, - (iPtr->errorCode != NULL) ? iPtr->errorCode : "NONE", + errorCode = ((iPtr->errorCode != NULL) ? iPtr->errorCode : "NONE"); + Tcl_ObjSetVar2((Tcl_Interp *) iPtr, iPtr->execEnvPtr->errorCode, + NULL, Tcl_NewStringObj(errorCode, -1), TCL_GLOBAL_ONLY); iPtr->flags |= ERROR_CODE_SET; if (iPtr->errorInfo != NULL) { - Tcl_SetVar2((Tcl_Interp *) iPtr, "errorInfo", (char *) NULL, - iPtr->errorInfo, TCL_GLOBAL_ONLY); + Tcl_ObjSetVar2((Tcl_Interp *) iPtr, iPtr->execEnvPtr->errorInfo, + NULL, Tcl_NewStringObj(iPtr->errorInfo, -1), + TCL_GLOBAL_ONLY); iPtr->flags |= ERR_IN_PROGRESS; } } |