* generic/tclBasic.c: Extended the existing TIP #280 system (info

	* generic/tclCmdAH.c: frame), added the ability to track the
	* generic/tclCompCmds.c: absolute location of literal procedure
	* generic/tclCompile.c: arguments, and making this information
	* generic/tclCompile.h: available to uplevel, eval, and
	* generic/tclInterp.c: siblings. This allows proper tracking of
	* generic/tclInt.h: absolute location through custom (Tcl-coded)
	* generic/tclNamesp.c: control structures based on uplevel, etc.
	* generic/tclProc.c:
	* tests/info.test:

10 files changed, 403 insertions, 69 deletions

diff --git a/ChangeLog b/ChangeLog
index a757bdb..d388303 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,16 @@
+2008-07-21  Andreas Kupries <andreask@activestate.com>
+
+	* generic/tclBasic.c: Extended the existing TIP #280 system (info
+	* generic/tclCmdAH.c: frame), added the ability to track the
+	* generic/tclCompCmds.c: absolute location of literal procedure
+	* generic/tclCompile.c: arguments, and making this information
+	* generic/tclCompile.h: available to uplevel, eval, and
+	* generic/tclInterp.c: siblings. This allows proper tracking of
+	* generic/tclInt.h: absolute location through custom (Tcl-coded)
+	* generic/tclNamesp.c: control structures based on uplevel, etc.
+	* generic/tclProc.c:
+	* tests/info.test:
+
 2007-02-22  Jan Nijtmans  <nijtmans@users.sf.net>
 
 	* generic/*.c: fix [2021443] inconsistant "wrong # args" messages
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index c7faf44..9ccc388 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.321 2008/07/21 21:54:06 das Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.322 2008/07/21 22:50:34 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -497,8 +497,10 @@ Tcl_CreateInterp(void)
     iPtr->cmdFramePtr = NULL;
     iPtr->linePBodyPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
     iPtr->lineBCPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+    iPtr->lineLAPtr = (Tcl_HashTable*) ckalloc (sizeof (Tcl_HashTable));
     Tcl_InitHashTable(iPtr->linePBodyPtr, TCL_ONE_WORD_KEYS);
     Tcl_InitHashTable(iPtr->lineBCPtr, TCL_ONE_WORD_KEYS);
+    Tcl_InitHashTable(iPtr->lineLAPtr, TCL_ONE_WORD_KEYS);
 
     iPtr->activeVarTracePtr = NULL;
 
@@ -1517,6 +1519,26 @@ DeleteInterpProc(
 	Tcl_DeleteHashTable(iPtr->lineBCPtr);
 	ckfree((char *) iPtr->lineBCPtr);
 	iPtr->lineBCPtr = NULL;
+
+	/*
+	 * Location stack for uplevel/eval/... scripts which were passed
+	 * through proc arguments. Actually we track all arguments as we
+	 * don't, cannot know which arguments will be used as scripts and
+	 * which won't.
+	 */
+
+	if (iPtr->lineLAPtr->numEntries) {
+	    /*
+	     * When the interp goes away we have nothing on the stack, so
+	     * there are no arguments, so this table has to be empty.
+	     */
+
+	    Tcl_Panic ("Argument location tracking table not empty");
+	}
+
+	Tcl_DeleteHashTable (iPtr->lineLAPtr);
+	ckfree((char*) iPtr->lineLAPtr);
+	iPtr->lineLAPtr = NULL;
     }
 
     Tcl_DeleteHashTable(&iPtr->varTraces);
