summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2007-01-18 11:12:37 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2007-01-18 11:12:37 (GMT)
commite59152c4b7d167237faee057b0326dda4efc89b8 (patch)
tree67efbcdc40453e5e938e4e1680e0770e62728b40
parent3046d041c02be38e96e7d08045486bd739f84cf7 (diff)
downloadtcl-e59152c4b7d167237faee057b0326dda4efc89b8.zip
tcl-e59152c4b7d167237faee057b0326dda4efc89b8.tar.gz
tcl-e59152c4b7d167237faee057b0326dda4efc89b8.tar.bz2
Fix [Bug 1638414] and make bytecode of expansion better
-rw-r--r--ChangeLog4
-rw-r--r--generic/tclCompile.c174
2 files changed, 107 insertions, 71 deletions
diff --git a/ChangeLog b/ChangeLog
index 3ebdd50..cc89082 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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;
}