Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcl/tcl/ChangeLog,v
retrieving revision 1.2282
diff -u -r1.2282 ChangeLog
--- ChangeLog	5 Oct 2004 15:45:00 -0000	1.2282
+++ ChangeLog	5 Oct 2004 18:03:46 -0000
@@ -1,5 +1,28 @@
 2004-10-05  Don Porter  <dgp@users.sourceforge.net>
 
+	* generic/tclBasic.c (Tcl_CreateInterp,Tcl_DeleteInterp,
+		TclEvalObjvInternal,Tcl_LogCommandInfo):
+	* generic/tclCmdAH.c (Tcl_CatchObjCmd):
+	* generic/tclEvent.c (BgError,Tcl_BackgroundError,HandleBgErrors):
+	* generic/tclInt.h (Interp, ERROR_CODE_SET):
+	* generic/tclNamesp.c
+		(Tcl_CreateNamespace,Tcl_DeleteNamespace,TclTeardownNamespace):
+	* generic/tclResult.c
+		(Tcl_ResetResult,Tcl_SetObjErrorCode,TclTransferResult):
+	* generic/tclTrace.c (CallVarTraces):
+	Reworked management of the "errorCode" data of an interp.
+	That information is now primarily stored in a new private
+	(Tcl_Obj *) field of the Interp struct, rather than using a
+	global variable ::errorCode as the primary storage.  The
+	ERROR_CODE_SET flag bit value is no longer required to manage
+	the value in its new location, and is removed.  Variable traces
+	are established to support compatibility for any code expecting
+	the ::errorCode variable to hold the information.
+
+	***POTENTIAL INCOMPATIBILITY***
+	Code that sets traces on the ::errorCode value may notice a
+	difference in timing of the firing of those traces.
+
 	* generic/tclNamesp.c (Tcl_PopCallFrame):	Removed Bug 1038021
 	workaround.  That bug is now fixed.
 
Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.122
diff -u -r1.122 tclBasic.c
--- generic/tclBasic.c	1 Oct 2004 03:19:56 -0000	1.122
+++ generic/tclBasic.c	5 Oct 2004 18:03:47 -0000
@@ -241,6 +241,7 @@
     Tcl_IncrRefCount(iPtr->defaultReturnOpts);
     iPtr->returnOpts = iPtr->defaultReturnOpts;
     Tcl_IncrRefCount(iPtr->returnOpts);
+    iPtr->errorCode = NULL;
 
     iPtr->appendResult = NULL;
     iPtr->appendAvl = 0;
@@ -426,30 +427,6 @@
 
     TclInterpInit(interp);
 
-    /*
-     * We used to create the "errorInfo" and "errorCode" global vars at this
-     * point because so much of the Tcl implementation assumes they already
-     * exist. This is not quite enough, however, since they can be unset
-     * at any time.
-     *
-     * There are 2 choices:
-     *    + Check every place where a GetVar of those is used 
-     *      and the NULL result is not checked (like in tclLoad.c)
-     *    + Make SetVar,... NULL friendly
-     * We choose the second option because :
-     *    + It is easy and low cost to check for NULL pointer before
-     *      calling strlen()
-     *    + It can be helpfull to other people using those API
-     *    + Passing a NULL value to those closest 'meaning' is empty string
-     *      (specially with the new objects where 0 bytes strings are ok)
-     * So the following init is commented out:              -- dl
-     *
-     * (void) Tcl_SetVar2((Tcl_Interp *)iPtr, "errorInfo", (char *) NULL,
-     *       "", TCL_GLOBAL_ONLY);
-     * (void) Tcl_SetVar2((Tcl_Interp *)iPtr, "errorCode", (char *) NULL,
-     *       "NONE", TCL_GLOBAL_ONLY);
-     */
-
 #ifndef TCL_GENERIC_ONLY
     TclSetupEnv(interp);
 #endif
@@ -1005,6 +982,10 @@
     interp->result = NULL;
     Tcl_DecrRefCount(iPtr->objResultPtr);
     iPtr->objResultPtr = NULL;
+    if (iPtr->errorCode) {
+	Tcl_DecrRefCount(iPtr->errorCode);
+	iPtr->errorCode = NULL;
+    }
     Tcl_DecrRefCount(iPtr->returnOpts);
     Tcl_DecrRefCount(iPtr->defaultReturnOpts);
     Tcl_DecrRefCount(iPtr->returnCodeKey);
