* generic/tclCompile.c (TclInitCompileEnv, EnterCmdWordIndex,

	TclCleanupByteCode, TclCompileScript):
	* generic/tclExecute.c (TclCompileObj, TclExecuteByteCode):
	* tclCompile.h (ExtCmdLoc):
	* tclInt.h (ExtIndex, CFWordBC, CmdFrame):
	* tclBasic.c (DeleteInterpProc, TclArgumentBCEnter,
	TclArgumentBCRelease, TclArgumentGet, SAVE_CONTEXT,
	RESTORE_CONTEXT, NRCoroutineExitCallback, TclNRCoroutineObjCmd):
	* generic/tclCmdAH.c (TclNRForObjCmd, TclNRForIterCallback,
	ForNextCallback):
	* generic/tclCmdMZ.c (TclNRWhileObjCmd):

	Extended the bytecode compiler initialization to recognize the
	compilation of whole files (NRE enabled 'source' command) and
	switch to the counting of absolute lines in that case.

	Further extended the bytecode compiler to track the start line in
	the generated information, and modified the bytecode execution to
	recompile an object if the location as per the calling context
	doesn't match the location saved in the bytecode. This part could
	be optimized more by using more memory to keep all possibilities
	which occur around, or by just adjusting the location information
	instead of a total recompile.

	Reworked the handling of literal command arguments in bytecode to
	be saved (compiler) and used (execution) per command (See the
	TCL_INVOKE_STK* instructions), and not per the whole bytecode.
	This, and the previous change remove the problems with location
	data caused by literal sharing (across whole files, but also proc
	bodies). Simplified the associated datastructures (ExtIndex is
	gone, as is the function EnterCmdWordIndex).

	The last change causes the hashtable 'lineLABCPtr' to be state
	which has to be kept per coroutine, like the CmdFrame stack.
	Reworked the coroutine support code to create, delete and switch
	the information as needed. Further reworked the tailcall command
	as well, it has to pop its own arguments when run in a bytecode
	context to keep a proper stack in 'lineLABCPtr'.

	Fixed the mishandling of line information in the NRE-enabled 'for'
	and 'while' commands introduced when both were made to share their
	iteration callbacks without taking into account that the loop body
	is found in different words of the command. Introduced a separate
	data structure to hold all the callback information, as we went
	over the limit of 4 direct client-data values for NRE callbacks.

	The above fixes [Bug 1605269].

7 files changed, 374 insertions, 166 deletions

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 264fdc8..a097976 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -16,7 +16,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclBasic.c,v 1.394 2009/05/08 08:48:19 dkf Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.395 2009/07/14 16:34:08 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -1545,9 +1545,7 @@ DeleteInterpProc(
 		ckfree((char *) eclPtr->loc);
 	    }
 
-	    if (eclPtr->eiloc != NULL) {
-		ckfree((char *) eclPtr->eiloc);
-	    }
+	    Tcl_DeleteHashTable (&eclPtr->litInfo);
 
 	    ckfree((char *) eclPtr);
 	    Tcl_DeleteHashEntry(hPtr);
