summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog13
-rw-r--r--doc/namespace.n2
-rw-r--r--doc/string.n4
-rw-r--r--generic/tclCompCmds.c108
-rw-r--r--generic/tclCompCmdsSZ.c10
5 files changed, 83 insertions, 54 deletions
diff --git a/ChangeLog b/ChangeLog
index 0c000b5..b4504b7 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,16 @@
+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
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/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);
}
/*
generated by cgit v0.12 at 2024-11-10 05:48:35 (GMT)