summaryrefslogtreecommitdiffstats
path: root/generic/tclCompile.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclCompile.c')
-rw-r--r--generic/tclCompile.c394
1 files changed, 383 insertions, 11 deletions
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index fe587ef..2683cd2 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.100 2006/11/15 20:08:43 dgp Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.101 2006/11/28 22:20:28 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -392,6 +392,13 @@ static void RecordByteCodeStats(ByteCode *codePtr);
static int SetByteCodeFromAny(Tcl_Interp *interp,
Tcl_Obj *objPtr);
+/* TIP #280 : Helper for building the per-word line information of all
+ * compiled commands */
+static void EnterCmdWordData(
+ ExtCmdLoc *eclPtr, int srcOffset, Tcl_Token* tokenPtr,
+ CONST char* cmd, int len, int numWords, int line,
+ int** lines);
+
/*
* The structure below defines the bytecode Tcl object type by means of
* procedures that can be invoked by generic object code.
@@ -438,9 +445,7 @@ TclSetByteCodeFromAny(
CompileHookProc *hookProc, /* Procedure to invoke after compilation. */
ClientData clientData) /* Hook procedure private data. */
{
-#ifdef TCL_COMPILE_DEBUG
Interp *iPtr = (Interp *) interp;
-#endif /*TCL_COMPILE_DEBUG*/
CompileEnv compEnv; /* Compilation environment structure allocated
* in frame. */
LiteralTable *localTablePtr = &(compEnv.localLitTable);
@@ -461,7 +466,16 @@ TclSetByteCodeFromAny(
#endif
stringPtr = Tcl_GetStringFromObj(objPtr, &length);
- TclInitCompileEnv(interp, &compEnv, stringPtr, length);
+
+ /*
+ * TIP #280. Pick up the CmdFrame in which the BC compiler was invoked
+ * and use to initialize the tracking in the compiler. This information
+ * was stored by TclCompEvalObj (tclExecute.c), and ProcCompileProc
+ * (tclProc.c).
+ */
+
+ TclInitCompileEnv(interp, &compEnv, stringPtr, length,
+ iPtr->invokeCmdFramePtr, iPtr->invokeWord);
TclCompileScript(interp, stringPtr, length, &compEnv);
/*
@@ -647,6 +661,7 @@ TclCleanupByteCode(
register ByteCode *codePtr) /* Points to the ByteCode to free. */
{
Tcl_Interp *interp = (Tcl_Interp *) *codePtr->interpHandle;
+ Interp* iPtr = (Interp*) interp;
int numLitObjects = codePtr->numLitObjects;
int numAuxDataItems = codePtr->numAuxDataItems;
register Tcl_Obj **objArrayPtr, *objPtr;
@@ -745,6 +760,36 @@ TclCleanupByteCode(
auxDataPtr++;
}
+ /*
+ * TIP #280. Release the location data associated with this byte code
+ * structure, if any. NOTE: The interp we belong to may be gone already,
+ * and the data with it.
+ *
+ * See also tclBasic.c, DeleteInterpProc
+ */
+
+ if (iPtr) {
+ Tcl_HashEntry* hePtr = Tcl_FindHashEntry (iPtr->lineBCPtr, (char *) codePtr);
+ if (hePtr) {
+ ExtCmdLoc* eclPtr = (ExtCmdLoc*) Tcl_GetHashValue (hePtr);
+ int i;
+
+ if (eclPtr->type == TCL_LOCATION_SOURCE) {
+ Tcl_DecrRefCount (eclPtr->path);
+ }
+ for (i=0; i< eclPtr->nuloc; i++) {
+ ckfree ((char*) eclPtr->loc[i].line);
+ }
+
+ if (eclPtr->loc != NULL) {
+ ckfree ((char*) eclPtr->loc);
+ }
+
+ ckfree ((char*) eclPtr);
+ Tcl_DeleteHashEntry (hePtr);
+ }
+ }
+
TclHandleRelease(codePtr->interpHandle);
ckfree((char *) codePtr);
}
@@ -773,7 +818,10 @@ TclInitCompileEnv(
register CompileEnv *envPtr,/* Points to the CompileEnv structure to
* initialize. */
char *stringPtr, /* The source string to be compiled. */
- int numBytes) /* Number of bytes in source string. */
+ int numBytes, /* Number of bytes in source string. */
+ CONST CmdFrame* invoker, /* Location context invoking the bcc */
+ int word) /* Index of the word in that context
+ * getting compiled */
{
Interp *iPtr = (Interp *) interp;
@@ -807,6 +855,72 @@ TclInitCompileEnv(
envPtr->cmdMapEnd = COMPILEENV_INIT_CMD_MAP_SIZE;
envPtr->mallocedCmdMap = 0;
+ /*
+ * TIP #280: Set up the extended command location information, based on
+ * the context invoking the byte code compiler. This structure is used to
+ * keep the per-word line information for all compiled commands.
+ *
+ * See also tclBasic.c, TclEvalObjEx, for the equivalent code in the
+ * non-compiling evaluator
+ */
+
+ envPtr->extCmdMapPtr = (ExtCmdLoc*) ckalloc (sizeof (ExtCmdLoc));
+ envPtr->extCmdMapPtr->loc = NULL;
+ envPtr->extCmdMapPtr->nloc = 0;
+ envPtr->extCmdMapPtr->nuloc = 0;
+ envPtr->extCmdMapPtr->path = NULL;
+
+ if (invoker == NULL) {
+ /* Initialize the compiler for relative counting */
+
+ envPtr->line = 1;
+ envPtr->extCmdMapPtr->type = (envPtr->procPtr
+ ? TCL_LOCATION_PROC
+ : TCL_LOCATION_BC);
+ } else {
+ /* Initialize the compiler using the context, making counting absolute
+ * to that context. Note that the context can be byte code
+ * execution. In that case we have to fill out the missing pieces
+ * (line, path, ...). Which may make change the type as well.
+ */
+
+ if ((invoker->nline <= word) || (invoker->line[word] < 0)) {
+ /* Word is not a literal, relative counting */
+
+ envPtr->line = 1;
+ envPtr->extCmdMapPtr->type = (envPtr->procPtr
+ ? TCL_LOCATION_PROC
+ : TCL_LOCATION_BC);
+
+ } else {
+ CmdFrame ctx = *invoker;
+ int pc = 0;
+
+ if (invoker->type == TCL_LOCATION_BC) {
+ /* Note: Type BC => ctx.data.eval.path is not used.
+ * ctx.data.tebc.codePtr is used instead.
+ */
+ TclGetSrcInfoForPc (&ctx);
+ pc = 1;
+ }
+
+ envPtr->line = ctx.line [word];
+ envPtr->extCmdMapPtr->type = ctx.type;
+
+ if (ctx.type == TCL_LOCATION_SOURCE) {
+ if (pc) {
+ /* The reference 'TclGetSrcInfoForPc' made is transfered */
+ envPtr->extCmdMapPtr->path = ctx.data.eval.path;
+ ctx.data.eval.path = NULL;
+ } else {
+ /* We have a new reference here */
+ envPtr->extCmdMapPtr->path = ctx.data.eval.path;
+ Tcl_IncrRefCount (envPtr->extCmdMapPtr->path);
+ }
+ }
+ }
+ }
+
envPtr->auxDataArrayPtr = envPtr->staticAuxDataArraySpace;
envPtr->auxDataArrayNext = 0;
envPtr->auxDataArrayEnd = COMPILEENV_INIT_AUX_DATA_SIZE;
@@ -934,6 +1048,29 @@ TclWordKnownAtCompileTime(
return 1;
}
+int
+TclWordSimpleExpansion(
+ Tcl_Token *tokenPtr) /* Points to Tcl_Token we should check */
+{
+ int numComponents = tokenPtr->numComponents;
+
+ if (tokenPtr->type != TCL_TOKEN_EXPAND_WORD) {
+ return 0;
+ }
+ tokenPtr++;
+ while (numComponents--) {
+ switch (tokenPtr->type) {
+ case TCL_TOKEN_TEXT:
+ break;
+
+ default:
+ return 0;
+ }
+ tokenPtr++;
+ }
+ return 1;
+}
+
/*
*----------------------------------------------------------------------
*
@@ -980,6 +1117,11 @@ TclCompileScript(
int commandLength, objIndex, code;
Tcl_DString ds;
+ /* TIP #280 */
+ ExtCmdLoc* eclPtr = envPtr->extCmdMapPtr;
+ int* wlines;
+ int wlineat, cmdLine;
+
Tcl_DStringInit(&ds);
if (numBytes < 0) {
@@ -1002,6 +1144,7 @@ TclCompileScript(
p = script;
bytesLeft = numBytes;
gotParse = 0;
+ cmdLine = envPtr->line;
do {
if (Tcl_ParseCommand(interp, p, bytesLeft, 0, &parse) != TCL_OK) {
/* Compile bytecodes to report the parse error at runtime */
@@ -1047,7 +1190,24 @@ TclCompileScript(
}
gotParse = 1;
if (parse.numWords > 0) {
- int expand = 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 */
/*
* If not the first command, pop the previous command's result
@@ -1092,19 +1252,110 @@ TclCompileScript(
#endif
/*
- * Check whether expansion has been requested for any of the words
+ * Check whether expansion has been requested for any of the
+ * words. NOTE: If a word to be expanded is actually a literal
+ * list we will do the expansion here, directly manipulating the
+ * token array.
+ *
+ * Due to the search for literal expansions it is not possible
+ * (anymore) to abort when a dynamic expansion is found. There
+ * 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);
+
for (wordIdx = 0, tokenPtr = parse.tokenPtr;
wordIdx < parse.numWords;
wordIdx++, tokenPtr += (tokenPtr->numComponents + 1)) {
+ exp [wordIdx] = -1;
+ expLen [wordIdx] = NULL;
+ expItem [wordIdx] = NULL;
+
if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
- expand = 1;
- TclEmitOpcode(INST_EXPAND_START, envPtr);
- break;
+ 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]),
+ &(expLen [wordIdx]),
+ &(expItem [wordIdx]));
+
+ eliterals += exp [wordIdx] ? exp[wordIdx] : 1;
+
+ } else if (!expand) {
+ expand = 1;
+ TclEmitOpcode(INST_EXPAND_START, envPtr);
+ }
+ }
+ }
+
+ if (eliterals) {
+ 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);
+ parse.numTokens = 0;
+
+ 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
+ * 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.
+ */
+
+ 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];
+ t->numComponents = 1;
+ t++;
+
+ 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]);
+ } else {
+ /* Regular word token. Copy as is, including subtree. */
+
+ int k;
+ new ++;
+ for (k=0;k<=tokenPtr->numComponents;k++) {
+ parse.tokenPtr [objIdx++] = tokenPtr[k];
+ }
+ }
+ }
+ parse.numTokens = objIdx;
+ parse.numWords = new;
+
+ if (copy != parse.staticTokens) {
+ ckfree ((char*) copy);
}
}
+ ckfree ((char*) exp);
+ ckfree ((char*) expLen);
+ ckfree ((char*) expItem);
+
envPtr->numCommands++;
currCmdIndex = (envPtr->numCommands - 1);
lastTopLevelCmdIndex = currCmdIndex;
@@ -1112,6 +1363,19 @@ TclCompileScript(
EnterCmdStartData(envPtr, currCmdIndex,
(parse.commandStart - envPtr->source), startCodeOffset);
+ /* 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);
+ wlineat = eclPtr->nuloc - 1;
+
/*
* Each iteration of the following loop compiles one word from the
* command.
@@ -1121,6 +1385,7 @@ TclCompileScript(
wordIdx < parse.numWords; wordIdx++,
tokenPtr += (tokenPtr->numComponents + 1)) {
+ envPtr->line = eclPtr->loc [wlineat].line [wordIdx];
if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
/*
* The word is not a simple string of characters.
@@ -1233,7 +1498,7 @@ TclCompileScript(
tokenPtr[1].start, tokenPtr[1].size);
}
TclEmitPush(objIndex, envPtr);
- }
+ } /* for loop */
/*
* Emit an invoke instruction for the command. We skip this if a
@@ -1276,6 +1541,12 @@ TclCompileScript(
EnterCmdExtentData(envPtr, currCmdIndex, commandLength,
(envPtr->codeNext-envPtr->codeStart) - startCodeOffset);
isFirstCmd = 0;
+
+ /* TIP #280: Free full form of per-word line data and insert
+ * the reduced form now
+ */
+ ckfree ((char*) eclPtr->loc [wlineat].line);
+ eclPtr->loc [wlineat].line = wlines;
} /* end if parse.numWords > 0 */
/*
@@ -1285,6 +1556,8 @@ TclCompileScript(
next = parse.commandStart + parse.commandSize;
bytesLeft -= (next - p);
p = next;
+ /* TIP #280 : Track lines in the just compiled command */
+ TclAdvanceLines (&cmdLine, parse.commandStart, p);
Tcl_FreeParse(&parse);
gotParse = 0;
} while (bytesLeft > 0);
@@ -1721,6 +1994,7 @@ TclInitByteCodeObj(
int numLitObjects = envPtr->literalArrayNext;
Namespace *namespacePtr;
int i;
+ int new;
Interp *iPtr;
iPtr = envPtr->iPtr;
@@ -1830,6 +2104,14 @@ TclInitByteCodeObj(
TclFreeIntRep(objPtr);
objPtr->internalRep.otherValuePtr = (void *) codePtr;
objPtr->typePtr = &tclByteCodeType;
+
+ /* TIP #280. Associate the extended per-word line information with the
+ * byte code object (internal rep), for use with the bc compiler.
+ */
+
+ Tcl_SetHashValue (Tcl_CreateHashEntry (iPtr->lineBCPtr, (char*) codePtr, &new),
+ envPtr->extCmdMapPtr);
+ envPtr->extCmdMapPtr = NULL;
}
/*
@@ -2108,6 +2390,96 @@ EnterCmdExtentData(
/*
*----------------------------------------------------------------------
+ * TIP #280
+ *
+ * EnterCmdWordData --
+ *
+ * Registers the lines for the words of a command. This information
+ * is used at runtime by 'info frame'.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Inserts word location information into the compilation
+ * environment envPtr for the command at index cmdIndex. The
+ * compilation environment's ExtCmdLoc.ECL array is grown if necessary.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EnterCmdWordData(eclPtr, srcOffset, tokenPtr, cmd, len, numWords, line, wlines)
+ ExtCmdLoc *eclPtr; /* Points to the map environment
+ * structure in which to enter command
+ * location information. */
+ int srcOffset; /* Offset of first char of the command. */
+ Tcl_Token* tokenPtr;
+ CONST char* cmd;
+ int len;
+ int numWords;
+ int line;
+ int** wlines;
+{
+ ECL* ePtr;
+ int wordIdx;
+ CONST char* last;
+ int wordLine;
+ int* wwlines;
+
+ if (eclPtr->nuloc >= eclPtr->nloc) {
+ /*
+ * Expand the ECL array by allocating more storage from the
+ * heap. The currently allocated ECL entries are stored from
+ * eclPtr->loc[0] up to eclPtr->loc[eclPtr->nuloc-1] (inclusive).
+ */
+
+ size_t currElems = eclPtr->nloc;
+ size_t newElems = (currElems ? 2*currElems : 1);
+ size_t currBytes = currElems * sizeof(ECL);
+ size_t newBytes = newElems * sizeof(ECL);
+ ECL * newPtr = (ECL *) ckalloc((unsigned) newBytes);
+
+ /*
+ * Copy from old ECL array to new, free old ECL array if
+ * needed.
+ */
+
+ if (currBytes) {
+ memcpy((VOID *) newPtr, (VOID *) eclPtr->loc, currBytes);
+ }
+ if (eclPtr->loc != NULL) {
+ ckfree((char *) eclPtr->loc);
+ }
+ eclPtr->loc = (ECL *) newPtr;
+ eclPtr->nloc = newElems;
+ }
+
+ ePtr = &eclPtr->loc [eclPtr->nuloc];
+ ePtr->srcOffset = srcOffset;
+ ePtr->line = (int*) ckalloc (numWords * sizeof (int));
+ ePtr->nline = numWords;
+ wwlines = (int*) ckalloc (numWords * sizeof (int));
+
+ last = cmd;
+ wordLine = line;
+ for (wordIdx = 0;
+ wordIdx < numWords;
+ wordIdx++, tokenPtr += (tokenPtr->numComponents + 1)) {
+ TclAdvanceLines (&wordLine, last, tokenPtr->start);
+ wwlines [wordIdx] = (TclWordKnownAtCompileTime (tokenPtr, NULL)
+ ? wordLine
+ : -1);
+ ePtr->line [wordIdx] = wordLine;
+ last = tokenPtr->start;
+ }
+
+ *wlines = wwlines;
+ eclPtr->nuloc ++;
+}
+
+/*
+ *----------------------------------------------------------------------
*
* TclCreateExceptRange --
*