@@ -3088,8 +3069,12 @@
      */
     if (!(cmdPtr->flags & CMD_IS_DELETED)) {
 	int saveErrFlags = iPtr->flags
-		& (ERR_IN_PROGRESS | ERR_ALREADY_LOGGED | ERROR_CODE_SET);
+		& (ERR_IN_PROGRESS | ERR_ALREADY_LOGGED);
 	Tcl_Obj *saveOptions = iPtr->returnOpts;
+	Tcl_Obj *saveErrCode = iPtr->errorCode;
+	if (saveErrCode) {
+	    Tcl_IncrRefCount(saveErrCode);
+	}
 	Tcl_IncrRefCount(saveOptions);
         if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && (traceCode == TCL_OK)) {
             traceCode = TclCheckExecutionTraces(interp, command, length,
@@ -3104,6 +3089,12 @@
 	    iPtr->returnOpts = saveOptions;
 	    Tcl_IncrRefCount(iPtr->returnOpts);
 	    iPtr->flags |= saveErrFlags;
+	    if (iPtr->errorCode) {
+		Tcl_DecrRefCount(iPtr->errorCode);
+	    }
+	    iPtr->errorCode = saveErrCode;
+	} else if (saveErrCode) {
+	    Tcl_DecrRefCount(saveErrCode);
 	}
 	Tcl_DecrRefCount(saveOptions);
     }
@@ -3307,7 +3298,7 @@
     Tcl_AppendToObj(message, "\"", -1);
     TclAppendObjToErrorInfo(interp, message);
     Tcl_DecrRefCount(message);
-    if (!(iPtr->flags & ERROR_CODE_SET)) {
+    if (!iPtr->errorCode) {
 	Tcl_SetErrorCode(interp, "NONE", NULL);
     }
 }
Index: generic/tclCmdAH.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdAH.c,v
retrieving revision 1.50
diff -u -r1.50 tclCmdAH.c
--- generic/tclCmdAH.c	30 Sep 2004 23:06:47 -0000	1.50
+++ generic/tclCmdAH.c	5 Oct 2004 18:03:47 -0000
@@ -298,8 +298,7 @@
 	    Tcl_DictObjGet(NULL, options, iPtr->returnErrorcodeKey, &value);
 	    if (NULL == value) {
 		Tcl_DictObjPut(NULL, options, iPtr->returnErrorcodeKey,
-			Tcl_ObjGetVar2(interp, iPtr->execEnvPtr->errorCode,
-			NULL, TCL_GLOBAL_ONLY));
+			iPtr->errorCode);
 	    }
 	    value = NULL;
 	    Tcl_DictObjGet(NULL, options, iPtr->returnErrorlineKey, &value);
Index: generic/tclEvent.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclEvent.c,v
retrieving revision 1.46
diff -u -r1.46 tclEvent.c
--- generic/tclEvent.c	27 Sep 2004 16:24:24 -0000	1.46
+++ generic/tclEvent.c	5 Oct 2004 18:03:47 -0000
@@ -33,7 +33,7 @@
 				 * Malloc-ed. */
     char *errorInfo;		/* Value of the errorInfo variable
 				 * (malloc-ed). */
-    char *errorCode;		/* Value of the errorCode variable
+    Tcl_Obj *errorCode;		/* Value of the errorCode variable
 				 * (malloc-ed). */
     struct BgError *nextPtr;	/* Next in list of all pending error
 				 * reports for this interpreter, or NULL
@@ -163,6 +163,7 @@
     CONST char *errResult, *varValue;
     ErrAssocData *assocPtr;
     int length;
+    Interp *iPtr = (Interp *) interp;
 
     /*
      * The Tcl_AddErrorInfo call below (with an empty string) ensures that
@@ -186,12 +187,15 @@
     }
     errPtr->errorInfo = (char *) ckalloc((unsigned) (strlen(varValue) + 1));
     strcpy(errPtr->errorInfo, varValue);
-    varValue = Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY);
-    if (varValue == NULL) {
-	varValue = "";
+
+    if (iPtr->errorCode) {
+	errPtr->errorCode = iPtr->errorCode;
+    } else {
+	/* Does this ever happen ? */
+	errPtr->errorCode = Tcl_NewObj();
     }
