merge trunk

7 files changed, 96 insertions, 57 deletions

diff --git a/ChangeLog b/ChangeLog
index 0cf822d..2e9c34c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,21 @@
+2013-01-28  Donal K. Fellows  <dkf@users.sf.net>
+
+	* generic/tclCompCmds.c (TclCompileArraySetCmd)
+	(TclCompileArrayUnsetCmd, TclCompileDictAppendCmd)
+	(TclCompileDictCreateCmd, CompileDictEachCmd, TclCompileDictIncrCmd)
+	(TclCompileDictLappendCmd, TclCompileDictMergeCmd)
+	(TclCompileDictUnsetCmd, TclCompileDictUpdateCmd)
+	(TclCompileDictWithCmd, TclCompileInfoCommandsCmd):
+	* generic/tclCompCmdsSZ.c (TclCompileStringMatchCmd)
+	(TclCompileStringMapCmd): Improve the code generation in cases where
+	full compilation is impossible but a full ensemble invoke is provably
+	not necessary.
+
+2013-01-26  Jan Nijtmans  <nijtmans@users.sf.net>
+
+	* unix/tclUnixCompat.c: [Bug 3601804]: platformCPUID segmentation
+	fault on Darwin.
+
 2013-01-23  Donal K. Fellows  <dkf@users.sf.net>
 
 	* library/http/http.tcl (http::geturl): [Bug 2911139]: Do not do vwait
diff --git a/doc/namespace.n b/doc/namespace.n
index b06d27a..f2812b2 100644
--- a/doc/namespace.n
+++ b/doc/namespace.n
@@ -287,7 +287,7 @@ This command is the complement of the \fBnamespace qualifiers\fR command.
 It does not check whether the namespace names are, in fact,
 the names of currently defined namespaces.
 .TP
-\fBnamespace upvar\fR \fInamespace\fR ?\fIotherVar myVar \fR...
+\fBnamespace upvar\fR \fInamespace\fR ?\fIotherVar myVar \fR...?
 .
 This command arranges for zero or more local variables in the current
 procedure to refer to variables in \fInamespace\fR. The namespace name is
diff --git a/doc/string.n b/doc/string.n
index f5eae39..351c865 100644
--- a/doc/string.n
+++ b/doc/string.n
@@ -19,7 +19,7 @@ string \- Manipulate strings
 Performs one of several string operations, depending on \fIoption\fR.
 The legal \fIoption\fRs (which may be abbreviated) are:
 .TP
-\fBstring compare\fR ?\fB\-nocase\fR? ?\fB\-length int\fR? \fIstring1 string2\fR
+\fBstring compare\fR ?\fB\-nocase\fR? ?\fB\-length\fI length\fR? \fIstring1 string2\fR
 .
 Perform a character-by-character comparison of strings \fIstring1\fR
 and \fIstring2\fR.  Returns \-1, 0, or 1, depending on whether
@@ -29,7 +29,7 @@ first \fIlength\fR characters are used in the comparison.  If
 \fB\-length\fR is negative, it is ignored.  If \fB\-nocase\fR is
 specified, then the strings are compared in a case-insensitive manner.
 .TP
-\fBstring equal\fR ?\fB\-nocase\fR? ?\fB\-length int\fR? \fIstring1 string2\fR
+\fBstring equal\fR ?\fB\-nocase\fR? ?\fB\-length\fI length\fR? \fIstring1 string2\fR
 .
 Perform a character-by-character comparison of strings \fIstring1\fR
 and \fIstring2\fR.  Returns 1 if \fIstring1\fR and \fIstring2\fR are
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 3427dff..b13ef18 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -3790,9 +3790,6 @@ TclNREvalObjv(
     }
     cmdPtrPtr = (Command **) &(callbackPtr->data[0]);
 
-    callbackPtr->data[2] = INT2PTR(objc);
-    callbackPtr->data[3] = (ClientData) objv;
-
     iPtr->numLevels++;
     result = TclInterpReady(interp);
 
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 503f339..389c1ee 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -295,19 +295,12 @@ TclCompileArraySetCmd(
     }
 
     tokenPtr = TokenAfter(parsePtr->tokenPtr);
-    if (envPtr->procPtr == NULL) {
-	Tcl_Token *tokPtr = TokenAfter(tokenPtr);
-
-	if (tokPtr->type != TCL_TOKEN_SIMPLE_WORD || tokPtr[1].size != 0) {
-	    return TCL_ERROR;
-	}
-    }
     PushVarNameWord(interp, tokenPtr, envPtr, TCL_NO_ELEMENT,
 	    &localIndex, &simpleVarName, &isScalar, 1);
