summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclCompCmds.c200
-rw-r--r--generic/tclCompCmdsGR.c16
-rw-r--r--generic/tclCompExpr.c81
-rw-r--r--generic/tclCompile.c3
-rw-r--r--generic/tclCompile.h10
-rw-r--r--generic/tclEncoding.c12
-rw-r--r--generic/tclEvent.c14
-rw-r--r--generic/tclExecute.c8
-rw-r--r--generic/tclIO.c3
-rw-r--r--generic/tclInt.h4
-rw-r--r--generic/tclParse.c113
-rw-r--r--generic/tclThread.c4
12 files changed, 232 insertions, 236 deletions
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 18f4564..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
@@ -3289,16 +3298,7 @@ TclPushVarName(
nameChars = elNameChars = 0;
localIndex = -1;
- /*
- * Check not only that the type is TCL_TOKEN_SIMPLE_WORD, but whether
- * curly braces surround the variable name. This really matters for array
- * elements to handle things like
- * set {x($foo)} 5
- * which raises an undefined var error if we are not careful here.
- */
-
- if ((varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) &&
- (varTokenPtr->start[0] != '{')) {
+ if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
/*
* A simple variable name. Divide it up into "name" and "elName"
* strings. If it is not a local variable, look it up at runtime.
@@ -3322,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.
@@ -3337,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] == ')')) {
@@ -3373,9 +3373,10 @@ TclPushVarName(
nameChars = p - varTokenPtr[1].start;
elName = p + 1;
remainingChars = (varTokenPtr[2].start - p) - 1;
- elNameChars = (varTokenPtr[n].start-p) + varTokenPtr[n].size - 2;
+ 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.
@@ -3395,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;
+ }
}
}
}
@@ -3436,7 +3438,7 @@ TclPushVarName(
localIndex = -1;
}
}
- if (localIndex < 0) {
+ if (interp && localIndex < 0) {
PushLiteral(envPtr, name, nameChars);
}
@@ -3453,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/tclCompExpr.c b/generic/tclCompExpr.c
index 94c1bd6..38c1ceb 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -365,7 +365,7 @@ static const unsigned char prec[] = {
0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0,
+ 0,
/* Unary operator lexemes */
PREC_UNARY, /* UNARY_PLUS */
PREC_UNARY, /* UNARY_MINUS */
@@ -420,7 +420,7 @@ static const unsigned char instruction[] = {
0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0,
+ 0,
/* Unary operator lexemes */
INST_UPLUS, /* UNARY_PLUS */
INST_UMINUS, /* UNARY_MINUS */
@@ -488,7 +488,7 @@ static const unsigned char Lexeme[] = {
typedef struct JumpList {
JumpFixup jump; /* Pass this argument to matching calls of
- * TclEmitForwardJump() and
+ * TclEmitForwardJump() and
* TclFixupForwardJump(). */
struct JumpList *next; /* Point to next item on the stack */
} JumpList;
@@ -838,7 +838,7 @@ ParseExpr(
switch (lexeme) {
case NUMBER:
- case BOOLEAN:
+ case BOOLEAN:
/*
* TODO: Consider using a dict or hash to collapse all
* duplicate literals into a single representative value.
@@ -861,7 +861,7 @@ ParseExpr(
start += scanned;
numBytes -= scanned;
continue;
-
+
default:
break;
}
@@ -1324,7 +1324,7 @@ ParseExpr(
nodePtr->mark = MARK_LEFT;
nodePtr->left = complete;
- /*
+ /*
* The COMMA operator cannot be optimized, since the function
* needs all of its arguments, and optimization would reduce the
* number. Other binary operators root constant expressions when
@@ -1546,7 +1546,7 @@ ConvertTreeToTokens(
* Tcl_ParseExpr() we do not change them now. Internally, we can
* do better.
*/
-
+
int toCopy = tokenPtr->numComponents + 1;
if (tokenPtr->numComponents == tokenPtr[1].numComponents + 1) {
@@ -1562,7 +1562,7 @@ ConvertTreeToTokens(
subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR;
parsePtr->numTokens += toCopy;
} else {
- /*
+ /*
* Multiple element word. Create a TCL_TOKEN_SUB_EXPR token to
* lead, with fields initialized from the leading token, then
* copy entire set of word tokens.
@@ -1611,7 +1611,7 @@ ConvertTreeToTokens(
case COMMA:
case COLON:
- /*
+ /*
* Historical practice has been to have no Tcl_Tokens for
* these operators.
*/
@@ -1747,7 +1747,7 @@ ConvertTreeToTokens(
/*
* Before we leave this node/operator/subexpression for the
* last time, finish up its tokens....
- *
+ *
* Our current position scanning the string is where the
* substring for the subexpression ends.
*/
@@ -1967,7 +1967,7 @@ ParseLexeme(
case 'i':
if ((numBytes > 1) && (start[1] == 'n')
- && ((numBytes == 2) || !isalpha(UCHAR(start[2])))) {
+ && ((numBytes == 2) || start[2] & 0x80 || !isalpha(UCHAR(start[2])))) {
/*
* Must make this check so we can tell the difference between the
* "in" operator and the "int" function name and the "infinity"
@@ -1981,14 +1981,15 @@ ParseLexeme(
case 'e':
if ((numBytes > 1) && (start[1] == 'q')
- && ((numBytes == 2) || !isalpha(UCHAR(start[2])))) {
+ && ((numBytes == 2) || start[2] & 0x80 || !isalpha(UCHAR(start[2])))) {
*lexemePtr = STREQ;
return 2;
}
break;
case 'n':
- if ((numBytes > 1) && ((numBytes == 2) || !isalpha(UCHAR(start[2])))) {
+ if ((numBytes > 1)
+ && ((numBytes == 2) || start[2] & 0x80 || !isalpha(UCHAR(start[2])))) {
switch (start[1]) {
case 'e':
*lexemePtr = STRNEQ;
@@ -2003,9 +2004,8 @@ ParseLexeme(
literal = Tcl_NewObj();
if (TclParseNumber(NULL, literal, NULL, start, numBytes, &end,
TCL_PARSE_NO_WHITESPACE) == TCL_OK) {
- if (end < start + numBytes && !isalnum(UCHAR(*end))
- && UCHAR(*end) != '_') {
-
+ if (end < start + numBytes && !TclIsBareword(*end)) {
+
number:
TclInitStringRep(literal, start, end-start);
*lexemePtr = NUMBER;
@@ -2029,9 +2029,9 @@ ParseLexeme(
const char *p = start;
while (p < end) {
- if (!isalnum(UCHAR(*p++))) {
+ if (!TclIsBareword(*p++)) {
/*
- * The number has non-bareword characters, so we
+ * The number has non-bareword characters, so we
* must treat it as a number.
*/
goto number;
@@ -2054,33 +2054,30 @@ ParseLexeme(
}
}
- if (Tcl_UtfCharComplete(start, numBytes)) {
- scanned = Tcl_UtfToUniChar(start, &ch);
- } else {
- char utfBytes[TCL_UTF_MAX];
+ /*
+ * We reject leading underscores in bareword. No sensible reason why.
+ * Might be inspired by reserved identifier rules in C, which of course
+ * have no direct relevance here.
+ */
- memcpy(utfBytes, start, (size_t) numBytes);
- utfBytes[numBytes] = '\0';
- scanned = Tcl_UtfToUniChar(utfBytes, &ch);
- }
- if (!isalnum(UCHAR(ch))) {
- *lexemePtr = INVALID;
- Tcl_DecrRefCount(literal);
- return scanned;
- }
- end = start;
- while (isalnum(UCHAR(ch)) || (UCHAR(ch) == '_')) {
- end += scanned;
- numBytes -= scanned;
- if (Tcl_UtfCharComplete(end, numBytes)) {
- scanned = Tcl_UtfToUniChar(end, &ch);
+ if (!TclIsBareword(*start) || *start == '_') {
+ if (Tcl_UtfCharComplete(start, numBytes)) {
+ scanned = Tcl_UtfToUniChar(start, &ch);
} else {
char utfBytes[TCL_UTF_MAX];
- memcpy(utfBytes, end, (size_t) numBytes);
+ memcpy(utfBytes, start, (size_t) numBytes);
utfBytes[numBytes] = '\0';
scanned = Tcl_UtfToUniChar(utfBytes, &ch);
}
+ *lexemePtr = INVALID;
+ Tcl_DecrRefCount(literal);
+ return scanned;
+ }
+ end = start;
+ while (numBytes && TclIsBareword(*end)) {
+ end += 1;
+ numBytes -= 1;
}
*lexemePtr = BAREWORD;
if (literalPtr) {
@@ -2098,7 +2095,7 @@ ParseLexeme(
* TclCompileExpr --
*
* This procedure compiles a string containing a Tcl expression into Tcl
- * bytecodes.
+ * bytecodes.
*
* Results:
* None.
@@ -2333,7 +2330,7 @@ CompileExprTree(
* Use the numWords count we've kept to invoke the function
* command with the correct number of arguments.
*/
-
+
if (numWords < 255) {
TclEmitInvoke(envPtr, INST_INVOKE_STK1, numWords);
} else {
@@ -2427,7 +2424,7 @@ CompileExprTree(
const char *bytes = TclGetStringFromObj(literal, &length);
int index = TclRegisterNewLiteral(envPtr, bytes, length);
Tcl_Obj *objPtr = TclFetchLiteral(envPtr, index);
-
+
if ((objPtr->typePtr == NULL) && (literal->typePtr != NULL)) {
/*
* Would like to do this:
@@ -2570,7 +2567,7 @@ TclSingleOpCmd(
*
* TclSortingOpCmd --
* Implements the commands:
- * <, <=, >, >=, ==, eq
+ * <, <=, >, >=, ==, eq
* in the ::tcl::mathop namespace. These commands are defined for
* arbitrary number of arguments by computing the AND of the base
* operator applied to all neighbor argument pairs.
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 3736498..0f4dfaf 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -4342,10 +4342,11 @@ TclInitAuxDataTypeTable(void)
Tcl_InitHashTable(&auxDataTypeTable, TCL_STRING_KEYS);
/*
- * There are only three AuxData types at this time, so register them here.
+ * There are only four AuxData types at this time, so register them here.
*/
RegisterAuxDataType(&tclForeachInfoType);
+ RegisterAuxDataType(&tclNewForeachInfoType);
RegisterAuxDataType(&tclJumptableInfoType);
RegisterAuxDataType(&tclDictUpdateInfoType);
}
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 51f0b34..c6c7a7c 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 f33e0e6..2a766d1 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) {
@@ -2984,7 +2987,9 @@ TableFreeProc(
*/
ckfree(dataPtr->toUnicode);
+ dataPtr->toUnicode = NULL;
ckfree(dataPtr->fromUnicode);
+ dataPtr->fromUnicode = NULL;
ckfree(dataPtr);
}
@@ -3457,6 +3462,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 3985767..6ca22a6 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/tclExecute.c b/generic/tclExecute.c
index 337a75f..b9da8fc 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -5410,8 +5410,8 @@ TEBCresume(
s1 = (char *) Tcl_GetByteArrayFromObj(valuePtr, &s1len);
s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
memCmpFn = memcmp;
- } else if (((valuePtr->typePtr == &tclStringType)
- && (value2Ptr->typePtr == &tclStringType))) {
+ } else if ((valuePtr->typePtr == &tclStringType)
+ && (value2Ptr->typePtr == &tclStringType)) {
/*
* Do a unicode-specific comparison if both of the args are of
* String type. If the char length == byte length, we can do a
@@ -5422,7 +5422,9 @@ TEBCresume(
s1len = Tcl_GetCharLength(valuePtr);
s2len = Tcl_GetCharLength(value2Ptr);
if ((s1len == valuePtr->length)
- && (s2len == value2Ptr->length)) {
+ && (valuePtr->bytes != NULL)
+ && (s2len == value2Ptr->length)
+ && (value2Ptr->bytes != NULL)) {
s1 = valuePtr->bytes;
s2 = value2Ptr->bytes;
memCmpFn = memcmp;
diff --git a/generic/tclIO.c b/generic/tclIO.c
index f8b9bfa..79aa667 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -9216,6 +9216,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 860c2a3..3f84717 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2927,7 +2927,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);
@@ -2985,8 +2985,8 @@ 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[]);
MODULE_SCOPE int TclJoinThread(Tcl_ThreadId id, int *result);
MODULE_SCOPE void TclLimitRemoveAllHandlers(Tcl_Interp *interp);
diff --git a/generic/tclParse.c b/generic/tclParse.c
index ee0d4c4..5524979 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -621,6 +621,47 @@ TclIsSpaceProc(
/*
*----------------------------------------------------------------------
*
+ * TclIsBareword--
+ *
+ * Report whether byte is one that can be part of a "bareword".
+ * This concept is named in expression parsing, where it determines
+ * what can be a legal function name, but is the same definition used
+ * in determining what variable names can be parsed as variable
+ * substitutions without the benefit of enclosing braces. The set of
+ * ASCII chars that are accepted are the numeric chars ('0'-'9'),
+ * the alphabetic chars ('a'-'z', 'A'-'Z') and underscore ('_').
+ *
+ * Results:
+ * Returns 1, if byte is in the accepted set of chars, 0 otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclIsBareword(
+ char byte)
+{
+ if (byte < '0' || byte > 'z') {
+ return 0;
+ }
+ if (byte <= '9' || byte >= 'a') {
+ return 1;
+ }
+ if (byte == '_') {
+ return 1;
+ }
+ if (byte < 'A' || byte > 'Z') {
+ return 0;
+ }
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* ParseWhiteSpace --
*
* Scans up to numBytes bytes starting at src, consuming white space
@@ -1346,9 +1387,7 @@ Tcl_ParseVarName(
{
Tcl_Token *tokenPtr;
register const char *src;
- unsigned char c;
- int varIndex, offset;
- Tcl_UniChar ch;
+ int varIndex;
unsigned array;
if ((numBytes == 0) || (start == NULL)) {
@@ -1431,22 +1470,12 @@ Tcl_ParseVarName(
tokenPtr->numComponents = 0;
while (numBytes) {
- if (Tcl_UtfCharComplete(src, numBytes)) {
- offset = Tcl_UtfToUniChar(src, &ch);
- } else {
- char utfBytes[TCL_UTF_MAX];
-
- memcpy(utfBytes, src, (size_t) numBytes);
- utfBytes[numBytes] = '\0';
- offset = Tcl_UtfToUniChar(utfBytes, &ch);
- }
- c = UCHAR(ch);
- if (isalnum(c) || (c == '_')) { /* INTL: ISO only, UCHAR. */
- src += offset;
- numBytes -= offset;
+ if (TclIsBareword(*src)) {
+ src += 1;
+ numBytes -= 1;
continue;
}
- if ((c == ':') && (numBytes != 1) && (src[1] == ':')) {
+ if ((src[0] == ':') && (numBytes != 1) && (src[1] == ':')) {
src += 2;
numBytes -= 2;
while (numBytes && (*src == ':')) {
@@ -2497,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
*/
generated by cgit v0.12 at 2024-11-03 14:48:51 (GMT)