From 79a19a1fcbb36bd0b0e41da53fda3ee8be77efc9 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 2f98d437c6f6fe174b88cd5e65eba288e0f3128a 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 c5f0eae368ab6a18f4d21796385e963adcd3cf34 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 6e36638f7c05fb239d0b0d56fee36f8b2c62bcd1 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 b96a5cc09f4f051a6b7a85a9a240470e6f5d5553 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 5ebd0feb1ccf775ec9f6dec2643698330dce1467 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 40ae358427d50647875105fb9760de916f5b56d1 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 f06d852f72d64565eab335c0aaab3fdc60927171 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 0495b7f2194bbfb5a1d05b091df455407e717021 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 748fa3a11436f305210af6a3e39d41222c25d704 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 3073801f15238627be21f713862787d8a5248c21 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 0b46203902b6bab47f2b10309f367e56fbf834ad 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 40d7215d54e63c1f2c3c064b112c078e1edf6fba 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 712798923a79fd0bd4a4020b31a06b21b139bdb1 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 fee272d8e8c4275d53f447cf243b898e9e97f611 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 bf940be5ea25aa49bc0daf614c361a74dbf1b012 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 9d653549927d022c769366f299b04e085a79282d 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 e0d2d783da5413e8df4bbd78f16d628d1d46b8a9 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 d0716e3327f9df70f093ffa5ca02821d353d6699 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 bc2ceda54bb62fdb07246c174ec53210f21ab3bd 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 From a1d0d2dc435ce6072fbb7cf4f1b78ab2b05fdbc6 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 19 Dec 2014 17:09:32 +0000 Subject: Revise name and interface of new utility routines to match work already in place on the trunk. --- generic/tclCompCmds.c | 105 ++++++++++++++++++++++++++++++++------------------ 1 file changed, 67 insertions(+), 38 deletions(-) diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 6821637..b3568e8 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -152,8 +152,10 @@ 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 LocalScalarFromToken(Tcl_Token *tokenPtr, + CompileEnv *envPtr); +static int LocalScalar(const char *bytes, int numBytes, + CompileEnv *envPtr); static int PushVarName(Tcl_Interp *interp, Tcl_Token *varTokenPtr, CompileEnv *envPtr, int flags, int *localIndexPtr, @@ -404,13 +406,15 @@ TclCompileCatchCmd( cmdTokenPtr = TokenAfter(parsePtr->tokenPtr); if (parsePtr->numWords >= 3) { resultNameTokenPtr = TokenAfter(cmdTokenPtr); - if (!GetLocalScalarIndex(resultNameTokenPtr, envPtr, &resultIndex)) { + resultIndex = LocalScalarFromToken(resultNameTokenPtr, envPtr); + if (resultIndex < 0) { return TCL_ERROR; } if (parsePtr->numWords == 4) { optsNameTokenPtr = TokenAfter(resultNameTokenPtr); - if (!GetLocalScalarIndex(optsNameTokenPtr, envPtr, &optsIndex)) { + optsIndex = LocalScalarFromToken(optsNameTokenPtr, envPtr); + if (optsIndex < 0) { return TCL_ERROR; } } @@ -670,7 +674,8 @@ TclCompileDictSetCmd( */ varTokenPtr = TokenAfter(parsePtr->tokenPtr); - if (!GetLocalScalarIndex(varTokenPtr, envPtr, &dictVarIndex)) { + dictVarIndex = LocalScalarFromToken(varTokenPtr, envPtr); + if (dictVarIndex < 0) { return TCL_ERROR; } @@ -721,7 +726,8 @@ TclCompileDictIncrCmd( */ varTokenPtr = TokenAfter(parsePtr->tokenPtr); - if (!GetLocalScalarIndex(varTokenPtr, envPtr, &dictVarIndex)) { + dictVarIndex = LocalScalarFromToken(varTokenPtr, envPtr); + if (dictVarIndex < 0) { return TCL_ERROR; } @@ -802,13 +808,12 @@ TclCompileDictForCmd( Tcl_Token *varsTokenPtr, *dictTokenPtr, *bodyTokenPtr; int keyVarIndex, valueVarIndex, loopRange, catchRange; int infoIndex, jumpDisplacement, bodyTargetOffset, emptyTargetOffset; - int numVars, endTargetOffset; + int numVars, endTargetOffset, numBytes; + const char *bytes; int savedStackDepth = envPtr->currStackDepth; /* Needed because jumps confuse the stack * space calculator. */ 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 */ /* @@ -841,15 +846,17 @@ TclCompileDictForCmd( } Tcl_ListObjIndex(NULL, varListObj, 0, &varNameObj); - token[1].start = Tcl_GetStringFromObj(varNameObj, &token[1].size); - if (!GetLocalScalarIndex(token, envPtr, &keyVarIndex)) { + bytes = Tcl_GetStringFromObj(varNameObj, &numBytes); + keyVarIndex = LocalScalar(bytes, numBytes, envPtr); + if (keyVarIndex < 0) { Tcl_DecrRefCount(varListObj); return TCL_ERROR; } Tcl_ListObjIndex(NULL, varListObj, 1, &varNameObj); - token[1].start = Tcl_GetStringFromObj(varNameObj, &token[1].size); - if (!GetLocalScalarIndex(token, envPtr, &valueVarIndex)) { + bytes = Tcl_GetStringFromObj(varNameObj, &numBytes); + valueVarIndex = LocalScalar(bytes, numBytes, envPtr); + if (valueVarIndex < 0) { Tcl_DecrRefCount(varListObj); return TCL_ERROR; } @@ -1020,7 +1027,8 @@ TclCompileDictUpdateCmd( */ dictVarTokenPtr = TokenAfter(parsePtr->tokenPtr); - if (!GetLocalScalarIndex(dictVarTokenPtr, envPtr, &dictIndex)) { + dictIndex = LocalScalarFromToken(dictVarTokenPtr, envPtr); + if (dictIndex < 0) { return TCL_ERROR; } @@ -1051,7 +1059,8 @@ TclCompileDictUpdateCmd( */ tokenPtr = TokenAfter(tokenPtr); - if (!GetLocalScalarIndex(tokenPtr, envPtr, &index)) { + index = LocalScalarFromToken(tokenPtr, envPtr); + if (index < 0) { ckfree((char *) duiPtr); TclStackFree(interp, keyTokenPtrs); return TCL_ERROR; @@ -1161,7 +1170,8 @@ TclCompileDictAppendCmd( */ tokenPtr = TokenAfter(parsePtr->tokenPtr); - if (!GetLocalScalarIndex(tokenPtr, envPtr, &dictVarIndex)) { + dictVarIndex = LocalScalarFromToken(tokenPtr, envPtr); + if (dictVarIndex < 0) { return TCL_ERROR; } @@ -1210,7 +1220,8 @@ TclCompileDictLappendCmd( varTokenPtr = TokenAfter(parsePtr->tokenPtr); keyTokenPtr = TokenAfter(varTokenPtr); valueTokenPtr = TokenAfter(keyTokenPtr); - if (!GetLocalScalarIndex(varTokenPtr, envPtr, &dictVarIndex)) { + dictVarIndex = LocalScalarFromToken(varTokenPtr, envPtr); + if (dictVarIndex < 0) { return TCL_ERROR; } CompileWord(envPtr, keyTokenPtr, interp, 2); @@ -1522,7 +1533,6 @@ 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; @@ -1576,8 +1586,6 @@ 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)) { @@ -1609,11 +1617,13 @@ TclCompileForeachCmd( for (j = 0; j < numVars; j++) { Tcl_Obj *varNameObj; + int numBytes; + const char *bytes; Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj); - token[1].start = Tcl_GetStringFromObj(varNameObj, &token[1].size); - if (!GetLocalScalarIndex(token, envPtr, - varListPtr->varIndexes + j)) { + bytes = Tcl_GetStringFromObj(varNameObj, &numBytes); + varListPtr->varIndexes[j] = LocalScalar(bytes, numBytes, envPtr); + if (varListPtr->varIndexes[j] < 0) { code = TCL_ERROR; goto done; } @@ -4695,33 +4705,50 @@ TclCompileWhileCmd( /* *---------------------------------------------------------------------- * - * GetLocalScalarIndex -- + * LocalScalar(FromToken) -- * - * Procedure used in the compiling where pushing a variable name is - * necessary (append, lappend, set). + * Get the index into the table of compiled locals that corresponds + * to a local scalar variable name. * * Results: - * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer - * evaluation to runtime. + * 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: - * Instructions are added to envPtr to execute the "set" command at - * runtime. + * May add an entry into the table of compiled locals. * *---------------------------------------------------------------------- */ static int -GetLocalScalarIndex( +LocalScalarFromToken( Tcl_Token *tokenPtr, - CompileEnv *envPtr, - int *indexPtr) + CompileEnv *envPtr) { - int isSimple, isScalar; + int isSimple, isScalar, index; - PushVarName(NULL, tokenPtr, envPtr, TCL_CREATE_VAR, indexPtr, + PushVarName(NULL, tokenPtr, envPtr, TCL_CREATE_VAR, &index, &isSimple, &isScalar, 0 /* ignored */, NULL /* ignored */); - return (isScalar && *indexPtr >= 0); + if (!isScalar) { + index = -1; + } + return index; +} + +static int +LocalScalar( + 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 LocalScalarFromToken(token, envPtr); } /* @@ -5718,7 +5745,8 @@ TclCompileUpvarCmd( localTokenPtr = TokenAfter(otherTokenPtr); CompileWord(envPtr, otherTokenPtr, interp, i); - if (!GetLocalScalarIndex(localTokenPtr, envPtr, &localIndex)) { + localIndex = LocalScalarFromToken(localTokenPtr, envPtr); + if (localIndex < 0) { return TCL_ERROR; } TclEmitInstInt4(INST_UPVAR, localIndex, envPtr); @@ -5807,7 +5835,8 @@ TclCompileNamespaceCmd( localTokenPtr = TokenAfter(otherTokenPtr); CompileWord(envPtr, otherTokenPtr, interp, i); - if (!GetLocalScalarIndex(localTokenPtr, envPtr, &localIndex)) { + localIndex = LocalScalarFromToken(localTokenPtr, envPtr); + if (localIndex < 0) { return TCL_ERROR; } TclEmitInstInt4(INST_NSUPVAR, localIndex, envPtr); -- cgit v0.12