From 916f1716f3f7dcdc6dc158c684aac96698e9e726 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 9 Dec 2014 20:29:09 +0000 Subject: [e711ffb458] Replace TclIsLocalScalar() (which does the wrong thing).... with PushVarNameWord() (which doesn't) in the compiler for [dict lappend]. --- generic/tclCompCmds.c | 18 ++++++------------ generic/tclCompile.c | 4 ++-- 2 files changed, 8 insertions(+), 14 deletions(-) diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index c8ca828..7ecdc9b 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -1284,32 +1284,26 @@ TclCompileDictLappendCmd( * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { - Proc *procPtr = envPtr->procPtr; - DefineLineInformation; /* TIP #280 */ Tcl_Token *varTokenPtr, *keyTokenPtr, *valueTokenPtr; - int dictVarIndex, nameChars; - const char *name; + int isSimple, dictVarIndex = -1, isScalar = 0; + DefineLineInformation; /* TIP #280 */ /* * There must be three arguments after the command. */ - if (parsePtr->numWords != 4 || procPtr == NULL) { + if (parsePtr->numWords != 4) { return TCL_ERROR; } varTokenPtr = TokenAfter(parsePtr->tokenPtr); keyTokenPtr = TokenAfter(varTokenPtr); valueTokenPtr = TokenAfter(keyTokenPtr); - if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; - } - name = varTokenPtr[1].start; - nameChars = varTokenPtr[1].size; - if (!TclIsLocalScalar(name, nameChars)) { + PushVarNameWord(interp, varTokenPtr, envPtr, TCL_CREATE_VAR, + &dictVarIndex, &isSimple, &isScalar, 1); + if (!isScalar || dictVarIndex < 0) { return TCL_ERROR; } - dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, procPtr); CompileWord(envPtr, keyTokenPtr, interp, 2); CompileWord(envPtr, valueTokenPtr, interp, 3); TclEmitInstInt4( INST_DICT_LAPPEND, dictVarIndex, envPtr); diff --git a/generic/tclCompile.c b/generic/tclCompile.c index f982359..5030f89 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -2288,8 +2288,8 @@ TclFindCompiledLocal( * scalar or array variable. If NULL, a * temporary var should be created. */ int nameBytes, /* Number of bytes in the name. */ - int create, /* If 1, allocate a local frame entry for the - * variable if it is new. */ + int create, /* If non-zero, allocate a local frame entry + * for the variable if it is new. */ register Proc *procPtr) /* Points to structure describing procedure * containing the variable reference. */ { -- cgit v0.12 From 2d415cbf59016e2af60ee20e8b75f9cb26103aed Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 9 Dec 2014 20:45:30 +0000 Subject: [e711ffb458] Replace TclIsLocalScalar() with PushVarNameWord() in the compiler for [dict set]. --- generic/tclCompCmds.c | 20 +++++++------------- 1 file changed, 7 insertions(+), 13 deletions(-) diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 7ecdc9b..ec22f65 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -683,17 +683,15 @@ TclCompileDictSetCmd( CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *tokenPtr; - Proc *procPtr = envPtr->procPtr; - DefineLineInformation; /* TIP #280 */ Tcl_Token *varTokenPtr; - int i, dictVarIndex, nameChars; - const char *name; + int i, isSimple, isScalar = 0, dictVarIndex = -1; + DefineLineInformation; /* TIP #280 */ /* - * There must be at least one argument after the command. + * There must be at least three arguments after the (sub-)command. */ - if (parsePtr->numWords < 4 || procPtr == NULL) { + if (parsePtr->numWords < 4) { return TCL_ERROR; } @@ -704,15 +702,11 @@ TclCompileDictSetCmd( */ varTokenPtr = TokenAfter(parsePtr->tokenPtr); - if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; - } - name = varTokenPtr[1].start; - nameChars = varTokenPtr[1].size; - if (!TclIsLocalScalar(name, nameChars)) { + PushVarNameWord(interp, varTokenPtr, envPtr, TCL_CREATE_VAR, + &dictVarIndex, &isSimple, &isScalar, 1); + if (!isScalar || dictVarIndex < 0) { return TCL_ERROR; } - dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, procPtr); /* * Remaining words (key path and value to set) can be handled normally. -- cgit v0.12 From 26326004c63514e3b84d7a3268d5177bf0d18894 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 11 Dec 2014 14:40:02 +0000 Subject: [e711ffb458] Same conversion for [catch] compiler. --- generic/tclCompCmds.c | 43 +++++++------------------------------------ 1 file changed, 7 insertions(+), 36 deletions(-) diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index ec22f65..10cba39 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -379,8 +379,7 @@ TclCompileCatchCmd( { JumpFixup jumpFixup; Tcl_Token *cmdTokenPtr, *resultNameTokenPtr, *optsNameTokenPtr; - const char *name; - int resultIndex, optsIndex, nameChars, range; + int resultIndex, optsIndex, isSimple, isScalar, range; int initStackDepth = envPtr->currStackDepth; int savedStackDepth; DefineLineInformation; /* TIP #280 */ @@ -395,15 +394,6 @@ TclCompileCatchCmd( } /* - * If variables were specified and the catch command is at global level - * (not in a procedure), don't compile it inline: the payoff is too small. - */ - - if ((parsePtr->numWords >= 3) && (envPtr->procPtr == NULL)) { - return TCL_ERROR; - } - - /* * Make sure the variable names, if any, have no substitutions and just * refer to local scalars. */ @@ -412,36 +402,17 @@ TclCompileCatchCmd( cmdTokenPtr = TokenAfter(parsePtr->tokenPtr); if (parsePtr->numWords >= 3) { resultNameTokenPtr = TokenAfter(cmdTokenPtr); - /* DGP */ - if (resultNameTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { + PushVarNameWord(interp, resultNameTokenPtr, envPtr, TCL_CREATE_VAR, + &resultIndex, &isSimple, &isScalar, 2); + if (!isScalar || resultIndex < 0) { return TCL_ERROR; } - name = resultNameTokenPtr[1].start; - nameChars = resultNameTokenPtr[1].size; - if (!TclIsLocalScalar(name, nameChars)) { - return TCL_ERROR; - } - resultIndex = TclFindCompiledLocal(resultNameTokenPtr[1].start, - resultNameTokenPtr[1].size, /*create*/ 1, envPtr->procPtr); - if (resultIndex < 0) { - return TCL_ERROR; - } - - /* DKF */ if (parsePtr->numWords == 4) { optsNameTokenPtr = TokenAfter(resultNameTokenPtr); - if (optsNameTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; - } - name = optsNameTokenPtr[1].start; - nameChars = optsNameTokenPtr[1].size; - if (!TclIsLocalScalar(name, nameChars)) { - return TCL_ERROR; - } - optsIndex = TclFindCompiledLocal(optsNameTokenPtr[1].start, - optsNameTokenPtr[1].size, /*create*/ 1, envPtr->procPtr); - if (optsIndex < 0) { + PushVarNameWord(interp, optsNameTokenPtr, envPtr, TCL_CREATE_VAR, + &optsIndex, &isSimple, &isScalar, 2); + if (!isScalar || resultIndex < 0) { return TCL_ERROR; } } -- cgit v0.12 From a417c667a52117af242053c93f3526069187ef95 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 11 Dec 2014 14:41:09 +0000 Subject: Get the word number right, even though it has no effect. --- generic/tclCompCmds.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 10cba39..e0dee13 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -411,7 +411,7 @@ TclCompileCatchCmd( if (parsePtr->numWords == 4) { optsNameTokenPtr = TokenAfter(resultNameTokenPtr); PushVarNameWord(interp, optsNameTokenPtr, envPtr, TCL_CREATE_VAR, - &optsIndex, &isSimple, &isScalar, 2); + &optsIndex, &isSimple, &isScalar, 3); if (!isScalar || resultIndex < 0) { return TCL_ERROR; } -- cgit v0.12 From 8e80c62f6f65a921aa7f69158b13f2e849f17439 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 11 Dec 2014 15:19:38 +0000 Subject: Similar revisions to [dict incr] compiler. --- generic/tclCompCmds.c | 60 +++++++++++++++++++-------------------------------- 1 file changed, 22 insertions(+), 38 deletions(-) diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index e0dee13..33598e7 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -707,20 +707,31 @@ TclCompileDictIncrCmd( * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { - Proc *procPtr = envPtr->procPtr; - DefineLineInformation; /* TIP #280 */ Tcl_Token *varTokenPtr, *keyTokenPtr; - int dictVarIndex, nameChars, incrAmount; - const char *name; + int dictVarIndex, incrAmount, isScalar, isSimple; + DefineLineInformation; /* TIP #280 */ /* * There must be at least two arguments after the command. */ - if (parsePtr->numWords < 3 || parsePtr->numWords > 4 || procPtr == NULL) { + if (parsePtr->numWords < 3 || parsePtr->numWords > 4) { return TCL_ERROR; } + + /* + * The dictionary variable must be a local scalar that is knowable at + * compile time; anything else exceeds the complexity of the opcode. So + * discover what the index is. + */ + varTokenPtr = TokenAfter(parsePtr->tokenPtr); + PushVarNameWord(interp, varTokenPtr, envPtr, TCL_CREATE_VAR, + &dictVarIndex, &isSimple, &isScalar, 1); + if (!isScalar || dictVarIndex < 0) { + return TCL_ERROR; + } + keyTokenPtr = TokenAfter(varTokenPtr); /* @@ -728,23 +739,12 @@ TclCompileDictIncrCmd( */ if (parsePtr->numWords == 4) { - const char *word; - int numBytes, code; - Tcl_Token *incrTokenPtr; - Tcl_Obj *intObj; - - incrTokenPtr = TokenAfter(keyTokenPtr); - if (incrTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; - } - word = incrTokenPtr[1].start; - numBytes = incrTokenPtr[1].size; - - intObj = Tcl_NewStringObj(word, numBytes); - Tcl_IncrRefCount(intObj); - code = TclGetIntFromObj(NULL, intObj, &incrAmount); - TclDecrRefCount(intObj); - if (code != TCL_OK) { + Tcl_Token *incrTokenPtr = TokenAfter(keyTokenPtr); + Tcl_Obj *intObj = Tcl_NewObj(); + int fail = (!TclWordKnownAtCompileTime(incrTokenPtr, intObj) + || TCL_ERROR == TclGetIntFromObj(NULL, intObj, &incrAmount)); + Tcl_DecrRefCount(intObj); + if (fail) { return TCL_ERROR; } } else { @@ -752,22 +752,6 @@ TclCompileDictIncrCmd( } /* - * The dictionary variable must be a local scalar that is knowable at - * compile time; anything else exceeds the complexity of the opcode. So - * discover what the index is. - */ - - if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; - } - name = varTokenPtr[1].start; - nameChars = varTokenPtr[1].size; - if (!TclIsLocalScalar(name, nameChars)) { - return TCL_ERROR; - } - dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, procPtr); - - /* * Emit the key and the code to actually do the increment. */ -- cgit v0.12 From 604faa265f3f4197582673cddb2acd4c7a0ef6a5 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 11 Dec 2014 15:45:16 +0000 Subject: Similar conversion for [dict update] compiler. --- generic/tclCompCmds.c | 45 +++++++++++++++------------------------------ 1 file changed, 15 insertions(+), 30 deletions(-) diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 33598e7..0c5b19d 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -818,7 +818,7 @@ TclCompileDictForCmd( Tcl_DString buffer; /* - * There must be at least three argument after the command. + * There must be exactly three arguments after the command. */ if (parsePtr->numWords != 4 || procPtr == NULL) { @@ -1004,21 +1004,11 @@ TclCompileDictUpdateCmd( * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { - Proc *procPtr = envPtr->procPtr; - DefineLineInformation; /* TIP #280 */ - const char *name; - int i, nameChars, dictIndex, numVars, range, infoIndex; + int i, dictIndex, numVars, range, infoIndex, isSimple, isScalar; Tcl_Token **keyTokenPtrs, *dictVarTokenPtr, *bodyTokenPtr, *tokenPtr; DictUpdateInfo *duiPtr; JumpFixup jumpFixup; - - /* - * There must be at least one argument after the command. - */ - - if (parsePtr->numWords < 5 || procPtr == NULL) { - return TCL_ERROR; - } + DefineLineInformation; /* TIP #280 */ /* * Parse the command. Expect the following: @@ -1029,6 +1019,9 @@ TclCompileDictUpdateCmd( return TCL_ERROR; } numVars = (parsePtr->numWords - 3) / 2; + if (numVars < 1) { + return TCL_ERROR; + } /* * The dictionary variable must be a local scalar that is knowable at @@ -1037,15 +1030,11 @@ TclCompileDictUpdateCmd( */ dictVarTokenPtr = TokenAfter(parsePtr->tokenPtr); - if (dictVarTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; - } - name = dictVarTokenPtr[1].start; - nameChars = dictVarTokenPtr[1].size; - if (!TclIsLocalScalar(name, nameChars)) { + PushVarNameWord(interp, dictVarTokenPtr, envPtr, TCL_CREATE_VAR, + &dictIndex, &isSimple, &isScalar, 1); + if (!isScalar || dictIndex < 0) { return TCL_ERROR; } - dictIndex = TclFindCompiledLocal(name, nameChars, 1, procPtr); /* * Assemble the instruction metadata. This is complex enough that it is @@ -1061,6 +1050,8 @@ TclCompileDictUpdateCmd( tokenPtr = TokenAfter(dictVarTokenPtr); for (i=0 ; itype != TCL_TOKEN_SIMPLE_WORD) { - ckfree((char *) duiPtr); - TclStackFree(interp, keyTokenPtrs); - return TCL_ERROR; - } - name = tokenPtr[1].start; - nameChars = tokenPtr[1].size; - if (!TclIsLocalScalar(name, nameChars)) { + PushVarNameWord(interp, tokenPtr, envPtr, TCL_CREATE_VAR, + &index, &isSimple, &isScalar, 1); + if (!isScalar || index < 0) { ckfree((char *) duiPtr); TclStackFree(interp, keyTokenPtrs); return TCL_ERROR; @@ -1089,8 +1075,7 @@ TclCompileDictUpdateCmd( * Stash the index in the auxiliary data. */ - duiPtr->varIndices[i] = - TclFindCompiledLocal(name, nameChars, 1, procPtr); + duiPtr->varIndices[i] = index; tokenPtr = TokenAfter(tokenPtr); } if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { -- cgit v0.12 From ee5c231ff5dde87b4436f0de5fa6a6059df4b774 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 11 Dec 2014 16:00:19 +0000 Subject: Similar conversion of the [dict append] compiler. --- generic/tclCompCmds.c | 25 +++++++++---------------- 1 file changed, 9 insertions(+), 16 deletions(-) diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 0c5b19d..a0f493c 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -1156,18 +1156,17 @@ TclCompileDictAppendCmd( * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { - Proc *procPtr = envPtr->procPtr; - DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; - int i, dictVarIndex; + int i, isSimple, isScalar, dictVarIndex; + DefineLineInformation; /* TIP #280 */ /* - * There must be at least two argument after the command. And we impose an - * (arbirary) safe limit; anyone exceeding it should stop worrying about - * speed quite so much. ;-) + * There must be at least two argument after the command. Since we + * implement using INST_CONCAT1, make sure the number of arguments + * stays within its range. */ - if (parsePtr->numWords<4 || parsePtr->numWords>100 || procPtr==NULL) { + if (parsePtr->numWords<4 || parsePtr->numWords>258) { return TCL_ERROR; } @@ -1176,16 +1175,10 @@ TclCompileDictAppendCmd( */ tokenPtr = TokenAfter(parsePtr->tokenPtr); - if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { + PushVarNameWord(interp, tokenPtr, envPtr, TCL_CREATE_VAR, + &dictVarIndex, &isSimple, &isScalar, 1); + if (!isScalar || dictVarIndex < 0) { return TCL_ERROR; - } else { - register const char *name = tokenPtr[1].start; - register int nameChars = tokenPtr[1].size; - - if (!TclIsLocalScalar(name, nameChars)) { - return TCL_ERROR; - } - dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, procPtr); } /* -- cgit v0.12 From d56e61b246f06cd10844c54a54f2d04aa4d47ade Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 18 Dec 2014 19:21:31 +0000 Subject: Shift the allocation of AuxData earlier in the [foreach] compiler. --- generic/tclCompCmds.c | 41 +++++++++++++++++++++++++---------------- 1 file changed, 25 insertions(+), 16 deletions(-) diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index a0f493c..f07b19f 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -1536,7 +1536,7 @@ TclCompileForeachCmd( CompileEnv *envPtr) /* Holds resulting instructions. */ { 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. */ int firstValueTemp; /* Index of the first temp var in the frame @@ -1599,6 +1599,16 @@ TclCompileForeachCmd( memset((char*) varvList, 0, numLists * sizeof(const char **)); /* + * Create and initialize the ForeachInfo and ForeachVarList data + * structures describing this command. Then create a AuxData record + * pointing to the ForeachInfo structure. + */ + + infoPtr = (ForeachInfo *) ckalloc((unsigned) + sizeof(ForeachInfo) + numLists*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 * compile the foreach inline if any var name needs substitutions or isn't * a scalar, or if any var list needs substitutions. @@ -1609,6 +1619,7 @@ TclCompileForeachCmd( i < numWords-1; i++, tokenPtr = TokenAfter(tokenPtr)) { Tcl_DString varList; + ForeachVarList *varListPtr; if (i%2 != 1) { continue; @@ -1634,6 +1645,12 @@ TclCompileForeachCmd( } numVars = varcList[loopIndex]; + varListPtr = (ForeachVarList *) ckalloc((unsigned) + sizeof(ForeachVarList) + numVars*sizeof(int)); + varListPtr->numVars = numVars; + infoPtr->varLists[loopIndex] = varListPtr; + infoPtr->numLists++; + /* * If the variable list is empty, we can enter an infinite loop when * the interpreted version would not. Take care to ensure this does @@ -1678,23 +1695,11 @@ TclCompileForeachCmd( loopCtTemp = TclFindCompiledLocal(NULL, /*nameChars*/ 0, /*create*/ 1, procPtr); - /* - * Create and initialize the ForeachInfo and ForeachVarList data - * structures describing this command. Then create a AuxData record - * pointing to the ForeachInfo structure. - */ - - infoPtr = (ForeachInfo *) ckalloc((unsigned) - sizeof(ForeachInfo) + numLists*sizeof(ForeachVarList *)); - infoPtr->numLists = numLists; infoPtr->firstValueTemp = firstValueTemp; infoPtr->loopCtTemp = loopCtTemp; for (loopIndex = 0; loopIndex < numLists; loopIndex++) { - ForeachVarList *varListPtr; - numVars = varcList[loopIndex]; - varListPtr = (ForeachVarList *) ckalloc((unsigned) - sizeof(ForeachVarList) + numVars*sizeof(int)); - varListPtr->numVars = numVars; + ForeachVarList *varListPtr = infoPtr->varLists[loopIndex]; + numVars = varListPtr->numVars; for (j = 0; j < numVars; j++) { const char *varName = varvList[loopIndex][j]; int nameChars = strlen(varName); @@ -1702,7 +1707,6 @@ TclCompileForeachCmd( varListPtr->varIndexes[j] = TclFindCompiledLocal(varName, nameChars, /*create*/ 1, procPtr); } - infoPtr->varLists[loopIndex] = varListPtr; } infoIndex = TclCreateAuxData(infoPtr, &tclForeachInfoType, envPtr); @@ -1816,6 +1820,11 @@ TclCompileForeachCmd( envPtr->currStackDepth = savedStackDepth + 1; done: + if (code == TCL_ERROR) { + if (infoPtr) { + FreeForeachInfo(infoPtr); + } + } for (loopIndex = 0; loopIndex < numLists; loopIndex++) { if (varvList[loopIndex] != NULL) { ckfree((char *) varvList[loopIndex]); -- cgit v0.12 From f664d633e6a5f16b3af12c6b9fa406636711068c Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 18 Dec 2014 20:34:12 +0000 Subject: With that shift, varcList is no longer needed. --- generic/tclCompCmds.c | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index f07b19f..739bf21 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -1553,11 +1553,9 @@ TclCompileForeachCmd( /* * 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; /* @@ -1592,8 +1590,6 @@ TclCompileForeachCmd( */ numLists = (numWords - 2)/2; - varcList = (int *) 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 **)); @@ -1637,13 +1633,12 @@ TclCompileForeachCmd( Tcl_DStringInit(&varList); Tcl_DStringAppend(&varList, tokenPtr[1].start, tokenPtr[1].size); code = Tcl_SplitList(interp, Tcl_DStringValue(&varList), - &varcList[loopIndex], &varvList[loopIndex]); + &numVars, &varvList[loopIndex]); Tcl_DStringFree(&varList); if (code != TCL_OK) { code = TCL_ERROR; goto done; } - numVars = varcList[loopIndex]; varListPtr = (ForeachVarList *) ckalloc((unsigned) sizeof(ForeachVarList) + numVars*sizeof(int)); @@ -1831,7 +1826,6 @@ TclCompileForeachCmd( } } TclStackFree(interp, (void *)varvList); - TclStackFree(interp, varcList); return code; } -- cgit v0.12 From 89e6a65411bda475baf46fcc2b3cf36c2eb81b4c Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 18 Dec 2014 20:38:53 +0000 Subject: Simplify creation and storage of temporaries --- generic/tclCompCmds.c | 24 +++++++----------------- 1 file changed, 7 insertions(+), 17 deletions(-) diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 739bf21..d2d14f0 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -1539,10 +1539,6 @@ TclCompileForeachCmd( ForeachInfo *infoPtr = NULL;/* Points to the structure describing this * foreach command. Stored in a AuxData * record in the ByteCode. */ - int firstValueTemp; /* Index of the first temp var in the frame - * used to point to a value list. */ - int loopCtTemp; /* Index of temp var holding the loop's - * iteration count. */ Tcl_Token *tokenPtr, *bodyTokenPtr; unsigned char *jumpPc; JumpFixup jumpFalseFixup; @@ -1679,19 +1675,14 @@ TclCompileForeachCmd( */ code = TCL_OK; - firstValueTemp = -1; - for (loopIndex = 0; loopIndex < numLists; loopIndex++) { - tempVar = TclFindCompiledLocal(NULL, /*nameChars*/ 0, - /*create*/ 1, procPtr); - if (loopIndex == 0) { - firstValueTemp = tempVar; - } + + tempVar = TclFindCompiledLocal(NULL, 0, 1, procPtr); + infoPtr->firstValueTemp = tempVar; + for (loopIndex = 1; loopIndex < numLists; loopIndex++) { + TclFindCompiledLocal(NULL, 0, 1, procPtr); } - loopCtTemp = TclFindCompiledLocal(NULL, /*nameChars*/ 0, - /*create*/ 1, procPtr); + infoPtr->loopCtTemp = TclFindCompiledLocal(NULL, 0, 1, procPtr); - infoPtr->firstValueTemp = firstValueTemp; - infoPtr->loopCtTemp = loopCtTemp; for (loopIndex = 0; loopIndex < numLists; loopIndex++) { ForeachVarList *varListPtr = infoPtr->varLists[loopIndex]; numVars = varListPtr->numVars; @@ -1722,14 +1713,13 @@ TclCompileForeachCmd( if ((i%2 == 0) && (i > 0)) { SetLineInformation (i); CompileTokens(envPtr, tokenPtr, interp); - tempVar = (firstValueTemp + loopIndex); if (tempVar <= 255) { TclEmitInstInt1(INST_STORE_SCALAR1, tempVar, envPtr); } else { TclEmitInstInt4(INST_STORE_SCALAR4, tempVar, envPtr); } TclEmitOpcode(INST_POP, envPtr); - loopIndex++; + loopIndex++; tempVar++; } } -- cgit v0.12 From 24817641b1ed1c0c461993db32e92d2a947319de Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 18 Dec 2014 21:08:53 +0000 Subject: Replace use of TclIsLocalScalar() and late setting of varIndexes with an earlier setting of varIndexes using PushVarNameWord(). --- generic/tclCompCmds.c | 44 +++++++++++++++++++++++++++++--------------- 1 file changed, 29 insertions(+), 15 deletions(-) diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index d2d14f0..bae1fd1 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -1545,6 +1545,7 @@ TclCompileForeachCmd( int jumpBackDist, jumpBackOffset, infoIndex, range; int numWords, numLists, numVars, loopIndex, tempVar, i, j, code; int savedStackDepth = envPtr->currStackDepth; + Tcl_Obj *varListObj = NULL; DefineLineInformation; /* TIP #280 */ /* @@ -1607,6 +1608,7 @@ TclCompileForeachCmd( */ loopIndex = 0; + varListObj = Tcl_NewObj(); for (i = 0, tokenPtr = parsePtr->tokenPtr; i < numWords-1; i++, tokenPtr = TokenAfter(tokenPtr)) { @@ -1616,7 +1618,16 @@ TclCompileForeachCmd( if (i%2 != 1) { continue; } - if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { + + /* + * 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] + */ + + if (!TclWordKnownAtCompileTime(tokenPtr, varListObj) || + TCL_OK != Tcl_ListObjLength(NULL, varListObj, &numVars) || + numVars == 0) { code = TCL_ERROR; goto done; } @@ -1642,25 +1653,23 @@ TclCompileForeachCmd( infoPtr->varLists[loopIndex] = varListPtr; infoPtr->numLists++; - /* - * 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] - */ - - if (numVars == 0) { - code = TCL_ERROR; - goto done; - } - for (j = 0; j < numVars; j++) { - const char *varName = varvList[loopIndex][j]; - - if (!TclIsLocalScalar(varName, (int) strlen(varName))) { + Tcl_Obj *varNameObj; + Tcl_Token token; + int varIndex, isSimple, isScalar; + + Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj); + token.start = Tcl_GetStringFromObj(varNameObj, &token.size); + PushVarNameWord(interp, &token, envPtr, TCL_CREATE_VAR, + &varIndex, &isSimple, &isScalar, 0 /* ignored */); + if (!isScalar || varIndex < 0) { code = TCL_ERROR; goto done; } + varListPtr->varIndexes[j] = varIndex; } + + Tcl_SetObjLength(varListObj, 0); loopIndex++; } @@ -1683,6 +1692,7 @@ TclCompileForeachCmd( } infoPtr->loopCtTemp = TclFindCompiledLocal(NULL, 0, 1, procPtr); +#if 0 for (loopIndex = 0; loopIndex < numLists; loopIndex++) { ForeachVarList *varListPtr = infoPtr->varLists[loopIndex]; numVars = varListPtr->numVars; @@ -1694,6 +1704,7 @@ TclCompileForeachCmd( nameChars, /*create*/ 1, procPtr); } } +#endif infoIndex = TclCreateAuxData(infoPtr, &tclForeachInfoType, envPtr); /* @@ -1810,6 +1821,9 @@ TclCompileForeachCmd( FreeForeachInfo(infoPtr); } } + if (varListObj) { + Tcl_DecrRefCount(varListObj); + } for (loopIndex = 0; loopIndex < numLists; loopIndex++) { if (varvList[loopIndex] != NULL) { ckfree((char *) varvList[loopIndex]); -- cgit v0.12 From 893c9c730286e9cdb5d98d190d4ff5877fd47efb Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 18 Dec 2014 21:29:07 +0000 Subject: Fix up the token array passed to PushVarNameWord. Remove string list parse. --- generic/tclCompCmds.c | 39 ++++++--------------------------------- 1 file changed, 6 insertions(+), 33 deletions(-) diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index bae1fd1..6fa1e71 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -1543,7 +1543,7 @@ TclCompileForeachCmd( unsigned char *jumpPc; JumpFixup jumpFalseFixup; int jumpBackDist, jumpBackOffset, infoIndex, range; - int numWords, numLists, numVars, loopIndex, tempVar, i, j, code; + int numWords, numLists, numVars, loopIndex, tempVar, i, j, code = TCL_OK; int savedStackDepth = envPtr->currStackDepth; Tcl_Obj *varListObj = NULL; DefineLineInformation; /* TIP #280 */ @@ -1612,7 +1612,6 @@ TclCompileForeachCmd( for (i = 0, tokenPtr = parsePtr->tokenPtr; i < numWords-1; i++, tokenPtr = TokenAfter(tokenPtr)) { - Tcl_DString varList; ForeachVarList *varListPtr; if (i%2 != 1) { @@ -1632,21 +1631,6 @@ TclCompileForeachCmd( goto done; } - /* - * Lots of copying going on here. Need a ListObj wizard to show a - * better way. - */ - - Tcl_DStringInit(&varList); - Tcl_DStringAppend(&varList, tokenPtr[1].start, tokenPtr[1].size); - code = Tcl_SplitList(interp, Tcl_DStringValue(&varList), - &numVars, &varvList[loopIndex]); - Tcl_DStringFree(&varList); - if (code != TCL_OK) { - code = TCL_ERROR; - goto done; - } - varListPtr = (ForeachVarList *) ckalloc((unsigned) sizeof(ForeachVarList) + numVars*sizeof(int)); varListPtr->numVars = numVars; @@ -1655,12 +1639,14 @@ TclCompileForeachCmd( for (j = 0; j < numVars; j++) { Tcl_Obj *varNameObj; - Tcl_Token token; + Tcl_Token token[2]; int varIndex, isSimple, isScalar; Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj); - token.start = Tcl_GetStringFromObj(varNameObj, &token.size); - PushVarNameWord(interp, &token, envPtr, TCL_CREATE_VAR, + token[0].type = TCL_TOKEN_SIMPLE_WORD; + token[0].numComponents = 1; + token[1].start = Tcl_GetStringFromObj(varNameObj, &token[1].size); + PushVarNameWord(interp, token, envPtr, TCL_CREATE_VAR, &varIndex, &isSimple, &isScalar, 0 /* ignored */); if (!isScalar || varIndex < 0) { code = TCL_ERROR; @@ -1692,19 +1678,6 @@ TclCompileForeachCmd( } infoPtr->loopCtTemp = TclFindCompiledLocal(NULL, 0, 1, procPtr); -#if 0 - for (loopIndex = 0; loopIndex < numLists; loopIndex++) { - ForeachVarList *varListPtr = infoPtr->varLists[loopIndex]; - numVars = varListPtr->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, procPtr); - } - } -#endif infoIndex = TclCreateAuxData(infoPtr, &tclForeachInfoType, envPtr); /* -- cgit v0.12 From f65cb994d8c1ae7358d383f10c983758eb59fdf0 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 18 Dec 2014 22:00:08 +0000 Subject: No need for varvList any more. --- generic/tclCompCmds.c | 27 ++------------------------- 1 file changed, 2 insertions(+), 25 deletions(-) diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 6fa1e71..1bafbe2 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -1549,13 +1549,6 @@ TclCompileForeachCmd( DefineLineInformation; /* TIP #280 */ /* - * We parse the variable list argument words and create two arrays: - * varvList[i] points to array of var names in i-th var list. - */ - - const char ***varvList; - - /* * If the foreach command isn't in a procedure, don't compile it inline: * the payoff is too small. */ @@ -1583,26 +1576,18 @@ TclCompileForeachCmd( } /* - * Allocate storage for the varcList and varvList arrays if necessary. - */ - - numLists = (numWords - 2)/2; - varvList = (const char ***) TclStackAlloc(interp, - numLists * sizeof(const char **)); - memset((char*) varvList, 0, numLists * sizeof(const char **)); - - /* * 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; infoPtr = (ForeachInfo *) ckalloc((unsigned) sizeof(ForeachInfo) + numLists*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. */ @@ -1669,8 +1654,6 @@ TclCompileForeachCmd( * nonoverlapping foreach loops, they don't share any temps. */ - code = TCL_OK; - tempVar = TclFindCompiledLocal(NULL, 0, 1, procPtr); infoPtr->firstValueTemp = tempVar; for (loopIndex = 1; loopIndex < numLists; loopIndex++) { @@ -1797,12 +1780,6 @@ TclCompileForeachCmd( if (varListObj) { Tcl_DecrRefCount(varListObj); } - for (loopIndex = 0; loopIndex < numLists; loopIndex++) { - if (varvList[loopIndex] != NULL) { - ckfree((char *) varvList[loopIndex]); - } - } - TclStackFree(interp, (void *)varvList); return code; } -- cgit v0.12 From aed72bee30f449ec04643ceb42df9d45b635892e Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 18 Dec 2014 22:13:11 +0000 Subject: No need for a loopIndex. --- generic/tclCompCmds.c | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 1bafbe2..0030f62 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -1543,7 +1543,7 @@ TclCompileForeachCmd( unsigned char *jumpPc; JumpFixup jumpFalseFixup; int jumpBackDist, jumpBackOffset, infoIndex, range; - int numWords, numLists, numVars, loopIndex, tempVar, i, j, code = TCL_OK; + int numWords, numLists, numVars, tempVar, i, j, code = TCL_OK; int savedStackDepth = envPtr->currStackDepth; Tcl_Obj *varListObj = NULL; DefineLineInformation; /* TIP #280 */ @@ -1592,7 +1592,6 @@ TclCompileForeachCmd( * a scalar, or if any var list needs substitutions. */ - loopIndex = 0; varListObj = Tcl_NewObj(); for (i = 0, tokenPtr = parsePtr->tokenPtr; i < numWords-1; @@ -1619,7 +1618,7 @@ TclCompileForeachCmd( varListPtr = (ForeachVarList *) ckalloc((unsigned) sizeof(ForeachVarList) + numVars*sizeof(int)); varListPtr->numVars = numVars; - infoPtr->varLists[loopIndex] = varListPtr; + infoPtr->varLists[i/2] = varListPtr; infoPtr->numLists++; for (j = 0; j < numVars; j++) { @@ -1641,7 +1640,6 @@ TclCompileForeachCmd( } Tcl_SetObjLength(varListObj, 0); - loopIndex++; } /* @@ -1656,7 +1654,7 @@ TclCompileForeachCmd( tempVar = TclFindCompiledLocal(NULL, 0, 1, procPtr); infoPtr->firstValueTemp = tempVar; - for (loopIndex = 1; loopIndex < numLists; loopIndex++) { + for (i= 1; i < numLists; i++) { TclFindCompiledLocal(NULL, 0, 1, procPtr); } infoPtr->loopCtTemp = TclFindCompiledLocal(NULL, 0, 1, procPtr); @@ -1673,7 +1671,6 @@ TclCompileForeachCmd( * Evaluate then store each value list in the associated temporary. */ - loopIndex = 0; for (i = 0, tokenPtr = parsePtr->tokenPtr; i < numWords-1; i++, tokenPtr = TokenAfter(tokenPtr)) { @@ -1686,7 +1683,7 @@ TclCompileForeachCmd( TclEmitInstInt4(INST_STORE_SCALAR4, tempVar, envPtr); } TclEmitOpcode(INST_POP, envPtr); - loopIndex++; tempVar++; + tempVar++; } } -- cgit v0.12 From ad195509092cfe037495a4817597fccf012bf686 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 18 Dec 2014 22:25:27 +0000 Subject: A bit more tidying... --- generic/tclCompCmds.c | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 0030f62..002012e 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -1540,6 +1540,7 @@ TclCompileForeachCmd( * foreach command. Stored in a AuxData * record in the ByteCode. */ Tcl_Token *tokenPtr, *bodyTokenPtr; + Tcl_Token token[2]; unsigned char *jumpPc; JumpFixup jumpFalseFixup; int jumpBackDist, jumpBackOffset, infoIndex, range; @@ -1593,6 +1594,8 @@ TclCompileForeachCmd( */ varListObj = Tcl_NewObj(); + token[0].type = TCL_TOKEN_SIMPLE_WORD; + token[0].numComponents = 1; for (i = 0, tokenPtr = parsePtr->tokenPtr; i < numWords-1; i++, tokenPtr = TokenAfter(tokenPtr)) { @@ -1623,12 +1626,9 @@ TclCompileForeachCmd( for (j = 0; j < numVars; j++) { Tcl_Obj *varNameObj; - Tcl_Token token[2]; int varIndex, isSimple, isScalar; Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj); - token[0].type = TCL_TOKEN_SIMPLE_WORD; - token[0].numComponents = 1; token[1].start = Tcl_GetStringFromObj(varNameObj, &token[1].size); PushVarNameWord(interp, token, envPtr, TCL_CREATE_VAR, &varIndex, &isSimple, &isScalar, 0 /* ignored */); @@ -1638,13 +1638,11 @@ TclCompileForeachCmd( } varListPtr->varIndexes[j] = varIndex; } - Tcl_SetObjLength(varListObj, 0); } /* - * We will compile the foreach command. Reserve (numLists + 1) temporary - * variables: + * Reserve (numLists + 1) temporary variables: * - numLists temps to hold each value list * - 1 temp for the loop counter (index of next element in each list) * -- cgit v0.12 From 88ec3c9772a4b3e03d7e18067452ae8b67a7b3c7 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 19 Dec 2014 03:31:09 +0000 Subject: Narrow scope of numVars. --- generic/tclCompCmds.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 002012e..48eafe5 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -1544,7 +1544,7 @@ TclCompileForeachCmd( unsigned char *jumpPc; JumpFixup jumpFalseFixup; int jumpBackDist, jumpBackOffset, infoIndex, range; - int numWords, numLists, numVars, tempVar, i, j, code = TCL_OK; + int numWords, numLists, tempVar, i, j, code = TCL_OK; int savedStackDepth = envPtr->currStackDepth; Tcl_Obj *varListObj = NULL; DefineLineInformation; /* TIP #280 */ @@ -1600,6 +1600,7 @@ TclCompileForeachCmd( i < numWords-1; i++, tokenPtr = TokenAfter(tokenPtr)) { ForeachVarList *varListPtr; + int numVars; if (i%2 != 1) { continue; -- cgit v0.12 From baf649278ac11f772a6921121574bb6fe65ed127 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 19 Dec 2014 14:17:03 +0000 Subject: Replace TclIsLocalScalar() with PushVarNameWord() in [dict for] compiler. --- generic/tclCompCmds.c | 53 ++++++++++++++++++++++++++------------------------- 1 file changed, 27 insertions(+), 26 deletions(-) diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 48eafe5..9ccfcb6 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -806,16 +806,17 @@ TclCompileDictForCmd( CompileEnv *envPtr) /* Holds resulting instructions. */ { Proc *procPtr = envPtr->procPtr; - DefineLineInformation; /* TIP #280 */ Tcl_Token *varsTokenPtr, *dictTokenPtr, *bodyTokenPtr; - int keyVarIndex, valueVarIndex, nameChars, loopRange, catchRange; + int keyVarIndex, valueVarIndex, loopRange, catchRange; int infoIndex, jumpDisplacement, bodyTargetOffset, emptyTargetOffset; - int numVars, endTargetOffset; + int numVars, endTargetOffset, isSimple, isScalar; int savedStackDepth = envPtr->currStackDepth; /* Needed because jumps confuse the stack * space calculator. */ - const char **argv; - Tcl_DString buffer; + Tcl_Obj *varNameObj, *varListObj = NULL; + Tcl_Token token[2] = {{TCL_TOKEN_SIMPLE_WORD, NULL, 0, 1}, + {TCL_TOKEN_TEXT, NULL, 0, 0}}; + DefineLineInformation; /* TIP #280 */ /* * There must be exactly three arguments after the command. @@ -828,8 +829,8 @@ TclCompileDictForCmd( varsTokenPtr = TokenAfter(parsePtr->tokenPtr); dictTokenPtr = TokenAfter(varsTokenPtr); bodyTokenPtr = TokenAfter(dictTokenPtr); - if (varsTokenPtr->type != TCL_TOKEN_SIMPLE_WORD || - bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { + + if (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { return TCL_ERROR; } @@ -838,33 +839,33 @@ TclCompileDictForCmd( * Then extract their indices in the LVT. */ - Tcl_DStringInit(&buffer); - Tcl_DStringAppend(&buffer, varsTokenPtr[1].start, varsTokenPtr[1].size); - if (Tcl_SplitList(NULL, Tcl_DStringValue(&buffer), &numVars, - &argv) != TCL_OK) { - Tcl_DStringFree(&buffer); - return TCL_ERROR; - } - Tcl_DStringFree(&buffer); - if (numVars != 2) { - ckfree((char *) argv); + varListObj = Tcl_NewObj(); + if (!TclWordKnownAtCompileTime(varsTokenPtr, varListObj) || + TCL_OK != Tcl_ListObjLength(NULL, varListObj, &numVars) || + numVars != 2) { + Tcl_DecrRefCount(varListObj); return TCL_ERROR; } - nameChars = strlen(argv[0]); - if (!TclIsLocalScalar(argv[0], nameChars)) { - ckfree((char *) argv); + Tcl_ListObjIndex(NULL, varListObj, 0, &varNameObj); + token[1].start = Tcl_GetStringFromObj(varNameObj, &token[1].size); + PushVarNameWord(interp, token, envPtr, TCL_CREATE_VAR, + &keyVarIndex, &isSimple, &isScalar, 0 /* ignored */); + if (!isScalar || keyVarIndex < 0) { + Tcl_DecrRefCount(varListObj); return TCL_ERROR; } - keyVarIndex = TclFindCompiledLocal(argv[0], nameChars, 1, procPtr); - nameChars = strlen(argv[1]); - if (!TclIsLocalScalar(argv[1], nameChars)) { - ckfree((char *) argv); + Tcl_ListObjIndex(NULL, varListObj, 1, &varNameObj); + token[1].start = Tcl_GetStringFromObj(varNameObj, &token[1].size); + PushVarNameWord(interp, token, envPtr, TCL_CREATE_VAR, + &valueVarIndex, &isSimple, &isScalar, 0 /* ignored */); + if (!isScalar || valueVarIndex < 0) { + Tcl_DecrRefCount(varListObj); return TCL_ERROR; } - valueVarIndex = TclFindCompiledLocal(argv[1], nameChars, 1, procPtr); - ckfree((char *) argv); + + Tcl_DecrRefCount(varListObj); /* * Allocate a temporary variable to store the iterator reference. The -- cgit v0.12 From 18131f9c09f735616d65001add027710eee6ad27 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 19 Dec 2014 14:21:42 +0000 Subject: With no callers left, TclIsLocalScalar() is removed. --- generic/tclInt.h | 1 - generic/tclParse.c | 50 -------------------------------------------------- 2 files changed, 51 deletions(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index 255ee23..18574c3 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2606,7 +2606,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 int TclJoinThread(Tcl_ThreadId id, int *result); diff --git a/generic/tclParse.c b/generic/tclParse.c index 025304c..c07336f 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -2563,56 +2563,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 -- cgit v0.12 From 2613112a13e8acb4974fb7006cc44581299dd3ce Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 19 Dec 2014 15:13:11 +0000 Subject: Use interp==NULL argument to PushVarName to signal that only an index into the CLT is sought, and no time should be wasted compiling other cases which the caller is just going to discard. --- generic/tclCompCmds.c | 34 +++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 9ccfcb6..7577bd3 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -402,7 +402,7 @@ TclCompileCatchCmd( cmdTokenPtr = TokenAfter(parsePtr->tokenPtr); if (parsePtr->numWords >= 3) { resultNameTokenPtr = TokenAfter(cmdTokenPtr); - PushVarNameWord(interp, resultNameTokenPtr, envPtr, TCL_CREATE_VAR, + PushVarNameWord(NULL, resultNameTokenPtr, envPtr, TCL_CREATE_VAR, &resultIndex, &isSimple, &isScalar, 2); if (!isScalar || resultIndex < 0) { return TCL_ERROR; @@ -410,7 +410,7 @@ TclCompileCatchCmd( if (parsePtr->numWords == 4) { optsNameTokenPtr = TokenAfter(resultNameTokenPtr); - PushVarNameWord(interp, optsNameTokenPtr, envPtr, TCL_CREATE_VAR, + PushVarNameWord(NULL, optsNameTokenPtr, envPtr, TCL_CREATE_VAR, &optsIndex, &isSimple, &isScalar, 3); if (!isScalar || resultIndex < 0) { return TCL_ERROR; @@ -673,7 +673,7 @@ TclCompileDictSetCmd( */ varTokenPtr = TokenAfter(parsePtr->tokenPtr); - PushVarNameWord(interp, varTokenPtr, envPtr, TCL_CREATE_VAR, + PushVarNameWord(NULL, varTokenPtr, envPtr, TCL_CREATE_VAR, &dictVarIndex, &isSimple, &isScalar, 1); if (!isScalar || dictVarIndex < 0) { return TCL_ERROR; @@ -726,7 +726,7 @@ TclCompileDictIncrCmd( */ varTokenPtr = TokenAfter(parsePtr->tokenPtr); - PushVarNameWord(interp, varTokenPtr, envPtr, TCL_CREATE_VAR, + PushVarNameWord(NULL, varTokenPtr, envPtr, TCL_CREATE_VAR, &dictVarIndex, &isSimple, &isScalar, 1); if (!isScalar || dictVarIndex < 0) { return TCL_ERROR; @@ -849,7 +849,7 @@ TclCompileDictForCmd( Tcl_ListObjIndex(NULL, varListObj, 0, &varNameObj); token[1].start = Tcl_GetStringFromObj(varNameObj, &token[1].size); - PushVarNameWord(interp, token, envPtr, TCL_CREATE_VAR, + PushVarNameWord(NULL, token, envPtr, TCL_CREATE_VAR, &keyVarIndex, &isSimple, &isScalar, 0 /* ignored */); if (!isScalar || keyVarIndex < 0) { Tcl_DecrRefCount(varListObj); @@ -858,7 +858,7 @@ TclCompileDictForCmd( Tcl_ListObjIndex(NULL, varListObj, 1, &varNameObj); token[1].start = Tcl_GetStringFromObj(varNameObj, &token[1].size); - PushVarNameWord(interp, token, envPtr, TCL_CREATE_VAR, + PushVarNameWord(NULL, token, envPtr, TCL_CREATE_VAR, &valueVarIndex, &isSimple, &isScalar, 0 /* ignored */); if (!isScalar || valueVarIndex < 0) { Tcl_DecrRefCount(varListObj); @@ -1031,7 +1031,7 @@ TclCompileDictUpdateCmd( */ dictVarTokenPtr = TokenAfter(parsePtr->tokenPtr); - PushVarNameWord(interp, dictVarTokenPtr, envPtr, TCL_CREATE_VAR, + PushVarNameWord(NULL, dictVarTokenPtr, envPtr, TCL_CREATE_VAR, &dictIndex, &isSimple, &isScalar, 1); if (!isScalar || dictIndex < 0) { return TCL_ERROR; @@ -1064,7 +1064,7 @@ TclCompileDictUpdateCmd( */ tokenPtr = TokenAfter(tokenPtr); - PushVarNameWord(interp, tokenPtr, envPtr, TCL_CREATE_VAR, + PushVarNameWord(NULL, tokenPtr, envPtr, TCL_CREATE_VAR, &index, &isSimple, &isScalar, 1); if (!isScalar || index < 0) { ckfree((char *) duiPtr); @@ -1176,7 +1176,7 @@ TclCompileDictAppendCmd( */ tokenPtr = TokenAfter(parsePtr->tokenPtr); - PushVarNameWord(interp, tokenPtr, envPtr, TCL_CREATE_VAR, + PushVarNameWord(NULL, tokenPtr, envPtr, TCL_CREATE_VAR, &dictVarIndex, &isSimple, &isScalar, 1); if (!isScalar || dictVarIndex < 0) { return TCL_ERROR; @@ -1227,7 +1227,7 @@ TclCompileDictLappendCmd( varTokenPtr = TokenAfter(parsePtr->tokenPtr); keyTokenPtr = TokenAfter(varTokenPtr); valueTokenPtr = TokenAfter(keyTokenPtr); - PushVarNameWord(interp, varTokenPtr, envPtr, TCL_CREATE_VAR, + PushVarNameWord(NULL, varTokenPtr, envPtr, TCL_CREATE_VAR, &dictVarIndex, &isSimple, &isScalar, 1); if (!isScalar || dictVarIndex < 0) { return TCL_ERROR; @@ -1632,7 +1632,7 @@ TclCompileForeachCmd( Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj); token[1].start = Tcl_GetStringFromObj(varNameObj, &token[1].size); - PushVarNameWord(interp, token, envPtr, TCL_CREATE_VAR, + PushVarNameWord(NULL, token, envPtr, TCL_CREATE_VAR, &varIndex, &isSimple, &isScalar, 0 /* ignored */); if (!isScalar || varIndex < 0) { code = TCL_ERROR; @@ -4805,7 +4805,7 @@ PushVarName( 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] == ')')) { @@ -4907,7 +4907,7 @@ PushVarName( localIndex = -1; } } - if (localIndex < 0) { + if (interp && localIndex < 0) { PushLiteral(envPtr, name, nameChars); } @@ -4915,7 +4915,7 @@ PushVarName( * Compile the element script, if any. */ - if (elName != NULL) { + if (interp && elName != NULL) { if (elNameChars) { envPtr->line = line; envPtr->clNext = clNext; @@ -4924,7 +4924,7 @@ PushVarName( PushLiteral(envPtr, "", 0); } } - } else { + } else if (interp) { /* * The var name isn't simple: compile and push it. */ @@ -5708,7 +5708,7 @@ TclCompileUpvarCmd( localTokenPtr = TokenAfter(otherTokenPtr); CompileWord(envPtr, otherTokenPtr, interp, i); - PushVarNameWord(interp, localTokenPtr, envPtr, TCL_CREATE_VAR, + PushVarNameWord(NULL, localTokenPtr, envPtr, TCL_CREATE_VAR, &localIndex, &simpleVarName, &isScalar, i+1); if((localIndex < 0) || !isScalar) { @@ -5800,7 +5800,7 @@ TclCompileNamespaceCmd( localTokenPtr = TokenAfter(otherTokenPtr); CompileWord(envPtr, otherTokenPtr, interp, i); - PushVarNameWord(interp, localTokenPtr, envPtr, TCL_CREATE_VAR, + PushVarNameWord(NULL, localTokenPtr, envPtr, TCL_CREATE_VAR, &localIndex, &simpleVarName, &isScalar, i+1); if((localIndex < 0) || !isScalar) { -- cgit v0.12 From cfefe7127b6d560629dbcfee782578099e42d895 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 19 Dec 2014 15:55:21 +0000 Subject: New utility routine GetLocalScalarIndex() reduces common caller boilerplate (and fixes a bug!) --- generic/tclCompCmds.c | 112 ++++++++++++++++++++++++++------------------------ 1 file changed, 58 insertions(+), 54 deletions(-) diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 7577bd3..6821637 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -152,6 +152,8 @@ static void FreeJumptableInfo(ClientData clientData); static void PrintJumptableInfo(ClientData clientData, Tcl_Obj *appendObj, ByteCode *codePtr, unsigned int pcOffset); +static int GetLocalScalarIndex(Tcl_Token *tokenPtr, + CompileEnv *envPtr, int *indexPtr); static int PushVarName(Tcl_Interp *interp, Tcl_Token *varTokenPtr, CompileEnv *envPtr, int flags, int *localIndexPtr, @@ -379,7 +381,7 @@ TclCompileCatchCmd( { JumpFixup jumpFixup; Tcl_Token *cmdTokenPtr, *resultNameTokenPtr, *optsNameTokenPtr; - int resultIndex, optsIndex, isSimple, isScalar, range; + int resultIndex, optsIndex, range; int initStackDepth = envPtr->currStackDepth; int savedStackDepth; DefineLineInformation; /* TIP #280 */ @@ -402,17 +404,13 @@ TclCompileCatchCmd( cmdTokenPtr = TokenAfter(parsePtr->tokenPtr); if (parsePtr->numWords >= 3) { resultNameTokenPtr = TokenAfter(cmdTokenPtr); - PushVarNameWord(NULL, resultNameTokenPtr, envPtr, TCL_CREATE_VAR, - &resultIndex, &isSimple, &isScalar, 2); - if (!isScalar || resultIndex < 0) { + if (!GetLocalScalarIndex(resultNameTokenPtr, envPtr, &resultIndex)) { return TCL_ERROR; } if (parsePtr->numWords == 4) { optsNameTokenPtr = TokenAfter(resultNameTokenPtr); - PushVarNameWord(NULL, optsNameTokenPtr, envPtr, TCL_CREATE_VAR, - &optsIndex, &isSimple, &isScalar, 3); - if (!isScalar || resultIndex < 0) { + if (!GetLocalScalarIndex(optsNameTokenPtr, envPtr, &optsIndex)) { return TCL_ERROR; } } @@ -653,9 +651,8 @@ TclCompileDictSetCmd( * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { - Tcl_Token *tokenPtr; - Tcl_Token *varTokenPtr; - int i, isSimple, isScalar = 0, dictVarIndex = -1; + Tcl_Token *tokenPtr, *varTokenPtr; + int i, dictVarIndex; DefineLineInformation; /* TIP #280 */ /* @@ -673,9 +670,7 @@ TclCompileDictSetCmd( */ varTokenPtr = TokenAfter(parsePtr->tokenPtr); - PushVarNameWord(NULL, varTokenPtr, envPtr, TCL_CREATE_VAR, - &dictVarIndex, &isSimple, &isScalar, 1); - if (!isScalar || dictVarIndex < 0) { + if (!GetLocalScalarIndex(varTokenPtr, envPtr, &dictVarIndex)) { return TCL_ERROR; } @@ -708,7 +703,7 @@ TclCompileDictIncrCmd( CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *varTokenPtr, *keyTokenPtr; - int dictVarIndex, incrAmount, isScalar, isSimple; + int dictVarIndex, incrAmount; DefineLineInformation; /* TIP #280 */ /* @@ -726,9 +721,7 @@ TclCompileDictIncrCmd( */ varTokenPtr = TokenAfter(parsePtr->tokenPtr); - PushVarNameWord(NULL, varTokenPtr, envPtr, TCL_CREATE_VAR, - &dictVarIndex, &isSimple, &isScalar, 1); - if (!isScalar || dictVarIndex < 0) { + if (!GetLocalScalarIndex(varTokenPtr, envPtr, &dictVarIndex)) { return TCL_ERROR; } @@ -809,7 +802,7 @@ TclCompileDictForCmd( Tcl_Token *varsTokenPtr, *dictTokenPtr, *bodyTokenPtr; int keyVarIndex, valueVarIndex, loopRange, catchRange; int infoIndex, jumpDisplacement, bodyTargetOffset, emptyTargetOffset; - int numVars, endTargetOffset, isSimple, isScalar; + int numVars, endTargetOffset; int savedStackDepth = envPtr->currStackDepth; /* Needed because jumps confuse the stack * space calculator. */ @@ -849,18 +842,14 @@ TclCompileDictForCmd( Tcl_ListObjIndex(NULL, varListObj, 0, &varNameObj); token[1].start = Tcl_GetStringFromObj(varNameObj, &token[1].size); - PushVarNameWord(NULL, token, envPtr, TCL_CREATE_VAR, - &keyVarIndex, &isSimple, &isScalar, 0 /* ignored */); - if (!isScalar || keyVarIndex < 0) { + if (!GetLocalScalarIndex(token, envPtr, &keyVarIndex)) { Tcl_DecrRefCount(varListObj); return TCL_ERROR; } Tcl_ListObjIndex(NULL, varListObj, 1, &varNameObj); token[1].start = Tcl_GetStringFromObj(varNameObj, &token[1].size); - PushVarNameWord(NULL, token, envPtr, TCL_CREATE_VAR, - &valueVarIndex, &isSimple, &isScalar, 0 /* ignored */); - if (!isScalar || valueVarIndex < 0) { + if (!GetLocalScalarIndex(token, envPtr, &valueVarIndex)) { Tcl_DecrRefCount(varListObj); return TCL_ERROR; } @@ -1005,7 +994,7 @@ TclCompileDictUpdateCmd( * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { - int i, dictIndex, numVars, range, infoIndex, isSimple, isScalar; + int i, dictIndex, numVars, range, infoIndex; Tcl_Token **keyTokenPtrs, *dictVarTokenPtr, *bodyTokenPtr, *tokenPtr; DictUpdateInfo *duiPtr; JumpFixup jumpFixup; @@ -1031,9 +1020,7 @@ TclCompileDictUpdateCmd( */ dictVarTokenPtr = TokenAfter(parsePtr->tokenPtr); - PushVarNameWord(NULL, dictVarTokenPtr, envPtr, TCL_CREATE_VAR, - &dictIndex, &isSimple, &isScalar, 1); - if (!isScalar || dictIndex < 0) { + if (!GetLocalScalarIndex(dictVarTokenPtr, envPtr, &dictIndex)) { return TCL_ERROR; } @@ -1064,9 +1051,7 @@ TclCompileDictUpdateCmd( */ tokenPtr = TokenAfter(tokenPtr); - PushVarNameWord(NULL, tokenPtr, envPtr, TCL_CREATE_VAR, - &index, &isSimple, &isScalar, 1); - if (!isScalar || index < 0) { + if (!GetLocalScalarIndex(tokenPtr, envPtr, &index)) { ckfree((char *) duiPtr); TclStackFree(interp, keyTokenPtrs); return TCL_ERROR; @@ -1158,7 +1143,7 @@ TclCompileDictAppendCmd( CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *tokenPtr; - int i, isSimple, isScalar, dictVarIndex; + int i, dictVarIndex; DefineLineInformation; /* TIP #280 */ /* @@ -1176,9 +1161,7 @@ TclCompileDictAppendCmd( */ tokenPtr = TokenAfter(parsePtr->tokenPtr); - PushVarNameWord(NULL, tokenPtr, envPtr, TCL_CREATE_VAR, - &dictVarIndex, &isSimple, &isScalar, 1); - if (!isScalar || dictVarIndex < 0) { + if (!GetLocalScalarIndex(tokenPtr, envPtr, &dictVarIndex)) { return TCL_ERROR; } @@ -1213,7 +1196,7 @@ TclCompileDictLappendCmd( CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *varTokenPtr, *keyTokenPtr, *valueTokenPtr; - int isSimple, dictVarIndex = -1, isScalar = 0; + int dictVarIndex; DefineLineInformation; /* TIP #280 */ /* @@ -1227,9 +1210,7 @@ TclCompileDictLappendCmd( varTokenPtr = TokenAfter(parsePtr->tokenPtr); keyTokenPtr = TokenAfter(varTokenPtr); valueTokenPtr = TokenAfter(keyTokenPtr); - PushVarNameWord(NULL, varTokenPtr, envPtr, TCL_CREATE_VAR, - &dictVarIndex, &isSimple, &isScalar, 1); - if (!isScalar || dictVarIndex < 0) { + if (!GetLocalScalarIndex(varTokenPtr, envPtr, &dictVarIndex)) { return TCL_ERROR; } CompileWord(envPtr, keyTokenPtr, interp, 2); @@ -1628,17 +1609,14 @@ TclCompileForeachCmd( for (j = 0; j < numVars; j++) { Tcl_Obj *varNameObj; - int varIndex, isSimple, isScalar; Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj); token[1].start = Tcl_GetStringFromObj(varNameObj, &token[1].size); - PushVarNameWord(NULL, token, envPtr, TCL_CREATE_VAR, - &varIndex, &isSimple, &isScalar, 0 /* ignored */); - if (!isScalar || varIndex < 0) { + if (!GetLocalScalarIndex(token, envPtr, + varListPtr->varIndexes + j)) { code = TCL_ERROR; goto done; } - varListPtr->varIndexes[j] = varIndex; } Tcl_SetObjLength(varListObj, 0); } @@ -4717,6 +4695,38 @@ TclCompileWhileCmd( /* *---------------------------------------------------------------------- * + * GetLocalScalarIndex -- + * + * Procedure used in the compiling where pushing a variable name is + * necessary (append, lappend, set). + * + * Results: + * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer + * evaluation to runtime. + * + * Side effects: + * Instructions are added to envPtr to execute the "set" command at + * runtime. + * + *---------------------------------------------------------------------- + */ + +static int +GetLocalScalarIndex( + Tcl_Token *tokenPtr, + CompileEnv *envPtr, + int *indexPtr) +{ + int isSimple, isScalar; + + PushVarName(NULL, tokenPtr, envPtr, TCL_CREATE_VAR, indexPtr, + &isSimple, &isScalar, 0 /* ignored */, NULL /* ignored */); + return (isScalar && *indexPtr >= 0); +} + +/* + *---------------------------------------------------------------------- + * * PushVarName -- * * Procedure used in the compiling where pushing a variable name is @@ -5645,7 +5655,7 @@ TclCompileUpvarCmd( CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr; - int simpleVarName, isScalar, localIndex, numWords, i; + int localIndex, numWords, i; DefineLineInformation; /* TIP #280 */ Tcl_Obj *objPtr; @@ -5708,10 +5718,7 @@ TclCompileUpvarCmd( localTokenPtr = TokenAfter(otherTokenPtr); CompileWord(envPtr, otherTokenPtr, interp, i); - PushVarNameWord(NULL, localTokenPtr, envPtr, TCL_CREATE_VAR, - &localIndex, &simpleVarName, &isScalar, i+1); - - if((localIndex < 0) || !isScalar) { + if (!GetLocalScalarIndex(localTokenPtr, envPtr, &localIndex)) { return TCL_ERROR; } TclEmitInstInt4(INST_UPVAR, localIndex, envPtr); @@ -5755,7 +5762,7 @@ TclCompileNamespaceCmd( CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr; - int simpleVarName, isScalar, localIndex, numWords, i; + int localIndex, numWords, i; DefineLineInformation; /* TIP #280 */ if (envPtr->procPtr == NULL) { @@ -5800,10 +5807,7 @@ TclCompileNamespaceCmd( localTokenPtr = TokenAfter(otherTokenPtr); CompileWord(envPtr, otherTokenPtr, interp, i); - PushVarNameWord(NULL, localTokenPtr, envPtr, TCL_CREATE_VAR, - &localIndex, &simpleVarName, &isScalar, i+1); - - if((localIndex < 0) || !isScalar) { + if (!GetLocalScalarIndex(localTokenPtr, envPtr, &localIndex)) { return TCL_ERROR; } TclEmitInstInt4(INST_NSUPVAR, localIndex, envPtr); -- cgit v0.12