-    errPtr->errorCode = (char *) ckalloc((unsigned) (strlen(varValue) + 1));
-    strcpy(errPtr->errorCode, varValue);
+    Tcl_IncrRefCount(errPtr->errorCode);
+
     errPtr->nextPtr = NULL;
 
     assocPtr = (ErrAssocData *) Tcl_GetAssocData(interp, "tclBgError",
@@ -266,8 +270,8 @@
 
 	Tcl_SetVar(interp, "errorInfo", assocPtr->firstBgPtr->errorInfo,
 		TCL_GLOBAL_ONLY);
-	Tcl_SetVar(interp, "errorCode", assocPtr->firstBgPtr->errorCode,
-		TCL_GLOBAL_ONLY);
+	Tcl_SetVar2Ex(interp, "errorCode", NULL,
+		assocPtr->firstBgPtr->errorCode, TCL_GLOBAL_ONLY);
 
 	/*
 	 * Create and invoke the bgerror command.
@@ -358,7 +362,7 @@
 	if (assocPtr->firstBgPtr) {
 	    ckfree(assocPtr->firstBgPtr->errorMsg);
 	    ckfree(assocPtr->firstBgPtr->errorInfo);
-	    ckfree(assocPtr->firstBgPtr->errorCode);
+	    Tcl_DecrRefCount(assocPtr->firstBgPtr->errorCode);
 	    errPtr = assocPtr->firstBgPtr->nextPtr;
 	    ckfree((char *) assocPtr->firstBgPtr);
 	    assocPtr->firstBgPtr = errPtr;
@@ -407,7 +411,7 @@
 	assocPtr->firstBgPtr = errPtr->nextPtr;
 	ckfree(errPtr->errorMsg);
 	ckfree(errPtr->errorInfo);
-	ckfree(errPtr->errorCode);
+	Tcl_DecrRefCount(errPtr->errorCode);
 	ckfree((char *) errPtr);
     }
     Tcl_CancelIdleCall(HandleBgErrors, (ClientData) assocPtr);
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.179
diff -u -r1.179 tclInt.h
--- generic/tclInt.h	1 Oct 2004 12:45:19 -0000	1.179
+++ generic/tclInt.h	5 Oct 2004 18:03:48 -0000
@@ -1332,6 +1332,8 @@
     Tcl_Obj *returnLevelKey;	/* holds "-level" */
     Tcl_Obj *returnOptionsKey;	/* holds "-options" */
 
+    Tcl_Obj *errorCode;		/* errorCode value (now as a Tcl_Obj) */
+
     /*
      * Resource limiting framework support (TIP#143).
      */
@@ -1400,10 +1402,6 @@
  *			in $errorInfo for the current Tcl_Eval instance,
  *			so Tcl_Eval needn't log it (used to implement the
  *			"error message log" command).
- * ERROR_CODE_SET:	Non-zero means that Tcl_SetErrorCode has been
- *			called to record information for the current
- *			error.	Zero means Tcl_Eval must clear the
- *			errorCode variable if an error is returned.
  * DONT_COMPILE_CMDS_INLINE: Non-zero means that the bytecode compiler
  *			should not compile any commands into an inline
  *			sequence of instructions. This is set 1, for
@@ -1422,7 +1420,6 @@
 #define DELETED				    1
 #define ERR_IN_PROGRESS			    2
 #define ERR_ALREADY_LOGGED		    4
-#define ERROR_CODE_SET			    8
 #define DONT_COMPILE_CMDS_INLINE	 0x20
 #define RAND_SEED_INITIALIZED		 0x40
 #define SAFE_INTERP			 0x80
Index: generic/tclNamesp.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclNamesp.c,v
retrieving revision 1.59
diff -u -r1.59 tclNamesp.c
--- generic/tclNamesp.c	5 Oct 2004 16:26:32 -0000	1.59
+++ generic/tclNamesp.c	5 Oct 2004 18:03:50 -0000
@@ -172,6 +172,12 @@
 static void		DeleteImportedCmd _ANSI_ARGS_((ClientData clientData));
 static void		DupNsNameInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,
 			    Tcl_Obj *copyPtr));