@@ -5448,49 +5446,74 @@ TclArgumentRelease(
 
 void
 TclArgumentBCEnter(
-     Tcl_Interp *interp,
-     void *codePtr,
-     CmdFrame *cfPtr)
+     Tcl_Interp* interp,
+     Tcl_Obj*    objv[],
+     int         objc,
+     void*       codePtr,
+     CmdFrame*   cfPtr,
+     int         pc)
 {
-    Interp *iPtr = (Interp *) interp;
-    Tcl_HashEntry *hePtr = Tcl_FindHashEntry(iPtr->lineBCPtr,
-	    (char *) codePtr);
+    Interp*        iPtr  = (Interp*) interp;
+    Tcl_HashEntry* hePtr = Tcl_FindHashEntry (iPtr->lineBCPtr, (char *) codePtr);
 
     if (hePtr) {
-	ExtCmdLoc *eclPtr = Tcl_GetHashValue(hePtr);
-	int i;
+	ExtCmdLoc* eclPtr = (ExtCmdLoc*) Tcl_GetHashValue (hePtr);
+	hePtr = Tcl_FindHashEntry(&eclPtr->litInfo, (char*) pc);
 
-	for (i = 0; i < eclPtr->nueiloc; i++) {
-	    ExtIndex *eiPtr = &eclPtr->eiloc[i];
-	    Tcl_Obj *obj = eiPtr->obj;
-	    int new;
-	    Tcl_HashEntry *hPtr;
-	    CFWordBC *cfwPtr;
+	if (hePtr) {
+	    int  word;
+	    int  cmd  = (int) Tcl_GetHashValue(hePtr);
+	    ECL* ePtr = &eclPtr->loc[cmd];
+	    CFWordBC* lastPtr = 0;
 
-	    hPtr = Tcl_CreateHashEntry(iPtr->lineLABCPtr, (char *) obj, &new);
-	    if (new) {
-		/*
-		 * The word is not on the stack yet, remember the current
-		 * location and initialize references.
-		 */
+	    /*
+	     * A few truths ...
+	     * (1) ePtr->nline == objc
+	     * (2) (ePtr->line[word] < 0) => !literal, for all words
+	     * (3) (word == 0) => !literal
+	     *
+	     * Item (2) is why we can use objv to get the literals, and do not
+	     * have to save them at compile time.
+	     */
 
-		cfwPtr = (CFWordBC *) ckalloc(sizeof(CFWordBC));
-		cfwPtr->framePtr = cfPtr;
-		cfwPtr->eiPtr = eiPtr;
-		cfwPtr->refCount = 1;
-		Tcl_SetHashValue(hPtr, cfwPtr);
-	    } else {
-		/*
-		 * The word is already on the stack, its current location is
-		 * not relevant. Just remember the reference to prevent early
-		 * removal.
-		 */
+	    for (word = 1; word < objc; word++) {
+		if (ePtr->line[word] >= 0) {
+		    int isnew;
+		    Tcl_HashEntry* hPtr =
+			Tcl_CreateHashEntry (iPtr->lineLABCPtr,
+					     (char*) objv[word], &isnew);
+		    CFWordBC* cfwPtr = (CFWordBC*) ckalloc (sizeof (CFWordBC));
+
+		    cfwPtr->framePtr = cfPtr;
+		    cfwPtr->obj      = objv[word];
+		    cfwPtr->pc       = pc;
+		    cfwPtr->word     = word;
+		    cfwPtr->nextPtr  = lastPtr;
+		    lastPtr = cfwPtr;
+
+		    if (isnew) {
+			/*
+			 * The word is not on the stack yet, remember the
+			 * current location and initialize references.
+			 */
+			cfwPtr->prevPtr = NULL;
+		    } else {
+			/*
+			 * The object is already on the stack, however it may
+			 * have a different location now (literal sharing may
+			 * map multiple location to a single Tcl_Obj*. Save
+			 * the old information in the new structure.
+			 */
+			cfwPtr->prevPtr = (CFWordBC*) Tcl_GetHashValue(hPtr);
+		    }
 
-		cfwPtr = Tcl_GetHashValue(hPtr);
-		cfwPtr->refCount++;
-	    }
-	}
-    }
+		    Tcl_SetHashValue (hPtr, cfwPtr);
+		}
+	    } /* for */
+
+	    cfPtr->litarg = lastPtr;
+	} /* if */
+    } /* if */
 }
 
 /*
@@ -5516,37 +5539,33 @@ TclArgumentBCEnter(
 void
 TclArgumentBCRelease(
      Tcl_Interp *interp,
-     void *codePtr)
+     CmdFrame* cfPtr)
 {
-    Interp *iPtr = (Interp *) interp;
-    Tcl_HashEntry *hePtr = Tcl_FindHashEntry(iPtr->lineBCPtr,
-	    (char *) codePtr);
+    Interp*   iPtr    = (Interp*) interp;
+    CFWordBC* cfwPtr  = (CFWordBC*) cfPtr->litarg;
 
-    if (hePtr) {
-	ExtCmdLoc *eclPtr = Tcl_GetHashValue(hePtr);
-	int i;
-
-	for (i = 0; i < eclPtr->nueiloc; i++) {
-	    Tcl_Obj *obj = eclPtr->eiloc[i].obj;
-	    Tcl_HashEntry *hPtr = Tcl_FindHashEntry(iPtr->lineLABCPtr,
-		    (char *) obj);
-	    CFWordBC *cfwPtr;
-
-	    if (!hPtr) {
-		continue;
-	    }
-
-	    cfwPtr = Tcl_GetHashValue(hPtr);
+    while (cfwPtr) {
+	CFWordBC* nextPtr = cfwPtr->nextPtr;
+	Tcl_HashEntry* hPtr =
+	    Tcl_FindHashEntry(iPtr->lineLABCPtr, (char *) cfwPtr->obj);
+	CFWordBC* xPtr = (CFWordBC*) Tcl_GetHashValue (hPtr);
 
-	    cfwPtr->refCount--;
-	    if (cfwPtr->refCount > 0) {
-		continue;
-	    }
+	if (xPtr != cfwPtr) {
+	    Tcl_Panic ("TclArgumentBC Enter/Release Mismatch");
+	}
 
-	    ckfree((char *) cfwPtr);
+	if (cfwPtr->prevPtr) {
+	    Tcl_SetHashValue(hPtr, cfwPtr->prevPtr);
+	} else {
 	    Tcl_DeleteHashEntry(hPtr);
 	}
+
+	ckfree((char *) cfwPtr);
+
+	cfwPtr = nextPtr;
     }
+
+    cfPtr->litarg = NULL;
 }
 
 /*
@@ -5612,13 +5631,12 @@ TclArgumentGet(
     hPtr = Tcl_FindHashEntry(iPtr->lineLABCPtr, (char *) obj);
     if (hPtr) {
 	CFWordBC *cfwPtr = Tcl_GetHashValue(hPtr);
-	ExtIndex *eiPtr = cfwPtr->eiPtr;
 
 	framePtr = cfwPtr->framePtr;
 	framePtr->data.tebc.pc = (char *) (((ByteCode *)
-		framePtr->data.tebc.codePtr)->codeStart + eiPtr->pc);
+		framePtr->data.tebc.codePtr)->codeStart + cfwPtr->pc);
 	*cfPtrPtr = cfwPtr->framePtr;
-	*wordPtr = eiPtr->word;
+	*wordPtr = cfwPtr->word;
 	return;
     }
 }
@@ -8072,6 +8090,16 @@ TclNRTailcallObjCmd(
      * TclNRAddCallBack macro to build the callback)
      */
 
