diff options
-rw-r--r-- | ChangeLog | 4 | ||||
-rw-r--r-- | generic/tclCompile.c | 174 |
2 files changed, 107 insertions, 71 deletions
@@ -1,5 +1,9 @@ 2007-01-18 Donal K. Fellows <donal.k.fellows@man.ac.uk> + * generic/tclCompile.c (TclCompileScript): Make sure that when parsing + an expanded literal fails, a correct bytecode sequence is still + issued. [Bug 1638414]. Also make sure that the start of the expansion + bytecode sequence falls inside the span of bytecodes for a command. * tests/compile.test (compile-16.24): Added test for [Bug 1638414] 2007-01-17 Donal K. Fellows <dkf@users.sf.net> diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 1ebf404..e13023f 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompile.c,v 1.102 2006/12/01 06:06:01 das Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.103 2007/01/18 11:12:38 dkf Exp $ */ #include "tclInt.h" @@ -1104,8 +1104,8 @@ TclCompileScript( Tcl_Parse parse; int lastTopLevelCmdIndex = -1; /* Index of most recent toplevel command in - * the command location table. Initialized * - * to avoid compiler warning. */ + * the command location table. Initialized to + * avoid compiler warning. */ int startCodeOffset = -1; /* Offset of first byte of current command's * code. Init. to avoid compiler warning. */ unsigned char *entryCodeNext = envPtr->codeNext; @@ -1147,7 +1147,10 @@ TclCompileScript( cmdLine = envPtr->line; do { if (Tcl_ParseCommand(interp, p, bytesLeft, 0, &parse) != TCL_OK) { - /* Compile bytecodes to report the parse error at runtime */ + /* + * Compile bytecodes to report the parse error at runtime. + */ + Tcl_Obj *returnCmd = Tcl_NewStringObj( "return -code 1 -level 0 -errorinfo", -1); Tcl_Obj *errMsg = Tcl_GetObjResult(interp); @@ -1190,24 +1193,25 @@ TclCompileScript( } gotParse = 1; if (parse.numWords > 0) { - int expand = 0; /* Set if there are dynamic expansions - * to handle */ - int eliterals = 0; /* Set if there are literal expansions - * to handle. Actually the number of - * words in the expanded literals. */ - int* exp = NULL; /* For literal expansions, #words in the - * expansion. Only valid if the - * associated expLen[] value is not - * NULL. Can be 0, expansion to nothing */ - int** expLen = NULL; /* Array of array of integers. Each - * array holds the lengths of the items - * in the expanded list. NULL indicates - * unexpanded words, or dynamically - * expanded words. */ - char*** expItem = NULL; /* Array of arrays of strings, holding - * pointers to the list elements, inside - * of the parsed script. No copies. For - * NULL, see expLen */ + int expand = 0; /* Set if there are dynamic expansions + * to handle */ + int eliterals = 0; /* Set if there are literal expansions + * to handle. Actually the number of + * words in the expanded literals. */ + int *exp = NULL; /* For literal expansions, #words in + * the expansion. Only valid if the + * associated expLen[] value is not + * NULL. Can be 0, expansion to + * nothing. */ + int **expLen = NULL; /* Array of array of integers. Each + * array holds the lengths of the + * items in the expanded list. NULL + * indicates unexpanded words, or + * dynamically expanded words. */ + char ***expItem = NULL; /* Array of arrays of strings, holding + * pointers to the list elements, + * inside of the parsed script. No + * copies. For NULL, see expLen. */ /* * If not the first command, pop the previous command's result @@ -1262,53 +1266,65 @@ TclCompileScript( * might be a literal one coming after. */ - exp = (int*) ckalloc (sizeof(int) * parse.numWords); - expLen = (int**) ckalloc (sizeof(int*) * parse.numWords); - expItem = (char***) ckalloc (sizeof(char**) * parse.numWords); + exp = (int *) ckalloc(sizeof(int) * parse.numWords); + expLen = (int **) ckalloc(sizeof(int *) * parse.numWords); + expItem = (char ***) ckalloc(sizeof(char **) * parse.numWords); for (wordIdx = 0, tokenPtr = parse.tokenPtr; wordIdx < parse.numWords; wordIdx++, tokenPtr += (tokenPtr->numComponents + 1)) { - exp [wordIdx] = -1; - expLen [wordIdx] = NULL; - expItem [wordIdx] = NULL; + exp[wordIdx] = -1; + expLen[wordIdx] = NULL; + expItem[wordIdx] = NULL; if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) { if (TclWordSimpleExpansion(tokenPtr)) { - CONST char* start = (tokenPtr+1)->start; - CONST char* end = ((tokenPtr+tokenPtr->numComponents)->start + - (tokenPtr+tokenPtr->numComponents)->size); - - TclMarkList (interp, start, end, - &(exp [wordIdx]), - (CONST int**)&(expLen [wordIdx]), - (CONST char ***)&(expItem [wordIdx])); - - eliterals += exp [wordIdx] ? exp[wordIdx] : 1; + CONST char *start = (tokenPtr+1)->start; + CONST char *end = + (tokenPtr+tokenPtr->numComponents)->start + + (tokenPtr+tokenPtr->numComponents)->size; + + if (TclMarkList(NULL, start, end, exp+wordIdx, + (CONST int **)(expLen+wordIdx), + (CONST char ***)(expItem+wordIdx)) != TCL_OK) { + /* + * We're trying to expand a literal that is not a + * well-formed list. No option but to punt the + * problem to run-time; arrange for compilation of + * this term as an expansion. + */ - } else if (!expand) { + expand = 1; + } else { + eliterals += exp[wordIdx] ? exp[wordIdx] : 1; + } + } else { expand = 1; - TclEmitOpcode(INST_EXPAND_START, envPtr); } } } if (eliterals) { - Tcl_Token* copy = parse.tokenPtr; + Tcl_Token *copy = parse.tokenPtr; int new; int objIdx; parse.tokensAvailable += eliterals + eliterals; - /* eliterals times 2 - simple_word, and text tokens */ - parse.tokenPtr = (Tcl_Token*) ckalloc (sizeof(Tcl_Token) * parse.tokensAvailable); + /* + * eliterals times 2 - simple_word, and text tokens. + */ + + parse.tokenPtr = (Tcl_Token *) + ckalloc(sizeof(Tcl_Token) * parse.tokensAvailable); parse.numTokens = 0; - for (objIdx = 0, wordIdx = 0, tokenPtr = copy, new = 0; - wordIdx < parse.numWords; - wordIdx++, tokenPtr += (tokenPtr->numComponents+1)) { + for (objIdx=0, wordIdx=0, tokenPtr=copy, new=0; + wordIdx < parse.numWords; + wordIdx++, tokenPtr += tokenPtr->numComponents+1) { if (expLen[wordIdx]) { - /* Expansion of a simple literal. We already have the + /* + * Expansion of a simple literal. We already have the * list elements which become the words. Now we `just` * have to create their tokens. The token array * already has the proper size to contain them all. @@ -1316,64 +1332,78 @@ TclCompileScript( int k; for (k = 0; k < exp[wordIdx]; k++) { - Tcl_Token* t = &parse.tokenPtr [objIdx]; - t->type = TCL_TOKEN_SIMPLE_WORD; - t->start = expItem [wordIdx][k]; - t->size = expLen [wordIdx][k]; + Tcl_Token *t = &parse.tokenPtr[objIdx]; + + t->type = TCL_TOKEN_SIMPLE_WORD; + t->start = expItem[wordIdx][k]; + t->size = expLen[wordIdx][k]; t->numComponents = 1; t++; - t->type = TCL_TOKEN_TEXT; - t->start = expItem [wordIdx][k]; - t->size = expLen [wordIdx][k]; + t->type = TCL_TOKEN_TEXT; + t->start = expItem[wordIdx][k]; + t->size = expLen[wordIdx][k]; t->numComponents = 0; objIdx += 2; new ++; } - ckfree ((char*) expLen [wordIdx]); - ckfree ((char*) expItem[wordIdx]); + ckfree((char *) expLen[wordIdx]); + ckfree((char *) expItem[wordIdx]); } else { - /* Regular word token. Copy as is, including subtree. */ + /* + * Regular word token. Copy as is, including subtree. + */ int k; - new ++; - for (k=0;k<=tokenPtr->numComponents;k++) { - parse.tokenPtr [objIdx++] = tokenPtr[k]; + + new++; + for (k=0 ; k<=tokenPtr->numComponents ; k++) { + parse.tokenPtr[objIdx++] = tokenPtr[k]; } } } parse.numTokens = objIdx; - parse.numWords = new; + parse.numWords = new; if (copy != parse.staticTokens) { - ckfree ((char*) copy); + ckfree((char *) copy); } } - ckfree ((char*) exp); - ckfree ((char*) expLen); - ckfree ((char*) expItem); + ckfree((char *) exp); + ckfree((char *) expLen); + ckfree((char *) expItem); envPtr->numCommands++; currCmdIndex = (envPtr->numCommands - 1); lastTopLevelCmdIndex = currCmdIndex; startCodeOffset = (envPtr->codeNext - envPtr->codeStart); EnterCmdStartData(envPtr, currCmdIndex, - (parse.commandStart - envPtr->source), startCodeOffset); + parse.commandStart - envPtr->source, startCodeOffset); + + /* + * Should only start issuing instructions after the "command has + * started" so that the command range is correct in the bytecode. + */ - /* TIP #280. Scan the words and compute the extended location + if (expand) { + TclEmitOpcode(INST_EXPAND_START, envPtr); + } + + /* + * TIP #280. Scan the words and compute the extended location * information. The map first contain full per-word line * information for use by the compiler. This is later replaced by * a reduced form which signals non-literal words, stored in * 'wlines'. */ - TclAdvanceLines (&cmdLine, p, parse.commandStart); - EnterCmdWordData (eclPtr, (parse.commandStart - envPtr->source), - parse.tokenPtr, parse.commandStart, parse.commandSize, - parse.numWords, cmdLine, &wlines); + TclAdvanceLines(&cmdLine, p, parse.commandStart); + EnterCmdWordData(eclPtr, parse.commandStart - envPtr->source, + parse.tokenPtr, parse.commandStart, parse.commandSize, + parse.numWords, cmdLine, &wlines); wlineat = eclPtr->nuloc - 1; /* @@ -1451,6 +1481,7 @@ TclCompileScript( /* * Fix the bytecode length. */ + unsigned char *fixPtr = envPtr->codeStart + savedCodeNext + 1; unsigned int fixLen = envPtr->codeNext @@ -1466,6 +1497,7 @@ TclCompileScript( * before the failure to produce bytecode got * reported. [Bugs 705406 and 735055] */ + envPtr->numCommands = savedNumCmds; envPtr->codeNext = envPtr->codeStart+savedCodeNext; } |