+static char *		ErrorCodeRead _ANSI_ARGS_(( ClientData clientData,
+			    Tcl_Interp *interp, CONST char *name1,
+			    CONST char *name2, int flags));
+static char *		EstablishErrorCodeTraces _ANSI_ARGS_((
+			    ClientData clientData, Tcl_Interp *interp,
+			    CONST char *name1, CONST char *name2, int flags));
 static void		FreeNsNameInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
 static int		GetNamespaceFromObj _ANSI_ARGS_((
 			    Tcl_Interp *interp, Tcl_Obj *objPtr,
@@ -516,6 +522,54 @@
 /*
  *----------------------------------------------------------------------
  *
+ * EstablishErrorCodeTraces --
+ *
+ *	Creates traces on the ::errorCode variable to keep its value
+ *	consistent with the expectation of legacy code.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Read and unset traces are established on ::errorCode.
+ *
+ *----------------------------------------------------------------------
+ */
+static char *
+EstablishErrorCodeTraces(clientData, interp, name1, name2, flags)
+    ClientData clientData;
+    Tcl_Interp *interp;
+    CONST char *name1;
+    CONST char *name2;
+    int flags;
+{
+    Tcl_TraceVar(interp, "errorCode", TCL_GLOBAL_ONLY | TCL_TRACE_READS,
+	    ErrorCodeRead, (ClientData) NULL);
+    Tcl_TraceVar(interp, "errorCode", TCL_GLOBAL_ONLY | TCL_TRACE_UNSETS,
+	    EstablishErrorCodeTraces, (ClientData) NULL);
+    return NULL;
+}
+
+static char *
+ErrorCodeRead(clientData, interp, name1, name2, flags)
+    ClientData clientData;
+    Tcl_Interp *interp;
+    CONST char *name1;
+    CONST char *name2;
+    int flags;
+{
+    Interp *iPtr = (Interp *)interp;
+
+    if (flags & TCL_INTERP_DESTROYED) return NULL;
+    if (iPtr->errorCode == NULL) return NULL;
+    Tcl_ObjSetVar2(interp, iPtr->execEnvPtr->errorCode, NULL,
+	    iPtr->errorCode, TCL_GLOBAL_ONLY);
+    return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_CreateNamespace --
  *
  *	Creates a new namespace with the given name. If there is no
@@ -649,6 +703,13 @@
         entryPtr = Tcl_CreateHashEntry(&parentPtr->childTable, simpleName,
 	        &newEntry);
         Tcl_SetHashValue(entryPtr, (ClientData) nsPtr);
+    } else {
+	/* 
+	 * In the global namespace create traces to maintain the
+	 * ::errorCode variable.
+	 */
+	iPtr->globalNsPtr = nsPtr;
+	EstablishErrorCodeTraces(NULL, interp, NULL, NULL, 0);
     }
 
     /*
@@ -791,7 +852,10 @@
             } else {
                 nsPtr->flags |= NS_DEAD;
             }
-        }
+        } else {
+	    /* Restore the ::errorCode traces */
+	    EstablishErrorCodeTraces(NULL, nsPtr->interp, NULL, NULL, 0);
+	}
     }
 }
 
@@ -843,22 +907,17 @@
     if (nsPtr == globalNsPtr) {
 	/*
 	 * This is the global namespace.  Tearing it down will destroy the
-	 * ::errorInfo and ::errorCode variables.  We save and restore them
+	 * ::errorInfo variable.  We save and restore it 
 	 * in case there are any errors in progress, so the error details
-	 * they contain will not be lost.  See test namespace-8.5
+	 * it contains will not be lost.  See test namespace-8.5
 	 */
 
 	Tcl_Obj *errorInfo = Tcl_GetVar2Ex(nsPtr->interp, "errorInfo",
 		NULL, TCL_GLOBAL_ONLY);
-	Tcl_Obj *errorCode = Tcl_GetVar2Ex(nsPtr->interp, "errorCode",
-		NULL, TCL_GLOBAL_ONLY);
 			                
 	if (errorInfo) {
 	    Tcl_IncrRefCount(errorInfo);
 	}   
-	if (errorCode) {
-	    Tcl_IncrRefCount(errorCode);
-	}
 
 	TclDeleteVars(iPtr, &nsPtr->varTable);
 	Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS);
