merge trunk

9 files changed, 137 insertions, 162 deletions

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 30c1318..6a22a30 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -177,9 +177,9 @@ TclCompileAppendCmd(
      */
 
     varTokenPtr = TokenAfter(parsePtr->tokenPtr);
-    PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_ELEMENT,
-	    &localIndex, &isScalar, 1);
-    if (!isScalar || localIndex < 0) {
+
+    localIndex = LocalScalarFromToken(varTokenPtr, envPtr);
+    if (localIndex < 0) {
 	return TCL_ERROR;
     }
 
@@ -2527,25 +2527,17 @@ CompileEachloopCmd(
 				 * (TCL_EACH_*) */
 {
     Proc *procPtr = envPtr->procPtr;
-    ForeachInfo *infoPtr;	/* Points to the structure describing this
+    ForeachInfo *infoPtr=NULL;	/* Points to the structure describing this
 				 * foreach command. Stored in a AuxData
 				 * record in the ByteCode. */
     
     Tcl_Token *tokenPtr, *bodyTokenPtr;
     int jumpBackOffset, infoIndex, range;
-    int numWords, numLists, numVars, loopIndex, i, j, code;
+    int numWords, numLists, i, j, code = TCL_OK;
+    Tcl_Obj *varListObj = NULL;
     DefineLineInformation;	/* TIP #280 */
 
     /*
-     * We parse the variable list argument words and create two arrays:
-     *    varcList[i] is number of variables in i-th var list.
-     *    varvList[i] points to array of var names in i-th var list.
-     */
-
-    int *varcList;
-    const char ***varvList;
-
-    /*
      * If the foreach command isn't in a procedure, don't compile it inline:
      * the payoff is too small.
      */
@@ -2573,105 +2565,73 @@ CompileEachloopCmd(
     }
 
     /*
-     * Allocate storage for the varcList and varvList arrays if necessary.
+     * Create and initialize the ForeachInfo and ForeachVarList data
+     * structures describing this command. Then create a AuxData record
+     * pointing to the ForeachInfo structure.
      */
 
     numLists = (numWords - 2)/2;
-    varcList = TclStackAlloc(interp, numLists * sizeof(int));
-    memset(varcList, 0, numLists * sizeof(int));
-    varvList = (const char ***) TclStackAlloc(interp,
-	    numLists * sizeof(const char **));
-    memset((char*) varvList, 0, numLists * sizeof(const char **));
+    infoPtr = ckalloc(sizeof(ForeachInfo)
+	    + (numLists - 1) * sizeof(ForeachVarList *));
+    infoPtr->numLists = 0;	/* Count this up as we go */
 
     /*
-     * Break up each var list and set the varcList and varvList arrays. Don't
+     * Parse each var list into sequence of var names.  Don't
      * compile the foreach inline if any var name needs substitutions or isn't
      * a scalar, or if any var list needs substitutions.
      */
 
-    loopIndex = 0;
+    varListObj = Tcl_NewObj();
     for (i = 0, tokenPtr = parsePtr->tokenPtr;
 	    i < numWords-1;
 	    i++, tokenPtr = TokenAfter(tokenPtr)) {
-	Tcl_DString varList;
+	ForeachVarList *varListPtr;
+	int numVars;
 
 	if (i%2 != 1) {
 	    continue;
 	}
-	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	    code = TCL_ERROR;
-	    goto done;
-	}
-
-	/*
-	 * Lots of copying going on here. Need a ListObj wizard to show a
-	 * better way.
-	 */
-
-	Tcl_DStringInit(&varList);
-	TclDStringAppendToken(&varList, &tokenPtr[1]);
-	code = Tcl_SplitList(NULL, Tcl_DStringValue(&varList),
-		&varcList[loopIndex], &varvList[loopIndex]);
-	Tcl_DStringFree(&varList);
-	if (code != TCL_OK) {
-	    code = TCL_ERROR;
-	    goto done;
-	}
-	numVars = varcList[loopIndex];
 
 	/*
 	 * If the variable list is empty, we can enter an infinite loop when
-	 * the interpreted version would not. Take care to ensure this does
-	 * not happen. [Bug 1671138]
+	 * the interpreted version would not.  Take care to ensure this does
+	 * not happen.  [Bug 1671138]
 	 */
 
-	if (numVars == 0) {
+	if (!TclWordKnownAtCompileTime(tokenPtr, varListObj) ||
+		TCL_OK != Tcl_ListObjLength(NULL, varListObj, &numVars) ||
+		numVars == 0) {
 	    code = TCL_ERROR;
 	    goto done;
 	}
 
-	for (j = 0;  j < numVars;  j++) {
-	    const char *varName = varvList[loopIndex][j];
+	varListPtr = ckalloc(sizeof(ForeachVarList)
+		+ (numVars - 1) * sizeof(int));
+	varListPtr->numVars = numVars;
+	infoPtr->varLists[i/2] = varListPtr;
+	infoPtr->numLists++;
 
-	    if (!TclIsLocalScalar(varName, (int) strlen(varName))) {
+	for (j = 0;  j < numVars;  j++) {
+	    Tcl_Obj *varNameObj;
+	    const char *bytes;
+	    int numBytes, varIndex;
+
+	    Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj);
+	    bytes = Tcl_GetStringFromObj(varNameObj, &numBytes);
+	    varIndex = LocalScalar(bytes, numBytes, envPtr);
+	    if (varIndex < 0) {
 		code = TCL_ERROR;
 		goto done;
 	    }
+	    varListPtr->varIndexes[j] = varIndex;
 	}
-	loopIndex++;
+	Tcl_SetObjLength(varListObj, 0);
     }
 
     /*
      * We will compile the foreach command.
      */
 
-    code = TCL_OK;
-
-    /*
-     * Create and initialize the ForeachInfo and ForeachVarList data
-     * structures describing this command. Then create a AuxData record
-     * pointing to the ForeachInfo structure.
-     */
-
-    infoPtr = ckalloc(sizeof(ForeachInfo)
-	    + (numLists - 1) * sizeof(ForeachVarList *));
-    infoPtr->numLists = numLists;
-    for (loopIndex = 0;  loopIndex < numLists;  loopIndex++) {
-	ForeachVarList *varListPtr;
-
-	numVars = varcList[loopIndex];
-	varListPtr = ckalloc(sizeof(ForeachVarList)
-		+ (numVars - 1) * sizeof(int));
-	varListPtr->numVars = numVars;
-	for (j = 0;  j < numVars;  j++) {
-	    const char *varName = varvList[loopIndex][j];
-	    int nameChars = strlen(varName);
-
-	    varListPtr->varIndexes[j] = TclFindCompiledLocal(varName,
-		    nameChars, /*create*/ 1, envPtr);
-	}
-	infoPtr->varLists[loopIndex] = varListPtr;
-    }
     infoIndex = TclCreateAuxData(infoPtr, &tclNewForeachInfoType, envPtr);
 
     /*
@@ -2743,13 +2703,14 @@ CompileEachloopCmd(
     }
     
     done:
-    for (loopIndex = 0;  loopIndex < numLists;  loopIndex++) {
-	if (varvList[loopIndex] != NULL) {
-	    ckfree(varvList[loopIndex]);
+    if (code == TCL_ERROR) {
+	if (infoPtr) {
+	    FreeForeachInfo(infoPtr);
 	}
     }
-    TclStackFree(interp, (void *)varvList);
-    TclStackFree(interp, varcList);
+    if (varListObj) {
+	Tcl_DecrRefCount(varListObj);
+    }
     return code;
 }
 
@@ -3234,6 +3195,54 @@ TclCompileFormatCmd(
 /*
  *----------------------------------------------------------------------
  *
+ * TclLocalScalarFromToken --
+ *
+ *	Get the index into the table of compiled locals that corresponds
+ *	to a local scalar variable name.
+ *
+ * Results:
+ * 	Returns the non-negative integer index value into the table of
+ * 	compiled locals corresponding to a local scalar variable name.
+ * 	If the arguments passed in do not identify a local scalar variable
+ * 	then return -1.
+ *
+ * Side effects:
+ *	May add an entery into the table of compiled locals.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclLocalScalarFromToken(
+    Tcl_Token *tokenPtr,
+    CompileEnv *envPtr)
+{
+    int isScalar, index;
+
+    TclPushVarName(NULL, tokenPtr, envPtr, TCL_NO_ELEMENT, &index, &isScalar);
+    if (!isScalar) {
+	index = -1;
+    }
+    return index;
+}
+
+int
+TclLocalScalar(
+    const char *bytes,
+    int numBytes,
+    CompileEnv *envPtr)
+{
+    Tcl_Token token[2] =        {{TCL_TOKEN_SIMPLE_WORD, NULL, 0, 1},
+                                 {TCL_TOKEN_TEXT, NULL, 0, 0}};
+
+    token[1].start = bytes;
+    token[1].size = numBytes;
+    return TclLocalScalarFromToken(token, envPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TclPushVarName --
  *
  *	Procedure used in the compiling where pushing a variable name is
@@ -3313,7 +3322,7 @@ TclPushVarName(
 		}
 	    }
 
-	    if ((elName != NULL) && elNameChars) {
+	    if (!(flags & TCL_NO_ELEMENT) && (elName != NULL) && elNameChars) {
 		/*
 		 * An array element, the element name is a simple string:
 		 * assemble the corresponding token.
@@ -3328,7 +3337,7 @@ TclPushVarName(
 		elemTokenCount = 1;
 	    }
 	}
-    } else if (((n = varTokenPtr->numComponents) > 1)
+    } else if (interp && ((n = varTokenPtr->numComponents) > 1)
 	    && (varTokenPtr[1].type == TCL_TOKEN_TEXT)
 	    && (varTokenPtr[n].type == TCL_TOKEN_TEXT)
 	    && (varTokenPtr[n].start[varTokenPtr[n].size - 1] == ')')) {
@@ -3366,7 +3375,8 @@ TclPushVarName(
 	    remainingChars = (varTokenPtr[2].start - p) - 1;
 	    elNameChars = (varTokenPtr[n].start-p) + varTokenPtr[n].size - 1;
 
-	    if (remainingChars) {
+	    if (!(flags & TCL_NO_ELEMENT)) {
+	      if (remainingChars) {
 		/*
 		 * Make a first token with the extra characters in the first
 		 * token.
@@ -3386,13 +3396,14 @@ TclPushVarName(
 
 		memcpy(elemTokenPtr+1, varTokenPtr+2,
 			(n-1) * sizeof(Tcl_Token));
-	    } else {
+	      } else {
 		/*
 		 * Use the already available tokens.
 		 */
 
 		elemTokenPtr = &varTokenPtr[2];
 		elemTokenCount = n - 1;
+	      }
 	    }
 	}
     }
