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,