using the new variable name caching possibilities when setting error

results in (Tcl_AddObjErrorInfo) and (TclUpdateReturnInfo)

5 files changed, 41 insertions, 16 deletions

diff --git a/ChangeLog b/ChangeLog
index 10f21e5..566cc0f 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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;
 	}
     }