@@ -3427,7 +3438,7 @@ TclPushVarName(
 		localIndex = -1;
 	    }
 	}
-	if (localIndex < 0) {
+	if (interp && localIndex < 0) {
 	    PushLiteral(envPtr, name, nameChars);
 	}
 
@@ -3444,7 +3455,7 @@ TclPushVarName(
 		PushStringLiteral(envPtr, "");
 	    }
 	}
-    } else {
+    } else if (interp) {
 	/*
 	 * The var name isn't simple: compile and push it.
 	 */
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index 98407f7..e2fb43d 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -2044,7 +2044,7 @@ TclCompileNamespaceUpvarCmd(
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
     Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
-    int isScalar, localIndex, numWords, i;
+    int localIndex, numWords, i;
     DefineLineInformation;	/* TIP #280 */
 
     if (envPtr->procPtr == NULL) {
@@ -2079,10 +2079,8 @@ TclCompileNamespaceUpvarCmd(
 	localTokenPtr = TokenAfter(otherTokenPtr);
 
 	CompileWord(envPtr, otherTokenPtr, interp, i);
-	PushVarNameWord(interp, localTokenPtr, envPtr, 0,
-		&localIndex, &isScalar, i+1);
-
-	if ((localIndex < 0) || !isScalar) {
+	localIndex = LocalScalarFromToken(localTokenPtr, envPtr);
+	if (localIndex < 0) {
 	    return TCL_ERROR;
 	}
 	TclEmitInstInt4(	INST_NSUPVAR, localIndex,	envPtr);
@@ -2763,7 +2761,7 @@ TclCompileUpvarCmd(
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
     Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
-    int isScalar, localIndex, numWords, i;
+    int localIndex, numWords, i;
     DefineLineInformation;	/* TIP #280 */
     Tcl_Obj *objPtr;
 
@@ -2826,10 +2824,8 @@ TclCompileUpvarCmd(
 	localTokenPtr = TokenAfter(otherTokenPtr);
 
 	CompileWord(envPtr, otherTokenPtr, interp, i);
-	PushVarNameWord(interp, localTokenPtr, envPtr, 0,
-		&localIndex, &isScalar, i+1);
-
-	if ((localIndex < 0) || !isScalar) {
+	localIndex = LocalScalarFromToken(localTokenPtr, envPtr);
+	if (localIndex < 0) {
 	    return TCL_ERROR;
 	}
 	TclEmitInstInt4(	INST_UPVAR, localIndex,		envPtr);
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index c097d6b..800e6af 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -1151,6 +1151,10 @@ MODULE_SCOPE void	TclFinalizeLoopExceptionRange(CompileEnv *envPtr,
 MODULE_SCOPE char *	TclLiteralStats(LiteralTable *tablePtr);
 MODULE_SCOPE int	TclLog2(int value);
 #endif
+MODULE_SCOPE int	TclLocalScalar(const char *bytes, int numBytes,
+			    CompileEnv *envPtr);
+MODULE_SCOPE int	TclLocalScalarFromToken(Tcl_Token *tokenPtr,
+			    CompileEnv *envPtr);
 MODULE_SCOPE void	TclOptimizeBytecode(void *envPtr);
 #ifdef TCL_COMPILE_DEBUG
 MODULE_SCOPE void	TclPrintByteCodeObj(Tcl_Interp *interp,
@@ -1678,11 +1682,9 @@ MODULE_SCOPE int	TclPushProcCallFrame(ClientData clientData,
 #define AnonymousLocal(envPtr) \
     (TclFindCompiledLocal(NULL, /*nameChars*/ 0, /*create*/ 1, (envPtr)))
 #define LocalScalar(chars,len,envPtr) \
-    (!TclIsLocalScalar((chars), (len)) ? -1 : \
-	TclFindCompiledLocal((chars), (len), /*create*/ 1, (envPtr)))
+    TclLocalScalar(chars, len, envPtr)
 #define LocalScalarFromToken(tokenPtr,envPtr) \
-    ((tokenPtr)->type != TCL_TOKEN_SIMPLE_WORD ? -1 : \
-	LocalScalar((tokenPtr)[1].start, (tokenPtr)[1].size, (envPtr)))
+    TclLocalScalarFromToken(tokenPtr, envPtr)
 
 /*
  * Flags bits used by TclPushVarName.
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 7ad3d0e..4f776e1 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -180,9 +180,9 @@ TCL_DECLARE_MUTEX(encodingMutex)
  * the system encoding will be used to perform the conversion.
  */
 
-static Tcl_Encoding defaultEncoding;
-static Tcl_Encoding systemEncoding;
-Tcl_Encoding tclIdentityEncoding;
+static Tcl_Encoding defaultEncoding = NULL;
+static Tcl_Encoding systemEncoding = NULL;
+Tcl_Encoding tclIdentityEncoding = NULL;
 
 /*
  * The following variable is used in the sparse matrix code for a
@@ -652,7 +652,10 @@ TclFinalizeEncodingSubsystem(void)
     Tcl_MutexLock(&encodingMutex);
     encodingsInitialized = 0;
     FreeEncoding(systemEncoding);
+    systemEncoding = NULL;
+    defaultEncoding = NULL;
     FreeEncoding(tclIdentityEncoding);
+    tclIdentityEncoding = NULL;
 
     hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
     while (hPtr != NULL) {
@@ -2898,7 +2901,9 @@ TableFreeProc(
      */
 
     ckfree(dataPtr->toUnicode);
+    dataPtr->toUnicode = NULL;
     ckfree(dataPtr->fromUnicode);
+    dataPtr->fromUnicode = NULL;
     ckfree(dataPtr);
 }
 
@@ -3371,6 +3376,7 @@ EscapeFreeProc(
 	subTablePtr = dataPtr->subTables;
 	for (i = 0; i < dataPtr->numSubTables; i++) {
 	    FreeEncoding((Tcl_Encoding) subTablePtr->encodingPtr);
+	    subTablePtr->encodingPtr = NULL;
 	    subTablePtr++;
 	}
     }
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 7f42362..95c69dd 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -119,6 +119,7 @@ static char *		VwaitVarProc(ClientData clientData,
 			    Tcl_Interp *interp, const char *name1,
 			    const char *name2, int flags);
 static void		InvokeExitHandlers(void);
+static void		FinalizeThread(int quick);
 
 /*
  *----------------------------------------------------------------------
@@ -983,7 +984,7 @@ Tcl_Exit(
 	     * Tcl_Channels that may have data enqueued.
 	     */
 
-	    Tcl_FinalizeThread();
+	    FinalizeThread(/* quick */ 1);
 	}
 	TclpExit(status);
 	Tcl_Panic("OS exit failed!");
@@ -1183,7 +1184,7 @@ Tcl_Finalize(void)
      * This fixes the Tcl Bug #990552.
      */
 
-    TclFinalizeThreadData();
+    TclFinalizeThreadData(/* quick */ 0);
 
     /*
      * Now we can free constants for conversions to/from double.
@@ -1269,6 +1270,13 @@ Tcl_Finalize(void)
 void
 Tcl_FinalizeThread(void)
 {
+    FinalizeThread(/* quick */ 0);
+}
+
+void
+FinalizeThread(
+    int quick)
+{
     ExitHandler *exitPtr;
     ThreadSpecificData *tsdPtr;
 
@@ -1309,7 +1317,7 @@ Tcl_FinalizeThread(void)
      *
      * Fix [Bug #571002]
      */
-    TclFinalizeThreadData();
+    TclFinalizeThreadData(quick);
 }
 
 /*
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 6f9dbfe..59a6a93 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -9162,6 +9162,9 @@ MBWrite(
     }
     outStatePtr->outQueueTail = tail;
     inStatePtr->inQueueHead = bufPtr;
+    if (inStatePtr->inQueueTail == tail) {
+	inStatePtr->inQueueTail = bufPtr;
+    }
     if (bufPtr == NULL) {
 	inStatePtr->inQueueTail = NULL;
     }
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 1ce5fe8..9a25db9 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2882,7 +2882,7 @@ MODULE_SCOPE void	TclFinalizePreserve(void);
 MODULE_SCOPE void	TclFinalizeSynchronization(void);
 MODULE_SCOPE void	TclFinalizeThreadAlloc(void);
 MODULE_SCOPE void	TclFinalizeThreadAllocThread(void);
-MODULE_SCOPE void	TclFinalizeThreadData(void);
+MODULE_SCOPE void	TclFinalizeThreadData(int quick);
 MODULE_SCOPE void	TclFinalizeThreadObjects(void);
 MODULE_SCOPE double	TclFloor(const mp_int *a);
 MODULE_SCOPE void	TclFormatNaN(double value, char *buffer);
@@ -2937,7 +2937,6 @@ MODULE_SCOPE void	TclInitNotifier(void);
 MODULE_SCOPE void	TclInitObjSubsystem(void);
 MODULE_SCOPE void	TclInitSubsystems(void);
 MODULE_SCOPE int	TclInterpReady(Tcl_Interp *interp);
-MODULE_SCOPE int	TclIsLocalScalar(const char *src, int len);
 MODULE_SCOPE int	TclIsSpaceProc(char byte);
 MODULE_SCOPE int	TclIsBareword(char byte);
 MODULE_SCOPE Tcl_Obj *	TclJoinPath(int elements, Tcl_Obj * const objv[]);
diff --git a/generic/tclParse.c b/generic/tclParse.c
index ca12be5..5524979 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -2526,56 +2526,6 @@ TclObjCommandComplete(
 }
 
 /*
- *----------------------------------------------------------------------
- *
- * TclIsLocalScalar --
- *
- *	Check to see if a given string is a legal scalar variable name with no
- *	namespace qualifiers or substitutions.
- *
- * Results:
- *	Returns 1 if the variable is a local scalar.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclIsLocalScalar(
-    const char *src,
-    int len)
-{
-    const char *p;
-    const char *lastChar = src + (len - 1);
-
-    for (p=src ; p<=lastChar ; p++) {
-	if ((CHAR_TYPE(*p) != TYPE_NORMAL)
-		&& (CHAR_TYPE(*p) != TYPE_COMMAND_END)) {
-	    /*
-	     * TCL_COMMAND_END is returned for the last character of the
-	     * string. By this point we know it isn't an array or namespace
-	     * reference.
-	     */
-
-	    return 0;
-	}
-	if (*p == '(') {
-	    if (*lastChar == ')') {	/* We have an array element */
-		return 0;
-	    }
-	} else if (*p == ':') {
-	    if ((p != lastChar) && *(p+1) == ':') {	/* qualified name */
-		return 0;
-	    }
-	}
-    }
-
-    return 1;
-}
-
-/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4
diff --git a/generic/tclThread.c b/generic/tclThread.c
index 5ac6a8d..198fa6a 100644
--- a/generic/tclThread.c
+++ b/generic/tclThread.c
@@ -353,11 +353,11 @@ Tcl_ConditionFinalize(
  */
 
 void
-TclFinalizeThreadData(void)
+TclFinalizeThreadData(int quick)
 {
     TclFinalizeThreadDataThread();
 #if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
-    if ((!TclInExit())||TclFullFinalizationRequested()) {
+    if (!quick) {
 	/*
 	 * Quick exit principle makes it useless to terminate allocators
 	 */