+    tokenPtr = TokenAfter(tokenPtr);
     if (!isScalar) {
 	return TCL_ERROR;
     }
-    tokenPtr = TokenAfter(tokenPtr);
 
     /*
      * Special case: literal empty value argument is just an "ensure array"
@@ -333,13 +326,33 @@ TclCompileArraySetCmd(
 	return TCL_OK;
     }
 
+    if (envPtr->procPtr == NULL) {
+	/*
+	 * Right number of arguments, but not compilable as we can't allocate
+	 * (unnamed) local variables to manage the internal iteration.
+	 */
+
+	Tcl_Obj *objPtr = Tcl_NewObj();
+	char *bytes;
+	int length, cmdLit;
+
+	Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
+	bytes = Tcl_GetStringFromObj(objPtr, &length);
+	cmdLit = TclRegisterNewCmdLiteral(envPtr, bytes, length);
+	TclSetCmdNameObj(interp, envPtr->literalArrayPtr[cmdLit].objPtr,
+		cmdPtr);
+	TclEmitPush(cmdLit, envPtr);
+	TclDecrRefCount(objPtr);
+	TclEmitInstInt4(INST_REVERSE, 2,			envPtr);
+	CompileWord(envPtr, tokenPtr, interp, 2);
+	TclEmitInstInt1(INST_INVOKE_STK1, 3,			envPtr);
+	return TCL_OK;
+    }
+
     /*
      * Prepare for the internal foreach.
      */
 
-    if (envPtr->procPtr == NULL) {
-	return TCL_ERROR;
-    }
     dataVar = TclFindCompiledLocal(NULL, 0, 1, envPtr);
     iterVar = TclFindCompiledLocal(NULL, 0, 1, envPtr);
     keyVar = TclFindCompiledLocal(NULL, 0, 1, envPtr);