+    /*
+     * In a bytecode execution context the engine has called
+     * TclArgumentBCEnter() which, due to the tailcall, is not paired with a
+     * regular TclArgumentBCRelease. Get rid of it on our own.
+     */
+
+    if (iPtr->cmdFramePtr->type == TCL_LOCATION_BC) {
+	TclArgumentBCRelease (interp, iPtr->cmdFramePtr);
+    }
+
     TclNRAddCallback(interp, NRTailcallEval, listPtr, nsObjPtr, NULL, NULL);
     tailcallPtr = TOP_CB(interp);
     TOP_CB(interp) = tailcallPtr->nextPtr;
@@ -8182,12 +8210,14 @@ static const CorContext NULL_CONTEXT = {NULL, NULL, NULL};
 #define SAVE_CONTEXT(context)				\
     (context).framePtr = iPtr->framePtr;		\
     (context).varFramePtr = iPtr->varFramePtr;		\
-    (context).cmdFramePtr = iPtr->cmdFramePtr
+    (context).cmdFramePtr = iPtr->cmdFramePtr;		\
+    (context).lineLABCPtr = iPtr->lineLABCPtr
 
 #define RESTORE_CONTEXT(context)			\
     iPtr->framePtr = (context).framePtr;		\
     iPtr->varFramePtr = (context).varFramePtr;		\
-    iPtr->cmdFramePtr = (context).cmdFramePtr
+    iPtr->cmdFramePtr = (context).cmdFramePtr;		\
+    iPtr->lineLABCPtr = (context).lineLABCPtr
 
 #define iPtr ((Interp *) interp)
 