@@ -868,11 +927,6 @@
 		    errorInfo, TCL_GLOBAL_ONLY);
 	    Tcl_DecrRefCount(errorInfo);
 	}   
-	if (errorCode) {
-	    Tcl_SetVar2Ex(nsPtr->interp, "errorCode", NULL,
-		    errorCode, TCL_GLOBAL_ONLY);
-	    Tcl_DecrRefCount(errorCode);
-	}
     } else {
 	/*
 	 * Variable table should be cleared but not freed! TclDeleteVars
Index: generic/tclResult.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclResult.c,v
retrieving revision 1.11
diff -u -r1.11 tclResult.c
--- generic/tclResult.c	30 Sep 2004 23:06:48 -0000	1.11
+++ generic/tclResult.c	5 Oct 2004 18:03:50 -0000
@@ -801,7 +801,13 @@
     }
     iPtr->result = iPtr->resultSpace;
     iPtr->resultSpace[0] = 0;
-    iPtr->flags &= ~(ERR_ALREADY_LOGGED | ERR_IN_PROGRESS | ERROR_CODE_SET);
+    if (iPtr->errorCode) {
+	Tcl_ObjSetVar2(interp, iPtr->execEnvPtr->errorCode, NULL,
+		iPtr->errorCode, TCL_GLOBAL_ONLY);
+	Tcl_DecrRefCount(iPtr->errorCode);
+	iPtr->errorCode = NULL;
+    }
+    iPtr->flags &= ~(ERR_ALREADY_LOGGED | ERR_IN_PROGRESS);
 }
 
 /*
@@ -955,9 +961,11 @@
 {
     Interp *iPtr = (Interp *) interp;
     
-    Tcl_ObjSetVar2(interp, iPtr->execEnvPtr->errorCode, NULL,
-	    errorObjPtr, TCL_GLOBAL_ONLY);
-    iPtr->flags |= ERROR_CODE_SET;
+    if (iPtr->errorCode) {
+	Tcl_DecrRefCount(iPtr->errorCode);
+    }
+    iPtr->errorCode = errorObjPtr;
+    Tcl_IncrRefCount(iPtr->errorCode);
 }
 
 /*
@@ -1033,8 +1041,7 @@
 	    ((Interp *) targetInterp)->flags |= ERR_IN_PROGRESS;
 	}
 
-	objPtr = Tcl_GetVar2Ex(sourceInterp, "errorCode", NULL,
-		TCL_GLOBAL_ONLY);
+	objPtr = ((Interp *) sourceInterp)->errorCode;
 	if (objPtr) {
 	    Tcl_SetObjErrorCode(targetInterp, objPtr);
 	}
Index: generic/tclTrace.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclTrace.c,v
retrieving revision 1.13
diff -u -r1.13 tclTrace.c
--- generic/tclTrace.c	1 Oct 2004 00:10:23 -0000	1.13
+++ generic/tclTrace.c	5 Oct 2004 18:03:51 -0000
@@ -2451,7 +2451,12 @@
     int code = TCL_OK;
     int disposeFlags = 0;
     int saveErrFlags = iPtr->flags
-	    & (ERR_IN_PROGRESS | ERR_ALREADY_LOGGED | ERROR_CODE_SET);
+	    & (ERR_IN_PROGRESS | ERR_ALREADY_LOGGED);
+    Tcl_Obj *saveErrCode = iPtr->errorCode;
+
+    if (saveErrCode) {
+	Tcl_IncrRefCount(saveErrCode);
+    }
 
     /*
      * If there are already similar trace procedures active for the
@@ -2576,6 +2581,12 @@
     done:
     if (code == TCL_OK) {
 	iPtr->flags |= saveErrFlags;
+	if (iPtr->errorCode) {
+	    Tcl_DecrRefCount(iPtr->errorCode);
+	}
+	iPtr->errorCode = saveErrCode;
+    } else if (saveErrCode) {
+	Tcl_DecrRefCount(saveErrCode);
     }
     if (code == TCL_ERROR) {
 	if (leaveErrMsg) {