@@ -442,7 +455,7 @@ TclCompileArrayUnsetCmd(
     int simpleVarName, isScalar, localIndex, savedStackDepth;
 
     if (parsePtr->numWords != 2) {
-	return TCL_ERROR;
+	return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
     }
 
     PushVarNameWord(interp, tokenPtr, envPtr, TCL_NO_ELEMENT,
@@ -936,7 +949,7 @@ TclCompileDictIncrCmd(
 
 	incrTokenPtr = TokenAfter(keyTokenPtr);
 	if (incrTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	    return TCL_ERROR;
+	    return TclCompileBasic2Or3ArgCmd(interp, parsePtr,cmdPtr, envPtr);
 	}
 	word = incrTokenPtr[1].start;
 	numBytes = incrTokenPtr[1].size;
@@ -946,7 +959,7 @@ TclCompileDictIncrCmd(
 	code = TclGetIntFromObj(NULL, intObj, &incrAmount);
 	TclDecrRefCount(intObj);
 	if (code != TCL_OK) {
-	    return TCL_ERROR;
+	    return TclCompileBasic2Or3ArgCmd(interp, parsePtr,cmdPtr, envPtr);
 	}
     } else {
 	incrAmount = 1;
@@ -959,16 +972,16 @@ TclCompileDictIncrCmd(
      */
 
     if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	return TCL_ERROR;
+	return TclCompileBasic2Or3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
     }
     name = varTokenPtr[1].start;
     nameChars = varTokenPtr[1].size;
     if (!TclIsLocalScalar(name, nameChars)) {
-	return TCL_ERROR;
+	return TclCompileBasic2Or3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
     }
     dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, envPtr);
     if (dictVarIndex < 0) {
-	return TCL_ERROR;
+	return TclCompileBasic2Or3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
     }
 
     /*
@@ -1086,16 +1099,16 @@ TclCompileDictUnsetCmd(
 
     tokenPtr = TokenAfter(parsePtr->tokenPtr);
     if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	return TCL_ERROR;
+	return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
     }
     name = tokenPtr[1].start;
     nameChars = tokenPtr[1].size;
     if (!TclIsLocalScalar(name, nameChars)) {
-	return TCL_ERROR;
+	return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
     }
     dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, envPtr);
     if (dictVarIndex < 0) {
-	return TCL_ERROR;
+	return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
     }
 
     /*
@@ -1186,7 +1199,7 @@ TclCompileDictCreateCmd(
   nonConstant:
     worker = TclFindCompiledLocal(NULL, 0, 1, envPtr);
     if (worker < 0) {
-	return TCL_ERROR;
+	return TclCompileBasicMin0ArgCmd(interp, parsePtr, cmdPtr, envPtr);
     }
 
     PushLiteral(envPtr,		"", 0);
@@ -1247,7 +1260,7 @@ TclCompileDictMergeCmd(
 
     workerIndex = TclFindCompiledLocal(NULL, 0, 1, envPtr);
     if (workerIndex < 0) {
-	return TCL_ERROR;
+	return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
     }
     infoIndex = TclFindCompiledLocal(NULL, 0, 1, envPtr);
 
@@ -1373,11 +1386,11 @@ CompileDictEachCmd(
     Tcl_DString buffer;
 
     /*
-     * There must be at least three argument after the command.
+     * There must be three arguments after the command.
      */
 
     if (parsePtr->numWords != 4) {
-	return TCL_ERROR;
+	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
     }
 
     varsTokenPtr = TokenAfter(parsePtr->tokenPtr);
@@ -1385,7 +1398,7 @@ CompileDictEachCmd(
     bodyTokenPtr = TokenAfter(dictTokenPtr);
     if (varsTokenPtr->type != TCL_TOKEN_SIMPLE_WORD ||
 	    bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	return TCL_ERROR;
+	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
     }
 
     /*
@@ -1397,7 +1410,7 @@ CompileDictEachCmd(
 	collectVar = TclFindCompiledLocal(NULL, /*nameChars*/ 0, /*create*/ 1,
 		envPtr);
 	if (collectVar < 0) {
-	    return TCL_ERROR;
+	    return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
 	}
     }
 
@@ -1411,31 +1424,31 @@ CompileDictEachCmd(
     if (Tcl_SplitList(NULL, Tcl_DStringValue(&buffer), &numVars,
 	    &argv) != TCL_OK) {
 	Tcl_DStringFree(&buffer);
-	return TCL_ERROR;
+	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
     }
     Tcl_DStringFree(&buffer);
     if (numVars != 2) {
 	ckfree(argv);
-	return TCL_ERROR;
+	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
     }
 
     nameChars = strlen(argv[0]);
     if (!TclIsLocalScalar(argv[0], nameChars)) {
 	ckfree(argv);
-	return TCL_ERROR;
+	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
     }
     keyVarIndex = TclFindCompiledLocal(argv[0], nameChars, 1, envPtr);
 
     nameChars = strlen(argv[1]);
     if (!TclIsLocalScalar(argv[1], nameChars)) {
 	ckfree(argv);
-	return TCL_ERROR;
+	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
     }
     valueVarIndex = TclFindCompiledLocal(argv[1], nameChars, 1, envPtr);
     ckfree(argv);
 
     if ((keyVarIndex < 0) || (valueVarIndex < 0)) {
-	return TCL_ERROR;
+	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
     }
 
     /*
@@ -1447,7 +1460,7 @@ CompileDictEachCmd(
 
     infoIndex = TclFindCompiledLocal(NULL, 0, 1, envPtr);
     if (infoIndex < 0) {
-	return TCL_ERROR;
+	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
     }
 
     /*
@@ -1644,16 +1657,16 @@ TclCompileDictUpdateCmd(
 
     dictVarTokenPtr = TokenAfter(parsePtr->tokenPtr);
     if (dictVarTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	return TCL_ERROR;
+	return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
     }
     name = dictVarTokenPtr[1].start;
     nameChars = dictVarTokenPtr[1].size;
     if (!TclIsLocalScalar(name, nameChars)) {
-	return TCL_ERROR;
+	return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
     }
     dictIndex = TclFindCompiledLocal(name, nameChars, 1, envPtr);
     if (dictIndex < 0) {
-	return TCL_ERROR;
+	return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
     }
 
     /*
@@ -1704,7 +1717,7 @@ TclCompileDictUpdateCmd(
     failedUpdateInfoAssembly:
 	ckfree(duiPtr);
 	TclStackFree(interp, keyTokenPtrs);
-	return TCL_ERROR;
+	return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
     }
     bodyTokenPtr = tokenPtr;
 
@@ -1802,17 +1815,17 @@ TclCompileDictAppendCmd(
 
     tokenPtr = TokenAfter(parsePtr->tokenPtr);
     if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	return TCL_ERROR;
+	return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
     } else {
 	register const char *name = tokenPtr[1].start;
 	register int nameChars = tokenPtr[1].size;
 
 	if (!TclIsLocalScalar(name, nameChars)) {
-	    return TCL_ERROR;
+	    return TclCompileBasicMin2ArgCmd(interp, parsePtr,cmdPtr, envPtr);
 	}
 	dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, envPtr);
 	if (dictVarIndex < 0) {
-	    return TCL_ERROR;
+	    return TclCompileBasicMin2ArgCmd(interp, parsePtr,cmdPtr, envPtr);
 	}
     }
 
@@ -1863,16 +1876,16 @@ TclCompileDictLappendCmd(
     keyTokenPtr = TokenAfter(varTokenPtr);
     valueTokenPtr = TokenAfter(keyTokenPtr);
     if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	return TCL_ERROR;
+	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
     }
     name = varTokenPtr[1].start;
     nameChars = varTokenPtr[1].size;
     if (!TclIsLocalScalar(name, nameChars)) {
-	return TCL_ERROR;
+	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
     }
     dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, envPtr);
     if (dictVarIndex < 0) {
-	return TCL_ERROR;
+	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
     }
     CompileWord(envPtr, keyTokenPtr, interp, 3);
     CompileWord(envPtr, valueTokenPtr, interp, 4);
@@ -1916,7 +1929,7 @@ TclCompileDictWithCmd(
 	tokenPtr = TokenAfter(tokenPtr);
     }
     if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	return TCL_ERROR;
+	return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
     }
 
     /*
@@ -1928,7 +1941,8 @@ TclCompileDictWithCmd(
     for (ptr=tokenPtr[1].start,end=ptr+tokenPtr[1].size ; ptr!=end ; ptr++) {
 	if (*ptr!=' ' && *ptr!='\t' && *ptr!='\n' && *ptr!='\r') {
 	    if (envPtr->procPtr == NULL) {
-		return TCL_ERROR;
+		return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr,
+			envPtr);
 	    }
 	    bodyIsEmpty = 0;
 	    break;
@@ -3755,7 +3769,9 @@ TclCompileInfoCommandsCmd(
      * We require one compile-time known argument for the case we can compile.
      */
 
-    if (parsePtr->numWords != 2) {
+    if (parsePtr->numWords == 1) {
+	return TclCompileBasic0ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+    } else if (parsePtr->numWords != 2) {
 	return TCL_ERROR;
     }
     tokenPtr = TokenAfter(parsePtr->tokenPtr);
@@ -3792,7 +3808,7 @@ TclCompileInfoCommandsCmd(
 
   notCompilable:
     Tcl_DecrRefCount(objPtr);
-    return TCL_ERROR;
+    return TclCompileBasic1ArgCmd(interp, parsePtr, cmdPtr, envPtr);
 }
 
 int
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 6e31481..f73beca 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -448,7 +448,7 @@ TclCompileStringMatchCmd(
 
     if (parsePtr->numWords == 4) {
 	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	    return TCL_ERROR;
+	    return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
 	}
 	str = tokenPtr[1].start;
 	length = tokenPtr[1].size;
@@ -457,7 +457,7 @@ TclCompileStringMatchCmd(
 	     * Fail at run time, not in compilation.
 	     */
 
-	    return TCL_ERROR;
+	    return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
 	}
 	nocase = 1;
 	tokenPtr = TokenAfter(tokenPtr);
@@ -578,13 +578,13 @@ TclCompileStringMapCmd(
     Tcl_IncrRefCount(mapObj);
     if (!TclWordKnownAtCompileTime(mapTokenPtr, mapObj)) {
 	Tcl_DecrRefCount(mapObj);
-	return TCL_ERROR;
+	return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
     } else if (Tcl_ListObjGetElements(NULL, mapObj, &len, &objv) != TCL_OK) {
 	Tcl_DecrRefCount(mapObj);
-	return TCL_ERROR;
+	return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
     } else if (len != 2) {
 	Tcl_DecrRefCount(mapObj);
-	return TCL_ERROR;
+	return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
     }
 
     /*
diff --git a/unix/tclUnixCompat.c b/unix/tclUnixCompat.c
index f8f0080..e5929ba 100644
--- a/unix/tclUnixCompat.c
+++ b/unix/tclUnixCompat.c
@@ -993,11 +993,19 @@ TclWinCPUID(
 
     /* See: <http://en.wikipedia.org/wiki/CPUID> */
 #if defined(HAVE_CPUID)
+#if defined(__x86_64__) || defined(_M_AMD64) || defined (_M_X64)
+    __asm__ __volatile__("movq %%rbx, %%rsi     \n\t" /* save %rbx */
+                 "cpuid            \n\t"
+                 "xchgq %%rsi, %%rbx   \n\t" /* restore the old %rbx */
+                 : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3])
+                 : "a"(index));
+#else
     __asm__ __volatile__("mov %%ebx, %%esi     \n\t" /* save %ebx */
                  "cpuid            \n\t"
                  "xchg %%esi, %%ebx   \n\t" /* restore the old %ebx */
                  : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3])
                  : "a"(index));
+#endif
     status = TCL_OK;
 #endif
     return status;