@@ -8384,7 +8414,8 @@ NRCoroutineExitCallback(
     TclDeleteExecEnv(corPtr->eePtr);
     corPtr->eePtr = NULL;
 
-    /* RESTORE_CONTEXT(corPtr->caller); AUTOMATIC! */
+    SAVE_CONTEXT(corPtr->running);
+    RESTORE_CONTEXT(corPtr->caller);
 
     NRE_ASSERT(iPtr->framePtr == corPtr->caller.framePtr);
     NRE_ASSERT(iPtr->cmdFramePtr == corPtr->caller.cmdFramePtr);
@@ -8392,6 +8423,16 @@ NRCoroutineExitCallback(
 
     iPtr->execEnvPtr = corPtr->callerEEPtr;
 
+    /*
+     * #280.
+     * Drop the coroutine-owned copy of the lineLABCPtr hashtable for literal
+     * command arguments in bytecode.
+     */
+
+    Tcl_DeleteHashTable(corPtr->base.lineLABCPtr);
+    ckfree((char *) corPtr->base.lineLABCPtr);
+    corPtr->base.lineLABCPtr = NULL;
+
     return result;
 }
 
@@ -8555,6 +8596,45 @@ TclNRCoroutineObjCmd(
     corPtr->running = NULL_CONTEXT;
 
     /*
+     * #280.
+     * Provide the new coroutine with its own copy of the lineLABCPtr
+     * hashtable for literal command arguments in bytecode. Note that that
+     * CFWordBC chains are not duplicated, only the entrypoints to them. This
+     * means that in the presence of coroutines each chain is potentially a
+     * tree. Like the chain -> tree conversion of the CmdFrame stack.
+     */
+
+    {
+	Tcl_HashSearch hSearch;
+	Tcl_HashEntry* hePtr;
+
+	corPtr->base.lineLABCPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+	Tcl_InitHashTable(corPtr->base.lineLABCPtr, TCL_ONE_WORD_KEYS);
+
+	for (hePtr = Tcl_FirstHashEntry(iPtr->lineLABCPtr,&hSearch);
+	     hePtr;
+	     hePtr = Tcl_NextHashEntry(&hSearch)) {
+	    int isNew;
+	    Tcl_HashEntry* newPtr =
+		Tcl_CreateHashEntry(corPtr->base.lineLABCPtr,
+		    (char *) Tcl_GetHashKey (iPtr->lineLABCPtr, hePtr),
+		    &isNew);
+	    Tcl_SetHashValue(newPtr, Tcl_GetHashValue(hePtr));
+	}
+
+	/*
+	 * The new copy is immediately plugged interpreter for use by the
+	 * first coroutine commands (see below). The interp's copy of the
+	 * table is already saved, see the SAVE_CONTEXT found just above this
+	 * whole code block. This also properly prepares us for the
+	 * SAVE/RESTORE dances during yields which swizzle the pointers
+	 * around.
+	 */
+
+	iPtr->lineLABCPtr = corPtr->base.lineLABCPtr;
+    }
+
+    /*
      * Eval things in 'uplevel #0', except for the very first command lookup
      * which should be looked up in caller's context.
      *
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index a00fff8..a3a5841 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCmdAH.c,v 1.116 2009/03/21 09:42:06 msofer Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.117 2009/07/14 16:34:08 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -1852,6 +1852,7 @@ TclNRForObjCmd(
 {
     int result;
     Interp *iPtr = (Interp *) interp;
+    ForIterData* iterPtr;
 
     if (objc != 5) {
 	Tcl_WrongNumArgs(interp, 1, objv, "start test next command");
@@ -1870,8 +1871,15 @@ TclNRForObjCmd(
 	return result;
     }
 
-    TclNRAddCallback(interp, TclNRForIterCallback, objv[2], objv[4],
-	    objv[3], "\n    (\"for\" body line %d)");
+    TclSmallAllocEx (interp, sizeof(ForIterData), iterPtr);
+    iterPtr->cond = objv[2];
+    iterPtr->body = objv[4];
+    iterPtr->next = objv[3];
+    iterPtr->msg  = "\n    (\"for\" body line %d)";
+    iterPtr->word = 4;
+
+    TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL,
+	    NULL, NULL);
     return TCL_OK;
 }
 
@@ -1882,10 +1890,11 @@ TclNRForIterCallback(
     int result)
 {
     Interp *iPtr = (Interp *) interp;
-    Tcl_Obj *cond = data[0];
-    Tcl_Obj *body = data[1];
-    Tcl_Obj *next = data[2];
-    char *msg = data[3];
+    ForIterData* iterPtr = data[0];
+    Tcl_Obj *cond = iterPtr->cond;
+    Tcl_Obj *body = iterPtr->body;
+    Tcl_Obj *next = iterPtr->next;
+    char *msg = iterPtr->msg;
     int value;
 
     if ((result != TCL_OK) && (result != TCL_CONTINUE)) {
@@ -1901,17 +1910,19 @@ TclNRForIterCallback(
     Tcl_ResetResult(interp);
     result = Tcl_ExprBooleanObj(interp, cond, &value);
     if (result != TCL_OK) {
+	TclSmallFreeEx (interp, iterPtr);
 	return result;
     }
     if (value) {
 	/* TIP #280. */
 	if (next) {
-	    TclNRAddCallback(interp, ForNextCallback, cond, body, next, msg);
+	    TclNRAddCallback(interp, ForNextCallback, iterPtr, NULL, NULL,
+		    NULL);
 	} else {
-	    TclNRAddCallback(interp, TclNRForIterCallback, cond, body, NULL,
-		    msg);
+	    TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL,
+		    NULL);
 	}
-	return TclNREvalObjEx(interp, body, 0, iPtr->cmdFramePtr, 2);
+	return TclNREvalObjEx(interp, body, 0, iPtr->cmdFramePtr, iterPtr->word);
     }
 
   done:
@@ -1925,6 +1936,7 @@ TclNRForIterCallback(
 	Tcl_AppendObjToErrorInfo(interp,
 		Tcl_ObjPrintf(msg, Tcl_GetErrorLine(interp)));
     }
+    TclSmallFreeEx (interp, iterPtr);
     return result;
 }
 
