* generic/tclBasic.c: TIP #280 implementation.

	* generic/tclCmdAH.c:
	* generic/tclCmdIL.c:
	* generic/tclCmdMZ.c:
	* generic/tclCompCmds.c:
	* generic/tclCompExpr.c:
	* generic/tclCompile.c:
	* generic/tclCompile.h:
	* generic/tclExecute.c:
	* generic/tclIOUtil.c:
	* generic/tclInt.h:
	* generic/tclInterp.c:
	* generic/tclNamesp.c:
	* generic/tclObj.c:
	* generic/tclProc.c:
	* tests/compile.test:
	* tests/info.test:
	* tests/platform.test:
	* tests/safe.test:

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 --
  *