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

1 files changed, 46 insertions, 1 deletions

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index bdb81bb..145a7b9 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.146.2.1 2008/05/16 14:27:30 msofer Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.146.2.2 2008/07/21 19:38:17 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -802,6 +802,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);
@@ -814,6 +816,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);
 	}
@@ -903,6 +914,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) {
         /*
@@ -1442,8 +1454,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 */
@@ -2412,6 +2439,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);
+}
+
 /*
  *----------------------------------------------------------------------
  *