@@ -1935,10 +1947,8 @@ ForNextCallback(
     int result)
 {
     Interp *iPtr = (Interp *) interp;
-    Tcl_Obj *cond = data[0];
-    Tcl_Obj *body = data[1];
-    Tcl_Obj *next = data[2];
-    char *msg = data[3];
+    ForIterData* iterPtr = data[0];
+    Tcl_Obj *next = iterPtr->next;
 
     if ((result == TCL_OK) || (result == TCL_CONTINUE)) {
 	/*
@@ -1952,12 +1962,13 @@ ForNextCallback(
 	if ((result != TCL_BREAK) && (result != TCL_OK)) {
 	    if (result == TCL_ERROR) {
 		Tcl_AddErrorInfo(interp, "\n    (\"for\" loop-end command)");
+		TclSmallFreeEx (interp, iterPtr);
 	    }
 	    return result;
 	}
     }
 
-    TclNRAddCallback(interp, TclNRForIterCallback, cond, body, next, msg);
+    TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL);
     return result;
 }
 
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 2021b5b..d6f2987 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -15,7 +15,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCmdMZ.c,v 1.184 2009/07/12 18:04:33 dkf Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.185 2009/07/14 16:34:08 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -4601,6 +4601,8 @@ TclNRWhileObjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
+    ForIterData* iterPtr;
+
     if (objc != 3) {
 	Tcl_WrongNumArgs(interp, 1, objv, "test command");
 	return TCL_ERROR;
@@ -4610,8 +4612,15 @@ TclNRWhileObjCmd(
      * We reuse [for]'s callback, passing a NULL for the 'next' script.
      */
 
-    TclNRAddCallback(interp, TclNRForIterCallback, objv[1], objv[2],
-	    NULL, "\n    (\"while\" body line %d)");
+    TclSmallAllocEx (interp, sizeof(ForIterData), iterPtr);
+    iterPtr->cond = objv[1];
+    iterPtr->body = objv[2];
+    iterPtr->next = NULL;
+    iterPtr->msg  = "\n    (\"while\" body line %d)";
+    iterPtr->word = 2;
+
+    TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL,
+	    NULL, NULL);
     return TCL_OK;
 }
 
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 14ed9a0..a1a7168 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.167 2009/06/13 14:31:54 dgp Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.168 2009/07/14 16:34:08 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -432,8 +432,6 @@ static void		PrintSourceToObj(Tcl_Obj *appendObj,
 static void		EnterCmdWordData(ExtCmdLoc *eclPtr, int srcOffset,
 			    Tcl_Token *tokenPtr, const char *cmd, int len,
 			    int numWords, int line, int **lines);
-static void		EnterCmdWordIndex(ExtCmdLoc *eclPtr, Tcl_Obj* obj,
-			    int pc, int word);
 
 /*
  * The structure below defines the bytecode Tcl object type by means of
@@ -815,10 +813,7 @@ TclCleanupByteCode(
 		ckfree((char *) eclPtr->loc);
 	    }
 
-	    /* Release index of literals as well. */
-	    if (eclPtr->eiloc != NULL) {
-		ckfree((char *) eclPtr->eiloc);
-	    }
+	    Tcl_DeleteHashTable (&eclPtr->litInfo);
 
 	    ckfree((char *) eclPtr);
 	    Tcl_DeleteHashEntry(hePtr);
@@ -910,9 +905,7 @@ TclInitCompileEnv(
     envPtr->extCmdMapPtr->nloc = 0;
     envPtr->extCmdMapPtr->nuloc = 0;
     envPtr->extCmdMapPtr->path = NULL;
-    envPtr->extCmdMapPtr->eiloc = NULL;
-    envPtr->extCmdMapPtr->neiloc = 0;
-    envPtr->extCmdMapPtr->nueiloc = 0;
+    Tcl_InitHashTable(&envPtr->extCmdMapPtr->litInfo, TCL_ONE_WORD_KEYS);
 
     if ((invoker == NULL) || (invoker->type == TCL_LOCATION_EVAL_LIST)) {
 	/*
@@ -921,8 +914,40 @@ TclInitCompileEnv(
 	 */
 
 	envPtr->line = 1;
-	envPtr->extCmdMapPtr->type =
+	if (iPtr->evalFlags & TCL_EVAL_FILE) {
+	    iPtr->evalFlags &= ~TCL_EVAL_FILE;
+	    envPtr->extCmdMapPtr->type = TCL_LOCATION_SOURCE;
+
+	    if (iPtr->scriptFile) {
+		/*
+		 * Normalization here, to have the correct pwd. Should have
+		 * negligible impact on performance, as the norm should have
+		 * been done already by the 'source' invoking us, and it
+		 * caches the result.
+		 */
+
+		Tcl_Obj *norm = Tcl_FSGetNormalizedPath(interp, iPtr->scriptFile);
+
+		if (norm == NULL) {
+		    /*
+		     * Error message in the interp result. No place to put
+		     * it. And no place to serve the error itself to either.
+		     * Fake a path, empty string.
+		     */
+
+		    TclNewLiteralStringObj(envPtr->extCmdMapPtr->path, "");
+		} else {
+		    envPtr->extCmdMapPtr->path = norm;
+		}
+	    } else {
+		TclNewLiteralStringObj(envPtr->extCmdMapPtr->path, "");
+	    }
+
+	    Tcl_IncrRefCount(envPtr->extCmdMapPtr->path);
+	} else {
+	    envPtr->extCmdMapPtr->type =
 		(envPtr->procPtr ? TCL_LOCATION_PROC : TCL_LOCATION_BC);
+	}
     } else {
 	/*
 	 * Initialize the compiler using the context, making counting absolute
@@ -988,6 +1013,8 @@ TclInitCompileEnv(
 	TclStackFree(interp, ctxPtr);
     }
 
+    envPtr->extCmdMapPtr->start = envPtr->line;
+
     envPtr->auxDataArrayPtr = envPtr->staticAuxDataArraySpace;
     envPtr->auxDataArrayNext = 0;
     envPtr->auxDataArrayEnd = COMPILEENV_INIT_AUX_DATA_SIZE;
@@ -1473,13 +1500,6 @@ TclCompileScript(
 		     */
 		    objIndex = TclRegisterNewLiteral(envPtr,
 			    tokenPtr[1].start, tokenPtr[1].size);
-
-		    if (eclPtr->type == TCL_LOCATION_SOURCE) {
-			EnterCmdWordIndex(eclPtr,
-				envPtr->literalArrayPtr[objIndex].objPtr,
-				envPtr->codeNext - envPtr->codeStart,
-				wordIdx);
-		    }
 		}
 		TclEmitPush(objIndex, envPtr);
 	    } /* for loop */
@@ -1509,6 +1529,15 @@ TclCompileScript(
 		TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr);
 		TclAdjustStackDepth((1-wordIdx), envPtr);
 	    } else if (wordIdx > 0) {
+		/*
+		 * Save PC -> command map for the TclArgumentBC* functions.
+		 */
+
+		int isnew;
+		Tcl_HashEntry* hePtr = Tcl_CreateHashEntry(&eclPtr->litInfo,
+			   (char*) (envPtr->codeNext - envPtr->codeStart), &isnew);
+		Tcl_SetHashValue(hePtr, (char*) wlineat);
+
 		if (wordIdx <= 255) {
 		    TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr);
 		} else {
@@ -2477,39 +2506,6 @@ EnterCmdWordData(
     eclPtr->nuloc ++;
 }
 
-static void
-EnterCmdWordIndex(
-    ExtCmdLoc *eclPtr,
-    Tcl_Obj *obj,
-    int pc,
-    int word)
-{
-    ExtIndex* eiPtr;
-
-    if (eclPtr->nueiloc >= eclPtr->neiloc) {
-	/*
-	 * Expand the ExtIndex 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->neiloc;
-	size_t newElems = (currElems ? 2*currElems : 1);
-	size_t newBytes = newElems * sizeof(ExtIndex);
-
-	eclPtr->eiloc = (ExtIndex *)
-		ckrealloc((char *)(eclPtr->eiloc), newBytes);
-	eclPtr->neiloc = newElems;
-    }
-
-    eiPtr = &eclPtr->eiloc[eclPtr->nueiloc];
-    eiPtr->obj = obj;
-    eiPtr->pc = pc;
-    eiPtr->word = word;
-
-    eclPtr->nueiloc++;
-}
-
 /*
  *----------------------------------------------------------------------
  *
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index a9b8545..75dc236 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -9,7 +9,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.h,v 1.116 2009/05/08 01:02:26 msofer Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.117 2009/07/14 16:34:08 andreas_kupries Exp $
  */
 
 #ifndef _TCLCOMPILATION
@@ -134,18 +134,23 @@ typedef struct ECL {
 				 * command. */
 } ECL;
 
-/* ExtIndex defined in tclInt.h */
-
 typedef struct ExtCmdLoc {
     int type;			/* Context type. */
+    int start;                  /* Starting line for compiled script. Needed
+				 * for the extended recompile check in
+				 * tclCompileObj. */
     Tcl_Obj *path;		/* Path of the sourced file the command is
 				 * in. */
     ECL *loc;			/* Command word locations (lines). */
     int nloc;			/* Number of allocated entries in 'loc'. */
     int nuloc;			/* Number of used entries in 'loc'. */
-    ExtIndex* eiloc;
-    int neiloc;
-    int nueiloc;
+    Tcl_HashTable litInfo;      /* Indexed by bytecode 'PC', to have the
+				 * information accessible per command and
+				 * argument, not per whole bytecode. Value is
+				 * index of command in 'loc', giving us the
+				 * literals to associate with line information
+				 * as command argument, see
+				 * TclArgumentBCEnter() */
 } ExtCmdLoc;
 
 /*
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index aac36da..5139dad 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -14,7 +14,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclExecute.c,v 1.440 2009/07/12 18:04:33 dkf Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.441 2009/07/14 16:34:08 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -1517,6 +1517,91 @@ TclCompileObj(
 	}
 
 	/*
+	 * #280.
+	 * Literal sharing fix. This part of the fix is not required by 8.4
+	 * nor 8.5, because they eval-direct any literals, so just saving the
+	 * argument locations per command in bytecode is enough, embedded
+	 * 'eval' commands, etc. get the correct information.
+	 *
+	 * But in 8.6 all the embedded script are compiled, and the resulting
+	 * bytecode stored in the literal. Now the shared literal has bytecode
+	 * with location data for _one_ particular location this literal is
+	 * found at. If we get executed from a different location the bytecode
+	 * has to be recompiled to get the correct locations. Not doing this
+	 * will execute the saved bytecode with data for a different location,
+	 * causing 'info frame' to point to the wrong place in the sources.
+	 *
+	 * Future optimizations ...
+	 * (1) Save the location data (ExtCmdLoc) keyed by start line. In that
+	 *     case we recompile once per location of the literal, but not
+	 *     continously, because the moment we have all locations we do not
+	 *     need to recompile any longer.
+	 *
+	 * (2) Alternative: Do not recompile, tell the execution engine the
+	 *     offset between saved starting line and actual one. Then modify
+	 *     the users to adjust the locations they have by this offset.
+	 *
+	 * (3) Alternative 2: Do not fully recompile, adjust just the location
+	 *     information.
+	 */
+
+	{
+	    Tcl_HashEntry *hePtr = Tcl_FindHashEntry(iPtr->lineBCPtr,
+						     (char *) codePtr);
+	    if (hePtr) {
+		ExtCmdLoc *eclPtr = Tcl_GetHashValue(hePtr);
+		int redo = 0;
+
+		if (invoker) {
+		    CmdFrame *ctxPtr = (CmdFrame *) 
+			TclStackAlloc(interp, sizeof(CmdFrame));
+		    *ctxPtr = *invoker;
+
+		    if (invoker->type == TCL_LOCATION_BC) {
+			/*
+			 * Note: Type BC => ctx.data.eval.path    is not used.
+			 *			ctx.data.tebc.codePtr is used instead.
+			 */
+
+			TclGetSrcInfoForPc(ctxPtr);
+			if (ctxPtr->type == TCL_LOCATION_SOURCE) {
+			    /*
+			     * The reference made by 'TclGetSrcInfoForPc' is dead.
+			     */
+			    Tcl_DecrRefCount(ctxPtr->data.eval.path);
+			    ctxPtr->data.eval.path = NULL;
+			}
+		    }
+
+		    if (word < ctxPtr->nline) {
+			/*
+			 * Note: We do not care if the line[word] is -1. This
+			 * is a difference and requires a recompile (location
+			 * changed from absolute to relative, literal is used
+			 * fixed and through variable)
+			 *
+			 * Example:
+			 * test info-32.0 using literal of info-24.8
+			 *     (dict with ... vs           set body ...).
+			 */
+			redo = 
+			    ((eclPtr->type == TCL_LOCATION_SOURCE) &&
+			     (eclPtr->start != ctxPtr->line[word])) ||
+			    ((eclPtr->type == TCL_LOCATION_BC)     &&
+			     (ctxPtr->type == TCL_LOCATION_SOURCE))
+			    ;
+		    }
+
+		    TclStackFree(interp, ctxPtr);
+		}
+
+		if (redo) {
+		    goto recompileObj;
+		}
+	    }
+	}
+
+	/*
 	 * Increment the code's ref count while it is being executed. If
 	 * afterwards no references to it remain, free the code.
 	 */
@@ -1940,14 +2025,12 @@ TclExecuteByteCode(
 	bcFramePtr->nextPtr = iPtr->cmdFramePtr;
 	bcFramePtr->nline = 0;
 	bcFramePtr->line = NULL;
-
+	bcFramePtr->litarg = NULL;
 	bcFramePtr->data.tebc.codePtr = codePtr;
 	bcFramePtr->data.tebc.pc = NULL;
 	bcFramePtr->cmd.str.cmd = NULL;
 	bcFramePtr->cmd.str.len = 0;
 
-	TclArgumentBCEnter((Tcl_Interp*) iPtr,codePtr,bcFramePtr);
-
 	if (iPtr->execEnvPtr->rewind) {
 	    result = TCL_ERROR;
 	    goto abnormalReturn;
@@ -1962,6 +2045,8 @@ TclExecuteByteCode(
 	NRE_ASSERT(iPtr->cmdFramePtr == bcFramePtr);
 	iPtr->cmdFramePtr = bcFramePtr->nextPtr;
 
+	TclArgumentBCRelease((Tcl_Interp*) iPtr, bcFramePtr);
+
 	/*
 	 * If the CallFrame is marked as tailcalling, keep tailcalling
 	 */
@@ -2760,6 +2845,9 @@ TclExecuteByteCode(
 
 	    instructionCount = 1;
 
+	    TclArgumentBCEnter((Tcl_Interp*) iPtr, objv, objc,
+			       codePtr, bcFramePtr, pc - codePtr->codeStart);
+
 	    DECACHE_STACK_INFO();
 
 	    result = TclNREvalObjv(interp, objc, objv,
@@ -2773,6 +2861,8 @@ TclExecuteByteCode(
 		goto nonRecursiveCallStart;
 	    }
 
+	    TclArgumentBCRelease((Tcl_Interp*) iPtr, bcFramePtr);
+
 	    iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
 	    NRE_ASSERT(iPtr->cmdFramePtr == bcFramePtr->nextPtr);
 
@@ -7794,8 +7884,6 @@ TclExecuteByteCode(
 	}
     }
 
-    TclArgumentBCRelease((Tcl_Interp*) iPtr,codePtr);
-
     oldBottomPtr = bottomPtr->prevBottomPtr;
     iPtr->cmdFramePtr = bcFramePtr->nextPtr;
     TclStackFree(interp, bottomPtr);	/* free my stack */
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 007facd..7374b23 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -15,7 +15,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInt.h,v 1.427 2009/07/12 18:04:33 dkf Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.428 2009/07/14 16:34:09 andreas_kupries Exp $
  */
 
 #ifndef _TCLINT
@@ -1114,7 +1114,10 @@ typedef struct CmdFrame {
     CallFrame *framePtr;	/* Procedure activation record, may be
 				 * NULL. */
     struct CmdFrame *nextPtr;	/* Link to calling frame. */
-
+    const struct CFWordBC* litarg; /* Link to set of literal arguments which
+				    * have ben pushed on the lineLABCPtr stack
+				    * by TclArgumentBCEnter().  These will be
+				    * removed by TclArgumentBCRelease. */
     /*
      * Data needed for Eval vs TEBC
      *
@@ -1171,19 +1174,16 @@ typedef struct CFWord {
 				 * stack. */
 } CFWord;
 
-typedef struct ExtIndex {
-    Tcl_Obj *obj;		/* Reference to the word. */
+typedef struct CFWordBC {
+    Tcl_Obj*         obj;       /* Back reference to hashtable key */
+    CmdFrame *framePtr;		/* CmdFrame to access. */
     int pc;			/* Instruction pointer of a command in
 				 * ExtCmdLoc.loc[.] */
     int word;			/* Index of word in
 				 * ExtCmdLoc.loc[cmd]->line[.] */
-} ExtIndex;
-
-typedef struct CFWordBC {
-    CmdFrame *framePtr;		/* CmdFrame to access. */
-    ExtIndex *eiPtr;		/* Word info: PC and index. */
-    int refCount;		/* Number of times the word is on the
-				 * stack. */
+    struct CFWordBC* prevPtr;   /* Previous entry in stack for same Tcl_Obj */
+    struct CFWordBC* nextPtr;   /* Next entry for same command call. See
+				 * CmdFrame litarg field for the list start. */
 } CFWordBC;
 
 /*
@@ -1345,7 +1345,8 @@ typedef struct ExecStack {
 typedef struct CorContext {
     struct CallFrame *framePtr;
     struct CallFrame *varFramePtr;
-    struct CmdFrame *cmdFramePtr;
+    struct CmdFrame *cmdFramePtr;  /* See Interp.cmdFramePtr */
+    Tcl_HashTable *lineLABCPtr;    /* See Interp.lineLABCPtr */
 } CorContext;
 
 typedef struct CoroutineData {
@@ -2612,6 +2613,23 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldObjCmd;
 MODULE_SCOPE void TclClearTailcall(Tcl_Interp *interp,
 	            struct TEOV_callback *tailcallPtr);
 
+/*
+ * This structure holds the data for the various iteration callbacks used to
+ * NRE the 'for' and 'while' commands. We need a separate structure because we
+ * have more than the 4 client data entries we can provide directly thorugh
+ * the callback API. It is the 'word' information which puts us over the
+ * limit. It is needed because the loop body is argument 4 of 'for' and
+ * argument 2 of 'while'. Not providing the correct index confuses the #280
+ * code. We TclSmallAlloc/Free this.
+ */
+
+typedef struct ForIterData {
+    Tcl_Obj* cond; /* loop condition expression */
+    Tcl_Obj* body; /* loop body */
+    Tcl_Obj* next; /* loop step script, NULL for 'while' */
+    char*    msg;  /* error message part */
+    int      word; /* Index of the body script in the command */
+} ForIterData;
 
 /*
  *----------------------------------------------------------------
@@ -2629,9 +2647,10 @@ MODULE_SCOPE void	TclArgumentEnter(Tcl_Interp *interp,
 MODULE_SCOPE void	TclArgumentRelease(Tcl_Interp *interp,
 			    Tcl_Obj *objv[], int objc);
 MODULE_SCOPE void	TclArgumentBCEnter(Tcl_Interp *interp,
-			    void *codePtr, CmdFrame *cfPtr);
+			    Tcl_Obj* objv[], int objc,
+			    void *codePtr, CmdFrame *cfPtr, int pc);
 MODULE_SCOPE void	TclArgumentBCRelease(Tcl_Interp *interp,
-			    void *codePtr);
+			    CmdFrame *cfPtr);
 MODULE_SCOPE void	TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj,
 			    CmdFrame **cfPtrPtr, int *wordPtr);
 MODULE_SCOPE int	TclArraySet(Tcl_Interp *interp,