@@ -5058,9 +5080,11 @@ TclEvalEx(
 	    eeFramePtr->nline = objectsUsed;
 	    eeFramePtr->line = lines;
 
+	    TclArgumentEnter (interp, objv, objectsUsed, eeFramePtr);
 	    iPtr->cmdFramePtr = eeFramePtr;
 	    code = TclEvalObjv(interp, objectsUsed, objv, TCL_EVAL_NOERR, NULL);
 	    iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
+	    TclArgumentRelease (interp, objv, objectsUsed);
 
 	    eeFramePtr->line = NULL;
 	    eeFramePtr->nline = 0;
@@ -5210,6 +5234,207 @@ TclAdvanceLines(
 
 /*
  *----------------------------------------------------------------------
+ * Note: The whole data structure access for argument location tracking is
+ * hidden behind these three functions. The only parts open are the lineLAPtr
+ * field in the Interp structure. The CFWord definition is internal to here.
+ * Should make it easier to redo the data structures if we find something more
+ * space/time efficient.
+ */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclArgumentEnter --
+ *
+ *	This procedure is a helper for the TIP #280 uplevel extension.
+ *	It enters location references for the arguments of a command to be
+ *	invoked. Only the first entry has the actual data, further entries
+ *	simply count the usage up.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	May allocate memory.
+ *
+ * TIP #280
+ *----------------------------------------------------------------------
+ */
+
+void
+TclArgumentEnter(interp,objv,objc,cfPtr)
+     Tcl_Interp* interp;
+     Tcl_Obj**   objv;
+     int         objc;
+     CmdFrame*   cfPtr;
+{
+    Interp* iPtr = (Interp*) interp;
+    int new, i;
+    Tcl_HashEntry* hPtr;
+    CFWord* cfwPtr;
+
+    for (i=1; i < objc; i++) {
+	/*
+	 * Ignore argument words without line information (= dynamic).  If
+	 * they are variables they may have location information associated
+	 * with that, either through globally recorded 'set' invokations, or
+	 * literals in bytecode. Eitehr way there is no need to record
+	 * something here.
+	 */
+
+	if (cfPtr->line [i] < 0) continue;
+	hPtr = Tcl_CreateHashEntry (iPtr->lineLAPtr, (char*) objv[i], &new);
+	if (new) {
+           /*
+	    * The word is not on the stack yet, remember the current location
+	    * and initialize references.
+            */
+           cfwPtr = (CFWord*) ckalloc (sizeof (CFWord));
+           cfwPtr->framePtr = cfPtr;
+           cfwPtr->word     = i;
+           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.
+            */
+           cfwPtr = (CFWord*) Tcl_GetHashValue (hPtr);
+           cfwPtr->refCount ++;
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclArgumentRelease --
+ *
+ *	This procedure is a helper for the TIP #280 uplevel extension.
+ *	It removes the location references for the arguments of a command
+ *	just done. Usage is counted down, the data is removed only when
+ *	no user is left over.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	May release memory.
+ *
+ * TIP #280
+ *----------------------------------------------------------------------
+ */
+
+void
+TclArgumentRelease(interp,objv,objc)
+     Tcl_Interp* interp;
+     Tcl_Obj**   objv;
+     int         objc;
+{
+    Interp*        iPtr = (Interp*) interp;
+    Tcl_HashEntry* hPtr;
+    CFWord*        cfwPtr;
+    int i;
+
+    for (i=1; i < objc; i++) {
+       hPtr = Tcl_FindHashEntry (iPtr->lineLAPtr, (char *) objv[i]);
+
+       if (!hPtr) { continue; }
+       cfwPtr = (CFWord*) Tcl_GetHashValue (hPtr);
+
+       cfwPtr->refCount --;
+       if (cfwPtr->refCount > 0) { continue; }
+
+       ckfree ((char*) cfwPtr);
+       Tcl_DeleteHashEntry (hPtr);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclArgumentGet --
+ *
+ *	This procedure is a helper for the TIP #280 uplevel extension.
+ *	It find the location references for a Tcl_Obj, if any.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Writes found location information into the result arguments.
+ *
+ * TIP #280
+ *----------------------------------------------------------------------
+ */
+
+void
+TclArgumentGet(interp,obj,cfPtrPtr,wordPtr)
+     Tcl_Interp* interp;
+     Tcl_Obj*    obj;
+     CmdFrame**  cfPtrPtr;
+     int*        wordPtr;
+{
+    Interp*        iPtr = (Interp*) interp;
+    Tcl_HashEntry* hPtr;
+    CmdFrame*      framePtr;
+
+    /*
+     * First look for location information recorded in the argument
+     * stack. That is nearest.
+     */
+
+    hPtr = Tcl_FindHashEntry (iPtr->lineLAPtr, (char *) obj);
+    if (hPtr) {
+	CFWord* cfwPtr = (CFWord*) Tcl_GetHashValue (hPtr);
+	*wordPtr  = cfwPtr->word;
+	*cfPtrPtr = cfwPtr->framePtr;
+	return;
+    }
+
+    /*
+     * Check if the Tcl_Obj has location information as a bytecode literal. We
+     * have to scan the stack up and check all bytecode frames for a possible
+     * definition.
+     */
+
+    for (framePtr = iPtr->cmdFramePtr;
+	 framePtr;
+	 framePtr = framePtr->nextPtr) {
+	const ByteCode* codePtr;
+	Tcl_HashEntry*  hePtr;
+
+	if (framePtr->type != TCL_LOCATION_BC) continue;
+
+	codePtr = framePtr->data.tebc.codePtr;
+	hePtr   = Tcl_FindHashEntry (iPtr->lineBCPtr, (char *) codePtr);
+
+	if (hePtr) {
+	    ExtCmdLoc*    eclPtr = (ExtCmdLoc*) Tcl_GetHashValue (hePtr);
+	    Tcl_HashEntry *hlPtr = Tcl_FindHashEntry (&eclPtr->litIndex, (char *) obj);
+
+	    if (hlPtr) {
+		/*
+		 * Convert from the current invoker CmdFrame to a CmdFrame
+		 * refering to the actual word location. We are directly
+		 * manipulating the relevant command frame in the frame stack.
+		 * That is no problem because TEBC is already setting the pc
+		 * for each invokation, so moving it somewhere will not affect
+		 * the following commands.
+		 */
+
+		ExtIndex* eiPtr = (ExtIndex*) Tcl_GetHashValue (hlPtr);
+
+		framePtr->data.tebc.pc = codePtr->codeStart + eiPtr->pc;
+		*cfPtrPtr = framePtr;
+		*wordPtr  = eiPtr->word;
+	    }
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
  *
  * Tcl_Eval --
  *
@@ -5494,65 +5719,52 @@ TclNREvalObjEx(
 	 * invokations.
 	 */
 
-	if ((invoker->nline <= word) || (invoker->line[word] < 0)) {
+	int pc = 0;
+	CmdFrame *ctxPtr = (CmdFrame *)
+	    TclStackAlloc(interp, sizeof(CmdFrame));
+
+	*ctxPtr = *invoker;
+	if (invoker->type == TCL_LOCATION_BC) {
+	    /*
+	     * Note: Type BC => ctxPtr->data.eval.path is not used.
+	     * ctxPtr->data.tebc.codePtr is used instead.
+	     */
+
+	    TclGetSrcInfoForPc(ctxPtr);
+	    pc = 1;
+	}
+
+	script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
+
+	if ((invoker->nline <= word) ||
+	    (invoker->line[word] < 0) ||
+	    (ctxPtr->type != TCL_LOCATION_SOURCE)) {
 	    /*
 	     * Dynamic script, or dynamic context, force our own context.
 	     */
 
-	    script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
 	    result = Tcl_EvalEx(interp, script, numSrcBytes, flags);
 
 	} else {
 	    /*
-	     * Try to get an absolute context for the evaluation.
+	     * Absolute context to reuse.
 	     */
 
-	    int pc = 0;
-	    CmdFrame *ctxPtr = (CmdFrame *)
-		    TclStackAlloc(interp, sizeof(CmdFrame));
+	    iPtr->invokeCmdFramePtr = ctxPtr;
+	    iPtr->evalFlags |= TCL_EVAL_CTX;
 
-	    *ctxPtr = *invoker;
-	    if (invoker->type == TCL_LOCATION_BC) {
-		/*
-		 * Note: Type BC => ctxPtr->data.eval.path is not used.
-		 * ctxPtr->data.tebc.codePtr is used instead.
-		 */
-
-		TclGetSrcInfoForPc(ctxPtr);
-		pc = 1;
-	    }
+	    result = TclEvalEx(interp, script, numSrcBytes, flags,
+			       ctxPtr->line[word]);
 
-	    if (ctxPtr->type == TCL_LOCATION_SOURCE) {
+	    if (pc) {
 		/*
-		 * Absolute context to reuse.
+		 * Death of SrcInfo reference.
 		 */
-
-		iPtr->invokeCmdFramePtr = ctxPtr;
-		iPtr->evalFlags |= TCL_EVAL_CTX;
-
-		script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
-		result = TclEvalEx(interp, script, numSrcBytes, flags,
-			ctxPtr->line[word]);
-
-		if (pc) {
-		    /*
-		     * Death of SrcInfo reference.
-		     */
-
-		    Tcl_DecrRefCount(ctxPtr->data.eval.path);
-		}
-	    } else {
-		/*
-		 * Dynamic context or script, easier to make our own as
-		 * well.
-		 */
-
-		script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
-		result = Tcl_EvalEx(interp, script, numSrcBytes, flags);
+		
+		Tcl_DecrRefCount(ctxPtr->data.eval.path);
 	    }
-
-	    TclStackFree(interp, ctxPtr);
 	}
+	TclStackFree(interp, ctxPtr);
     }
     TclDecrRefCount(objPtr);
     return result;
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 303ecd5..6f4778b 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.98 2008/07/21 22:22:27 nijtmans Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.99 2008/07/21 22:50:34 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -657,10 +657,15 @@ Tcl_EvalObjCmd(
 
     if (objc == 2) {
 	/*
-	 * TIP #280. Make invoking context available to eval'd script.
+	 * TIP #280. Make argument location available to eval'd script.
 	 */
 
-	result = TclEvalObjEx(interp, objv[1], TCL_EVAL_DIRECT, iPtr->cmdFramePtr, 1);
+	CmdFrame* invoker = iPtr->cmdFramePtr;
+	int word          = 1;
+	TclArgumentGet (interp, objv[1], &invoker, &word);
+
+	result = TclEvalObjEx(interp, objv[1], TCL_EVAL_DIRECT,
+		invoker, word);
     } else {
 	/*
 	 * More than one argument: concatenate them together with spaces
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 187d81e..88d8b86 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.149 2008/06/08 03:21:33 msofer Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.150 2008/07/21 22:50:34 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -801,6 +801,8 @@ TclCleanupByteCode(
 	if (hePtr) {
 	    ExtCmdLoc *eclPtr = Tcl_GetHashValue(hePtr);
 	    int i;
+	    Tcl_HashSearch hSearch;
+	    Tcl_HashEntry *hlPtr;
 
 	    if (eclPtr->type == TCL_LOCATION_SOURCE) {
 		Tcl_DecrRefCount(eclPtr->path);
@@ -813,6 +815,15 @@ TclCleanupByteCode(
 		ckfree((char *) eclPtr->loc);
 	    }
 
+	    /* Release index of literals as well. */
+	    for (hlPtr = Tcl_FirstHashEntry(&eclPtr->litIndex, &hSearch);
+		 hlPtr != NULL;
+		 hlPtr = Tcl_NextHashEntry(&hSearch)) {
+		ExtIndex* eiPtr = (ExtIndex*) Tcl_GetHashValue (hlPtr);
+		ckfree((char*) eiPtr);
+		Tcl_DeleteHashEntry (hlPtr);
+	    }
+	    Tcl_DeleteHashTable (&eclPtr->litIndex);
 	    ckfree((char *) eclPtr);
 	    Tcl_DeleteHashEntry(hePtr);
 	}
@@ -902,6 +913,7 @@ TclInitCompileEnv(
     envPtr->extCmdMapPtr->nloc = 0;
     envPtr->extCmdMapPtr->nuloc = 0;
     envPtr->extCmdMapPtr->path = NULL;
+    Tcl_InitHashTable(&envPtr->extCmdMapPtr->litIndex, TCL_ONE_WORD_KEYS);
 
     if (invoker == NULL) {
         /*
@@ -1441,8 +1453,23 @@ TclCompileScript(
 			TclHideLiteral(interp, envPtr, objIndex);
 		    }
 		} else {
+		    /*
+		     * Simple argument word of a command. We reach this if and
+		     * only if the command word was not compiled for whatever
+		     * reason. Register the literal's location for use by
+		     * uplevel, etc. commands, should they encounter it
+		     * unmodified. We care only if the we are in a context
+		     * which already allows absolute counting.
+		     */
 		    objIndex = TclRegisterNewLiteral(envPtr,
 			    tokenPtr[1].start, tokenPtr[1].size);
+
+		    if (eclPtr->type == TCL_LOCATION_SOURCE) {
+			TclEnterCmdWordIndex (eclPtr,
+					      envPtr->literalArrayPtr[objIndex].objPtr,
+					      envPtr->codeNext - envPtr->codeStart,
+					      wordIdx);
+		    }
 		}
 		TclEmitPush(objIndex, envPtr);
 	    } /* for loop */
@@ -2442,6 +2469,24 @@ EnterCmdWordData(
     eclPtr->nuloc ++;
 }
 
+void
+TclEnterCmdWordIndex (eclPtr, obj, pc, word)
+     ExtCmdLoc *eclPtr;
+     Tcl_Obj*   obj;
+     int        pc;
+     int        word;
+{
+    int       new;
+    ExtIndex* eiPtr = (ExtIndex*) ckalloc (sizeof (ExtIndex));
+
+    eiPtr->pc   = pc;
+    eiPtr->word = word;
+
+    Tcl_SetHashValue (Tcl_CreateHashEntry (&eclPtr->litIndex,
+					   (char*) obj, &new),
+		      eiPtr);
+}
+
 /*
  *----------------------------------------------------------------------
  *
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 21ff9cc..a27bbd9 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.93 2008/07/13 09:03:33 msofer Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.94 2008/07/21 22:50:34 andreas_kupries Exp $
  */
 
 #ifndef _TCLCOMPILATION
@@ -129,7 +129,7 @@ typedef struct CmdLocation {
 
 typedef struct ECL {
     int srcOffset;		/* Command location to find the entry. */
-    int nline;
+    int nline;                  /* Number of words in the command */
     int *line;			/* Line information for all words in the
 				 * command. */
 } ECL;
@@ -141,8 +141,17 @@ typedef struct ExtCmdLoc {
     ECL *loc;			/* Command word locations (lines). */
     int nloc;			/* Number of allocated entries in 'loc'. */
     int nuloc;			/* Number of used entries in 'loc'. */
+    Tcl_HashTable litIndex;     /* HashValue is ExtIndex* */
 } ExtCmdLoc;
 
+typedef struct ExtIndex {
+  int pc;   /* Instruction pointer of a command in ExtCmdLoc.loc[.] */
+  int word; /* Index of word in ExtCmdLoc.loc[cmd]->line[.] */
+} ExtIndex;
+
+EXTERN void TclEnterCmdWordIndex (ExtCmdLoc *eclPtr, Tcl_Obj* obj,
+				  int pc, int word);
+
 /*
  * CompileProcs need the ability to record information during compilation that
  * can be used by bytecode instructions during execution. The AuxData
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 1857153..7614f32 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -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: tclInt.h,v 1.375 2008/07/21 16:26:06 msofer Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.376 2008/07/21 22:50:34 andreas_kupries Exp $
  */
 
 #ifndef _TCLINT
@@ -1150,6 +1150,12 @@ typedef struct CmdFrame {
     } cmd;
 } CmdFrame;
 
+typedef struct CFWord {
+    CmdFrame* framePtr;  /* CmdFrame to acess */
+    int       word;      /* Index of the word in the command */
+    int       refCount;  /* #times the word is on the stack */
+} CFWord;
+
 /*
  * The following macros define the allowed values for the type field of the
  * CmdFrame structure above. Some of the values occur only in the extended
@@ -1862,11 +1868,26 @@ typedef struct Interp {
     Tcl_HashTable *linePBodyPtr;/* This table remembers for each statically
 				 * defined procedure the location information
 				 * for its body. It is keyed by the address of
-				 * the Proc structure for a procedure. */
+				 * the Proc structure for a procedure. The
+				 * values are "struct CmdFrame*". */
     Tcl_HashTable *lineBCPtr;	/* This table remembers for each ByteCode
 				 * object the location information for its
 				 * body. It is keyed by the address of the
-				 * Proc structure for a procedure. */
+				 * Proc structure for a procedure. The values
+				 * are "struct ExtCmdLoc*" (See tclCompile.h) */
+    Tcl_HashTable* lineLAPtr;   /* This table remembers for each argument of a
+				 * command on the execution stack the index of
+				 * the argument in the command, and the
+				 * location data of the command. It is keyed
+				 * by the address of the Tcl_Obj containing
+				 * the argument. The values are "struct
+				 * CFWord*" (See tclBasic.c). This allows
+				 * commands like uplevel, eval, etc. to find
+				 * location information for their arguments,
+				 * if they are a proper literal argument to an
+				 * invoking command. Alt view: An index to the
+				 * CmdFrame stack keyed by command argument
+				 * holders. */
     /*
      * TIP #268. The currently active selection mode, i.e. the package require
      * preferences.
@@ -2486,6 +2507,12 @@ MODULE_SCOPE int        TclEvalObjv(Tcl_Interp *interp, int objc,
 
 MODULE_SCOPE void       TclAdvanceLines(int *line, const char *start,
 			    const char *end);
+MODULE_SCOPE void       TclArgumentEnter(Tcl_Interp* interp,
+			    Tcl_Obj* objv[], int objc, CmdFrame* cf);
+MODULE_SCOPE void       TclArgumentRelease(Tcl_Interp* interp,
+			    Tcl_Obj* objv[], int objc);
+MODULE_SCOPE void       TclArgumentGet(Tcl_Interp* interp, Tcl_Obj* obj,
+			    CmdFrame** cfPtrPtr, int* wordPtr);
 MODULE_SCOPE int	TclArraySet(Tcl_Interp *interp,
 			    Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj);
 MODULE_SCOPE double	TclBignumToDouble(mp_int *bignum);
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index b4b89a4..6c55d97 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.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: tclInterp.c,v 1.91 2008/07/19 22:50:40 nijtmans Exp $
+ * RCS: @(#) $Id: tclInterp.c,v 1.92 2008/07/21 22:50:35 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -2614,7 +2614,7 @@ SlaveEval(
 
     if (objc == 1) {
 	/*
-	 * TIP #280: Make invoker available to eval'd script.
+	 * TIP #280: Make actual argument location available to eval'd script.
 	 *
 	 * Do not let any intReps accross, with the exception of
 	 * bytecodes. The intrep spoiling is due to happen anyway when
@@ -2622,6 +2622,8 @@ SlaveEval(
 	 */
 
         Interp *iPtr = (Interp *) interp;
+	CmdFrame* invoker = iPtr->cmdFramePtr;
+	int word          = 0;
 
 	objPtr = objv[0];
 	if (objPtr->typePtr
@@ -2631,8 +2633,10 @@ SlaveEval(
 	    TclFreeIntRep(objPtr);
 	    objPtr->typePtr = NULL;
 	}
+
+	TclArgumentGet (interp, objPtr, &invoker, &word);
 	
-	result = TclEvalObjEx(slaveInterp, objPtr, 0, iPtr->cmdFramePtr, 0);
+	result = TclEvalObjEx(slaveInterp, objPtr, 0, invoker, word);
     } else {
 	objPtr = Tcl_ConcatObj(objc, objv);
 	Tcl_IncrRefCount(objPtr);
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index cf7e250..3eda959 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -23,7 +23,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclNamesp.c,v 1.170 2008/07/21 16:26:08 msofer Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.171 2008/07/21 22:50:36 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -3265,6 +3265,8 @@ NamespaceEvalCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Interp *iPtr = (Interp *) interp;
+    CmdFrame* invoker;
+    int word;
     Tcl_Namespace *namespacePtr;
     CallFrame *framePtr, **framePtrPtr;
     Tcl_Obj *objPtr;
@@ -3312,7 +3314,14 @@ NamespaceEvalCmd(
     framePtr->objv = objv;
 
     if (objc == 4) {
-	objPtr = objv[3];
+	/*
+	 * TIP #280: Make actual argument location available to eval'd script.
+	 */
+
+	objPtr  = objv[3];
+	invoker = iPtr->cmdFramePtr;
+	word    = 3;
+	TclArgumentGet (interp, objPtr, &invoker, &word);
     } else {
 	/*
 	 * More than one argument: concatenate them together with spaces
@@ -3320,7 +3329,9 @@ NamespaceEvalCmd(
 	 * object when it decrements its refcount after eval'ing it.
 	 */
 
-	objPtr = Tcl_ConcatObj(objc-3, objv+3);
+	objPtr  = Tcl_ConcatObj(objc-3, objv+3);
+	invoker = NULL;
+	word    = 0;
     }
     
     /*
@@ -3329,7 +3340,7 @@ NamespaceEvalCmd(
     
     TclNRAddCallback(interp, NsEval_Callback, namespacePtr, "eval",
 	    NULL, NULL);
-    return TclNREvalObjEx(interp, objPtr, 0, iPtr->cmdFramePtr, 3);
+    return TclNREvalObjEx(interp, objPtr, 0, invoker, word);
 }
 
 static int
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 713ee18..9947549 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclProc.c,v 1.150 2008/07/21 03:43:32 msofer Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.151 2008/07/21 22:50:36 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -919,6 +919,8 @@ TclNRUplevelObjCmd(
 {
 
     register Interp *iPtr = (Interp *) interp;
+    CmdFrame* invoker = NULL;
+    int word          = 0;
     int result;
     CallFrame *savedVarFramePtr, *framePtr;
     Tcl_Obj *objPtr;
@@ -955,7 +957,13 @@ TclNRUplevelObjCmd(
      */
 
     if (objc == 1) {
+	/*
+	 * TIP #280. Make actual argument location available to eval'd script
+	 */
+
+	TclArgumentGet (interp, objv[0], &invoker, &word);
 	objPtr = objv[0];
+
     } else {
 	/*
 	 * More than one argument: concatenate them together with spaces
@@ -968,7 +976,7 @@ TclNRUplevelObjCmd(
 
     TclNRAddCallback(interp, Uplevel_Callback, savedVarFramePtr, NULL, NULL,
 	    NULL);
-    return TclNREvalObjEx(interp, objPtr, 0, NULL, 0);
+    return TclNREvalObjEx(interp, objPtr, 0, invoker, word);
 }
 
 /*
diff --git a/tests/info.test b/tests/info.test
index a83a1fc..43fc794 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -13,7 +13,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: info.test,v 1.50 2008/07/19 22:50:38 nijtmans Exp $
+# RCS: @(#) $Id: info.test,v 1.51 2008/07/21 22:50:36 andreas_kupries Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -746,15 +746,15 @@ test info-22.2 {info frame, bad level absolute} {!singleTestInterp} {
     catch {info frame 9} msg
     set msg
 } {bad level "9"}
-test info-22.3 {info frame, current, relative} {
+test info-22.3 {info frame, current, relative} -match glob -body {
     info frame 0
-} {type eval line 2 cmd {info frame 0} proc ::tcltest::RunTest}
-test info-22.4 {info frame, current, relative, nested} {
+} -result {type source line 750 file */info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-22.4 {info frame, current, relative, nested} -match glob -body {
     set res [info frame 0]
-} {type eval line 2 cmd {info frame 0} proc ::tcltest::RunTest}
-test info-22.5 {info frame, current, absolute} {!singleTestInterp} {
+} -result {type source line 753 file */info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-22.5 {info frame, current, absolute} -constraints {!singleTestInterp} -match glob -body {
     reduce [info frame 7]
-} {type eval line 2 cmd {info frame 7} proc ::tcltest::RunTest}
+} -result {type source line 756 file info.test cmd {info frame 7} proc ::tcltest::RunTest}
 test info-22.6 {info frame, global, relative} {!singleTestInterp} {
     reduce [info frame -6]
 } {type source line 758 file info.test cmd test\ info-22.6\ \{info\ frame,\ global,\ relative\}\ \{!singleTestInter level 0}