* generic/tclBasic.c: TIP #280 implementation, conditional on the define TCL_TIP280.

* 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:
author: andreas_kupries <akupries@shaw.ca> 2006-11-28 22:19:57 (GMT)
committer: andreas_kupries <akupries@shaw.ca> 2006-11-28 22:19:57 (GMT)
commit: bf08959966d3a565773dbddb52b0be2e0747ec3a (patch)
tree: dfdbbd337f6bf772d6f99a7a6ea50aaaab685d00
parent: 78afab8ec5cb163b94f8fed86fb67d9e339d9268 (diff)
download: tcl-bf08959966d3a565773dbddb52b0be2e0747ec3a.zip
tcl-bf08959966d3a565773dbddb52b0be2e0747ec3a.tar.gz
tcl-bf08959966d3a565773dbddb52b0be2e0747ec3a.tar.bz2
18 files changed, 2611 insertions, 56 deletions
diff --git a/ChangeLog b/ChangeLog
index 53c91d6..0e91607 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,25 @@
+2006-11-28  Andreas Kupries  <andreask@activestate.com>
+
+	* generic/tclBasic.c: TIP #280 implementation, conditional on the define TCL_TIP280.
+	* 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:
+
 2006-11-27  Kevin Kenny  <kennykb@acm.org>
  
  	* unix/tclUnixChan.c (TclUnixWaitForFile):
@@ -19,7 +41,7 @@
 
 2006-11-03  Miguel Sofer  <msofer@users.sf.net>
 
-	* generic/tclBasic.c (TEOVI): fix por possible leak of a Command
+	* generic/tclBasic.c (TEOVI): fix for possible leak of a Command
 	in the presence of execution traces that delete it.
 
 	* generic/tclBasic.c (TEOVI):
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index f55c531..76f439c 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -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: tclBasic.c,v 1.75.2.25 2006/11/04 01:37:55 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.75.2.26 2006/11/28 22:19:59 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -41,6 +41,17 @@ static int	        StringTraceProc _ANSI_ARGS_((ClientData clientData,
 						    Tcl_Obj *CONST objv[]));
 static void           StringTraceDeleteProc _ANSI_ARGS_((ClientData clientData));
 
+#ifdef TCL_TIP280
+/* TIP #280 - Modified token based evulation, with line information */
+static int            EvalEx _ANSI_ARGS_((Tcl_Interp *interp, CONST char *script,
+					  int numBytes, int flags, int line));
+
+static int            EvalTokensStandard _ANSI_ARGS_((Tcl_Interp *interp,
+						      Tcl_Token *tokenPtr,
+						      int count, int line));
+
+#endif
+
 extern TclStubs tclStubs;
 
 /*
@@ -334,6 +345,19 @@ Tcl_CreateInterp()
     iPtr->maxNestingDepth = MAX_NESTING_DEPTH;
     iPtr->framePtr = NULL;
     iPtr->varFramePtr = NULL;
+
+#ifdef TCL_TIP280
+    /*
+     * TIP #280 - Initialize the arrays used to extend the ByteCode and
+     * Proc structures.
+     */
+    iPtr->cmdFramePtr  = NULL;
+    iPtr->linePBodyPtr = (Tcl_HashTable*) ckalloc (sizeof (Tcl_HashTable));
+    iPtr->lineBCPtr    = (Tcl_HashTable*) ckalloc (sizeof (Tcl_HashTable));
+    Tcl_InitHashTable(iPtr->linePBodyPtr, TCL_ONE_WORD_KEYS);
+    Tcl_InitHashTable(iPtr->lineBCPtr,    TCL_ONE_WORD_KEYS);
+#endif
+
     iPtr->activeVarTracePtr = NULL;
     iPtr->returnCode = TCL_OK;
     iPtr->errorInfo = NULL;
@@ -589,6 +613,10 @@ Tcl_CreateInterp()
     Tcl_SetVar2(interp, "tcl_platform", "tip,268", "1",
 	    TCL_GLOBAL_ONLY);
 #endif
+#ifdef TCL_TIP280
+    Tcl_SetVar2(interp, "tcl_platform", "tip,280", "1",
+	    TCL_GLOBAL_ONLY);
+#endif
 #ifdef Tcl_InitStubs
 #undef Tcl_InitStubs
 #endif
@@ -1108,6 +1136,62 @@ DeleteInterpProc(interp)
      */
 
     TclDeleteLiteralTable(interp, &(iPtr->literalTable));
+
+#ifdef TCL_TIP280
+    /* TIP #280 - Release the arrays for ByteCode/Proc extension, and contents.
+     */
+    {
+        Tcl_HashEntry *hPtr;
+	Tcl_HashSearch hSearch;
+	CmdFrame*      cfPtr;
+	ExtCmdLoc*     eclPtr;
+	int            i;
+
+	for (hPtr = Tcl_FirstHashEntry(iPtr->linePBodyPtr, &hSearch);
+	     hPtr != NULL;
+	     hPtr = Tcl_NextHashEntry(&hSearch)) {
+
+	    cfPtr = (CmdFrame*) Tcl_GetHashValue (hPtr);
+
+	    if (cfPtr->type == TCL_LOCATION_SOURCE) {
+	        Tcl_DecrRefCount (cfPtr->data.eval.path);
+	    }
+	    ckfree ((char*) cfPtr->line);
+	    ckfree ((char*) cfPtr);
+	    Tcl_DeleteHashEntry (hPtr);
+
+	}
+	Tcl_DeleteHashTable (iPtr->linePBodyPtr);
+	ckfree ((char*) iPtr->linePBodyPtr);
+	iPtr->linePBodyPtr = NULL;
+
+	/* See also tclCompile.c, TclCleanupByteCode */
+
+	for (hPtr = Tcl_FirstHashEntry(iPtr->lineBCPtr, &hSearch);
+	     hPtr != NULL;
+	     hPtr = Tcl_NextHashEntry(&hSearch)) {
+
+	    eclPtr = (ExtCmdLoc*) Tcl_GetHashValue (hPtr);
+
+	    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 (hPtr);
+	}
+	Tcl_DeleteHashTable (iPtr->lineBCPtr);
+	ckfree((char*) iPtr->lineBCPtr);
+	iPtr->lineBCPtr = NULL;
+    }
+#endif
     ckfree((char *) iPtr);
 }
 
@@ -3353,7 +3437,7 @@ Tcl_LogCommandInfo(interp, script, command, length)
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_EvalTokensStandard --
+ * Tcl_EvalTokensStandard, EvalTokensStandard --
  *
  *	Given an array of tokens parsed from a Tcl command (e.g., the
  *	tokens that make up a word or the index for an array variable)
@@ -3367,7 +3451,8 @@ Tcl_LogCommandInfo(interp, script, command, length)
  *
  * Side effects:
  *	Depends on the array of tokens being evaled.
-  *
+ *
+ * TIP #280 : Keep public API, internally extended API.
  *----------------------------------------------------------------------
  */
 
@@ -3381,6 +3466,22 @@ Tcl_EvalTokensStandard(interp, tokenPtr, count)
     int count;			/* Number of tokens to consider at tokenPtr.
 				 * Must be at least 1. */
 {
+#ifdef TCL_TIP280
+  return EvalTokensStandard (interp, tokenPtr, count, 1);
+}
+
+static int
+EvalTokensStandard(interp, tokenPtr, count, line)
+    Tcl_Interp *interp;		/* Interpreter in which to lookup
+				 * variables, execute nested commands,
+				 * and report errors. */
+    Tcl_Token *tokenPtr;	/* Pointer to first in an array of tokens
+				 * to evaluate and concatenate. */
+    int count;			/* Number of tokens to consider at tokenPtr.
+				 * Must be at least 1. */
+    int line;                   /* The line the script starts on. */
+{
+#endif
     Tcl_Obj *resultPtr, *indexPtr, *valuePtr;
     char buffer[TCL_UTF_MAX];
 #ifdef TCL_MEM_DEBUG
@@ -3429,8 +3530,14 @@ Tcl_EvalTokensStandard(interp, tokenPtr, count)
 		iPtr->numLevels++;
 		code = TclInterpReady(interp);
 		if (code == TCL_OK) {
+#ifndef TCL_TIP280
 		    code = Tcl_EvalEx(interp,
 			    tokenPtr->start+1, tokenPtr->size-2, 0);
+#else
+		    /* TIP #280: Transfer line information to nested command */
+		    code = EvalEx(interp,
+			    tokenPtr->start+1, tokenPtr->size-2, 0, line);
+#endif
 		}
 		iPtr->numLevels--;
 		if (code != TCL_OK) {
@@ -3445,8 +3552,14 @@ Tcl_EvalTokensStandard(interp, tokenPtr, count)
 		    indexPtr = NULL;
 		    index = NULL;
 		} else {
+#ifndef TCL_TIP280
 		    code = Tcl_EvalTokensStandard(interp, tokenPtr+2,
 			    tokenPtr->numComponents - 1);
+#else
+		    /* TIP #280: Transfer line information to nested command */
+		    code = EvalTokensStandard(interp, tokenPtr+2,
+			    tokenPtr->numComponents - 1, line);
+#endif
 		    if (code != TCL_OK) {
 			goto done;
 		    }
@@ -3526,8 +3639,7 @@ Tcl_EvalTokensStandard(interp, tokenPtr, count)
     }
     return code;
 }
-
-
+
 /*
  *----------------------------------------------------------------------
  *
@@ -3583,7 +3695,7 @@ Tcl_EvalTokens(interp, tokenPtr, count)
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_EvalEx --
+ * Tcl_EvalEx, EvalEx --
  *
  *	This procedure evaluates a Tcl script without using the compiler
  *	or byte-code interpreter.  It just parses the script, creates
@@ -3598,6 +3710,7 @@ Tcl_EvalTokens(interp, tokenPtr, count)
  * Side effects:
  *	Depends on the script.
  *
+ * TIP #280 : Keep public API, internally extended API.
  *----------------------------------------------------------------------
  */
 
@@ -3614,13 +3727,33 @@ Tcl_EvalEx(interp, script, numBytes, flags)
 				 * TCL_EVAL_GLOBAL is currently
 				 * supported. */
 {
+#ifdef TCL_TIP280
+  return EvalEx (interp, script, numBytes, flags, 1);
+}
+
+static int
+EvalEx(interp, script, numBytes, flags, line)
+    Tcl_Interp *interp;		/* Interpreter in which to evaluate the
+				 * script.  Also used for error reporting. */
+    CONST char *script;		/* First character of script to evaluate. */
+    int numBytes;		/* Number of bytes in script.  If < 0, the
+				 * script consists of all bytes up to the
+				 * first null character. */
+    int flags;			/* Collection of OR-ed bits that control
+				 * the evaluation of the script.  Only
+				 * TCL_EVAL_GLOBAL is currently
+				 * supported. */
+    int line;                   /* The line the script starts on. */
+{
+#endif
     Interp *iPtr = (Interp *) interp;
     CONST char *p, *next;
     Tcl_Parse parse;
 #define NUM_STATIC_OBJS 20
     Tcl_Obj *staticObjArray[NUM_STATIC_OBJS], **objv;
     Tcl_Token *tokenPtr;
-    int i, code, commandLength, bytesLeft, nested;
+    int code = TCL_OK;
+    int i, commandLength, bytesLeft, nested;
     CallFrame *savedVarFramePtr;   /* Saves old copy of iPtr->varFramePtr
 				    * in case TCL_EVAL_GLOBAL was set. */
     int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
@@ -3633,6 +3766,11 @@ Tcl_EvalEx(interp, script, numBytes, flags)
 
     int gotParse = 0, objectsUsed = 0;
 
+#ifdef TCL_TIP280
+    /* TIP #280 Structures for tracking of command locations. */
+    CmdFrame eeFrame;
+#endif
+
     if (numBytes < 0) {
 	numBytes = strlen(script);
     }
@@ -3656,6 +3794,62 @@ Tcl_EvalEx(interp, script, numBytes, flags)
     } else {
 	nested = 0;
     }
+
+#ifdef TCL_TIP280
+    /* TIP #280 Initialize tracking. Do not push on the frame stack yet. */
+    /*
+     * We may cont. counting based on a specific context (CTX), or open a new
+     * context, either for a sourced script, or 'eval'. For sourced files we
+     * always have a path object, even if nothing was specified in the interp
+     * itself. That makes code using it simpler as NULL checks can be left
+     * out. Sourced file without path in the 'scriptFile' is possible during
+     * Tcl initialization.
+     */
+
+    if (iPtr->evalFlags & TCL_EVAL_CTX) {
+        /* Path information comes out of the context. */
+
+        eeFrame.type           = TCL_LOCATION_SOURCE;
+	eeFrame.data.eval.path = iPtr->invokeCmdFramePtr->data.eval.path;
+	Tcl_IncrRefCount (eeFrame.data.eval.path);
+    } else if (iPtr->evalFlags & TCL_EVAL_FILE) {
+	/* Set up for a sourced file */
+
+        eeFrame.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) {
+		/* Error message in the interp result */
+		return TCL_ERROR;
+	    }
+	    eeFrame.data.eval.path = norm;
+	    Tcl_IncrRefCount (eeFrame.data.eval.path);
+	} else {
+	    eeFrame.data.eval.path = Tcl_NewStringObj ("",-1);
+	}
+    } else {
+	/* Set up for plain eval */
+
+        eeFrame.type           = TCL_LOCATION_EVAL;
+	eeFrame.data.eval.path = NULL;
+    }
+
+    eeFrame.level     = (iPtr->cmdFramePtr == NULL
+			 ? 1
+			 : iPtr->cmdFramePtr->level + 1);
+    eeFrame.framePtr  = iPtr->framePtr;
+    eeFrame.nextPtr   = iPtr->cmdFramePtr;
+    eeFrame.nline     = 0;
+    eeFrame.line      = NULL;
+#endif
+
     iPtr->evalFlags = 0;
     do {
 	if (Tcl_ParseCommand(interp, p, bytesLeft, nested, &parse)
@@ -3676,7 +3870,27 @@ Tcl_EvalEx(interp, script, numBytes, flags)
 	    goto error;
 	}
 
+#ifdef TCL_TIP280
+	/*
+	 * TIP #280 Track lines. The parser may have skipped text till it
+	 * found the command we are now at. We have count the lines in this
+	 * block.
+	 */
+
+	TclAdvanceLines (&line, p, parse.commandStart);
+#endif
+
 	if (parse.numWords > 0) {
+#ifdef TCL_TIP280
+	    /*
+	     * TIP #280. Track lines within the words of the current
+	     * command.
+	     */
+
+	    int         wordLine  = line;
+	    CONST char* wordStart = parse.commandStart;
+#endif
+
 	    /*
 	     * Generate an array of objects for the words of the command.
 	     */
@@ -3687,11 +3901,45 @@ Tcl_EvalEx(interp, script, numBytes, flags)
 		objv = (Tcl_Obj **) ckalloc((unsigned)
 		    (parse.numWords * sizeof (Tcl_Obj *)));
 	    }
+
+#ifdef TCL_TIP280
+	    eeFrame.nline = parse.numWords;
+	    eeFrame.line  = (int*) ckalloc((unsigned)
+		  (parse.numWords * sizeof (int)));
+#endif
+
 	    for (objectsUsed = 0, tokenPtr = parse.tokenPtr;
-		    objectsUsed < parse.numWords;
-		    objectsUsed++, tokenPtr += (tokenPtr->numComponents + 1)) {
+		 objectsUsed < parse.numWords;
+		 objectsUsed++, tokenPtr += (tokenPtr->numComponents + 1)) {
+#ifndef TCL_TIP280
 		code = Tcl_EvalTokensStandard(interp, tokenPtr+1, 
 		            tokenPtr->numComponents);
+#else
+	        /*
+		 * TIP #280. Track lines to current word. Save the
+		 * information on a per-word basis, signaling dynamic words as
+		 * needed. Make the information available to the recursively
+		 * called evaluator as well, including the type of context
+		 * (source vs. eval).
+		 */
+
+		TclAdvanceLines (&wordLine, wordStart, tokenPtr->start);
+		wordStart = tokenPtr->start;
+
+                eeFrame.line [objectsUsed] = (TclWordKnownAtCompileTime (tokenPtr)
+					      ? wordLine
+					      : -1);
+
+	        if (eeFrame.type == TCL_LOCATION_SOURCE) {
+		    iPtr->evalFlags |= TCL_EVAL_FILE;
+		}
+
+		code = EvalTokensStandard(interp, tokenPtr+1, 
+		            tokenPtr->numComponents, wordLine);
+
+		iPtr->evalFlags = 0;
+#endif
+
 		if (code == TCL_OK) {
 		    objv[objectsUsed] = Tcl_GetObjResult(interp);
 		    Tcl_IncrRefCount(objv[objectsUsed]);
@@ -3702,12 +3950,36 @@ Tcl_EvalEx(interp, script, numBytes, flags)
     
 	    /*
 	     * Execute the command and free the objects for its words.
+	     *
+	     * TIP #280: Remember the command itself for 'info frame'. We
+	     * shorten the visible command by one char to exclude the
+	     * termination character, if necessary. Here is where we put our
+	     * frame on the stack of frames too. _After_ the nested commands
+	     * have been executed.
 	     */
 
+#ifdef TCL_TIP280
+	    eeFrame.cmd.str.cmd = parse.commandStart;
+	    eeFrame.cmd.str.len = parse.commandSize;
+
+	    if (parse.term == parse.commandStart + parse.commandSize - 1) {
+		eeFrame.cmd.str.len --;
+	    }
+
+	    iPtr->cmdFramePtr = &eeFrame;
+#endif
 	    iPtr->numLevels++;    
 	    code = TclEvalObjvInternal(interp, objectsUsed, objv, 
 	            parse.commandStart, parse.commandSize, 0);
 	    iPtr->numLevels--;
+#ifdef TCL_TIP280
+	    iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
+
+	    ckfree ((char*) eeFrame.line);
+	    eeFrame.line  = NULL;
+	    eeFrame.nline = 0;
+#endif
+
 	    if (code != TCL_OK) {
 		goto error;
 	    }
@@ -3723,11 +3995,17 @@ Tcl_EvalEx(interp, script, numBytes, flags)
 
 	/*
 	 * Advance to the next command in the script.
+	 *
+	 * TIP #280 Track Lines. Now we track how many lines were in the
+	 * executed command.
 	 */
 
 	next = parse.commandStart + parse.commandSize;
 	bytesLeft -= next - p;
 	p = next;
+#ifdef TCL_TIP280
+	TclAdvanceLines (&line, parse.commandStart, p);
+#endif
 	Tcl_FreeParse(&parse);
 	gotParse = 0;
 	if (nested && (*parse.term == ']')) {
@@ -3740,7 +4018,12 @@ Tcl_EvalEx(interp, script, numBytes, flags)
 
 	    iPtr->termOffset = (p - 1) - script;
 	    iPtr->varFramePtr = savedVarFramePtr;
+#ifndef TCL_TIP280
 	    return TCL_OK;
+#else
+	    code = TCL_OK;
+	    goto cleanup_return;
+#endif
 	}
     } while (bytesLeft > 0);
 
@@ -3755,7 +4038,12 @@ Tcl_EvalEx(interp, script, numBytes, flags)
     
     iPtr->termOffset = p - script;
     iPtr->varFramePtr = savedVarFramePtr;
+#ifndef TCL_TIP280
     return TCL_OK;
+#else
+    code = TCL_OK;
+    goto cleanup_return;
+#endif
 
     error:
     /*
@@ -3812,7 +4100,11 @@ Tcl_EvalEx(interp, script, numBytes, flags)
 
     if (!nested) {
 	iPtr->termOffset = p - script;
+#ifndef TCL_TIP280
 	return code;
+#else
+	goto cleanup_return;
+#endif
     }
 
     /*
@@ -3840,7 +4132,11 @@ Tcl_EvalEx(interp, script, numBytes, flags)
 	    } else {
 	        iPtr->termOffset = (next - 1) - script;
 	    }
+#ifndef TCL_TIP280
 	    return code;
+#else
+	    goto cleanup_return;
+#endif
 	}
 	next = parse.commandStart + parse.commandSize;
 	bytesLeft -= next - p;
@@ -3863,7 +4159,12 @@ Tcl_EvalEx(interp, script, numBytes, flags)
 	iPtr->termOffset = parse.term - script;
 	Tcl_SetObjResult(interp,
 		Tcl_NewStringObj("missing close-bracket", -1));
+#ifndef TCL_TIP280
 	return TCL_ERROR;
+#else
+	code = TCL_ERROR;
+	goto cleanup_return;
+#endif
     } else if (*parse.term != ']') {
 	/*
 	 * There was no close-bracket.  Syntax error.
@@ -3872,16 +4173,67 @@ Tcl_EvalEx(interp, script, numBytes, flags)
 	iPtr->termOffset = (parse.term + 1) - script;
 	Tcl_SetObjResult(interp,
 		Tcl_NewStringObj("missing close-bracket", -1));
+#ifndef TCL_TIP280
 	return TCL_ERROR;
+#else
+	code = TCL_ERROR;
+	goto cleanup_return;
+#endif
     } else {
 	/* 
 	 * parse.term points to the close-bracket.
 	 */
 	iPtr->termOffset = parse.term - script;
     }
+
+#ifdef TCL_TIP280
+ cleanup_return:
+    /* TIP #280. Release the local CmdFrame, and its contents. */
+
+    if (eeFrame.line != NULL) {
+        ckfree ((char*) eeFrame.line);
+    }
+    if (eeFrame.type == TCL_LOCATION_SOURCE) {
+        Tcl_DecrRefCount (eeFrame.data.eval.path);
+    }
+#endif
     return code;
 }
 
+#ifdef TCL_TIP280
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclAdvanceLines --
+ *
+ *	This procedure is a helper which counts the number of lines
+ *	in a block of text and advances an external counter.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The specified counter is advanced per the number of lines found.
+ *
+ * TIP #280
+ *----------------------------------------------------------------------
+ */
+
+void
+TclAdvanceLines (line,start,end)
+     int*        line;
+     CONST char* start;
+     CONST char* end;
+{
+    CONST char* p;
+    for (p = start; p < end; p++) {
+        if (*p == '\n') {
+	  (*line) ++;
+	}
+    }
+}
+#endif
+
 /*
  *----------------------------------------------------------------------
  *
@@ -3963,7 +4315,7 @@ Tcl_GlobalEvalObj(interp, objPtr)
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_EvalObjEx --
+ * Tcl_EvalObjEx, TclEvalObjEx --
  *
  *	Execute Tcl commands stored in a Tcl object. These commands are
  *	compiled into bytecodes if necessary, unless TCL_EVAL_DIRECT
@@ -3983,6 +4335,7 @@ Tcl_GlobalEvalObj(interp, objPtr)
  *	Just as in Tcl_Eval, interp->termOffset is set to the offset of the
  *	last character executed in the objPtr's string.
  *
+ * TIP #280 : Keep public API, internally extended API.
  *----------------------------------------------------------------------
  */
 
@@ -3999,6 +4352,26 @@ Tcl_EvalObjEx(interp, objPtr, flags)
 					 * TCL_EVAL_GLOBAL and
 					 * TCL_EVAL_DIRECT. */
 {
+#ifdef TCL_TIP280
+  return TclEvalObjEx (interp, objPtr, flags, NULL, 0);
+}
+
+int
+TclEvalObjEx(interp, objPtr, flags, invoker, word)
+    Tcl_Interp *interp;			/* Token for command interpreter
+					 * (returned by a previous call to
+					 * Tcl_CreateInterp). */
+    register Tcl_Obj *objPtr;		/* Pointer to object containing
+					 * commands to execute. */
+    int flags;				/* Collection of OR-ed bits that
+					 * control the evaluation of the
+					 * script.  Supported values are
+					 * TCL_EVAL_GLOBAL and
+					 * TCL_EVAL_DIRECT. */
+    CONST CmdFrame* invoker; /* Frame of the command doing the eval  */
+    int             word;    /* Index of the word which is in objPtr */
+{
+#endif
     register Interp *iPtr = (Interp *) interp;
     char *script;
     int numSrcBytes;
@@ -4030,36 +4403,171 @@ Tcl_EvalObjEx(interp, objPtr, flags)
 	    register List *listRepPtr =
 		(List *) objPtr->internalRep.twoPtrValue.ptr1;
 	    int i, objc = listRepPtr->elemCount;
+
 #define TEOE_PREALLOC 10
 	    Tcl_Obj *staticObjv[TEOE_PREALLOC], **objv = staticObjv;
 
+#ifdef TCL_TIP280
+	    /* TIP #280 Structures for tracking lines.
+	     * As we know that this is dynamic execution we ignore the
+	     * invoker, even if known.
+	     */
+	    int      line;
+	    CmdFrame eoFrame;
+
+	    eoFrame.type     = TCL_LOCATION_EVAL_LIST;
+	    eoFrame.level    = (iPtr->cmdFramePtr == NULL ?
+				1 :
+				iPtr->cmdFramePtr->level + 1);
+	    eoFrame.framePtr = iPtr->framePtr;
+	    eoFrame.nextPtr  = iPtr->cmdFramePtr;
+	    eoFrame.nline    = objc;
+	    eoFrame.line     = (int*) ckalloc (objc * sizeof (int));
+
+	    /* NOTE: Getting the string rep of the list to eval to fill the
+	     * command information required by 'info frame' implies that
+	     * further calls for the same list would not be optimized, as it
+	     * would not be 'pure' anymore. It would also be a waste of time
+	     * as most of the time this information is not needed at all. What
+	     * we do instead is to keep the list obj itself around and have
+	     * 'info frame' sort it out.
+	     */
+
+	    eoFrame.cmd.listPtr  = objPtr;
+	    Tcl_IncrRefCount (eoFrame.cmd.listPtr);
+	    eoFrame.data.eval.path = NULL;
+#endif
 	    if (objc > TEOE_PREALLOC) {
 		objv = (Tcl_Obj **) ckalloc(objc*sizeof(Tcl_Obj *));
 	    }
 #undef TEOE_PREALLOC
 	    /*
-	     * Copy the list elements here, to avoid a segfault if objPtr
-	     * loses its List internal rep [Bug 1119369]
+	     * Copy the list elements here, to avoid a segfault if
+	     * objPtr loses its List internal rep [Bug 1119369].
+	     *
+	     * TIP #280 Computes all the line numbers for the
+	     * words in the command.
 	     */
-	    
+
+#ifdef TCL_TIP280
+	    line = 1;
+#endif
 	    for (i=0; i < objc; i++) {
 		objv[i] = listRepPtr->elements[i];
 		Tcl_IncrRefCount(objv[i]);
+#ifdef TCL_TIP280
+		eoFrame.line [i] = line;
+		{
+		    char* w = Tcl_GetString (objv [i]);
+		    TclAdvanceLines (&line, w, w+ strlen(w));
+		}
+#endif
 	    }
+
+#ifdef TCL_TIP280
+	    iPtr->cmdFramePtr = &eoFrame;
+#endif
 	    result = Tcl_EvalObjv(interp, objc, objv, flags);
+#ifdef TCL_TIP280
+	    iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
+	    Tcl_DecrRefCount (eoFrame.cmd.listPtr);
+#endif
+
 	    for (i=0; i < objc; i++) {
 		TclDecrRefCount(objv[i]);
 	    }
 	    if (objv != staticObjv) {
 		ckfree((char *) objv);
 	    }
+#ifdef TCL_TIP280
+	    ckfree ((char*) eoFrame.line);
+	    eoFrame.line  = NULL;
+	    eoFrame.nline = 0;
+#endif
 	} else {
+#ifndef TCL_TIP280
 	    script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
 	    result = Tcl_EvalEx(interp, script, numSrcBytes, flags);
+#else
+	    /*
+	     * TIP #280. Propagate context as much as we can. Especially if
+	     * the script to evaluate is a single literal it makes sense to
+	     * look if our context is one with absolute line numbers we can
+	     * then track into the literal itself too.
+	     *
+	     * See also tclCompile.c, TclInitCompileEnv, for the equivalent
+	     * code in the bytecode compiler.
+	     */
+
+	    if (invoker == NULL) {
+	        /* No context, force opening of our own */
+	        script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
+		result = Tcl_EvalEx(interp, script, numSrcBytes, flags);
+	    } else {
+		/* We have an invoker, describing the command asking for the
+		 * evaluation of a subordinate script. This script may
+		 * originate in a literal word, or from a variable, etc. Using
+		 * the line array we now check if we have good line
+		 * information for the relevant word. The type of context is
+		 * relevant as well. In a non-'source' context we don't have
+		 * to try tracking lines.
+		 *
+		 * First see if the word exists and is a literal. If not we go
+		 * through the easy dynamic branch. No need to perform more
+		 * complex invokations.
+		 */
+
+		if ((invoker->nline <= word) || (invoker->line[word] < 0)) {
+		    /* 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
+		     */
+
+		    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;
+		    }
+
+		    if (ctx.type == TCL_LOCATION_SOURCE) {
+			/* Absolute context to reuse. */
+
+			iPtr->invokeCmdFramePtr = &ctx;
+			iPtr->evalFlags |= TCL_EVAL_CTX;
+
+			script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
+			result = EvalEx(interp, script, numSrcBytes, flags, ctx.line [word]);
+
+			if (pc) {
+			    /* Death of SrcInfo reference */
+			    Tcl_DecrRefCount (ctx.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);
+		    }
+		}
+	    }
+#endif
 	}
     } else {
 	/*
 	 * Let the compiler/engine subsystem do the evaluation.
+	 *
+	 * TIP #280 The invoker provides us with the context for the
+	 * script. We transfer this to the byte code compiler.
 	 */
 
 	savedVarFramePtr = iPtr->varFramePtr;
@@ -4067,7 +4575,11 @@ Tcl_EvalObjEx(interp, objPtr, flags)
 	    iPtr->varFramePtr = NULL;
 	}
 
+#ifndef TCL_TIP280
 	result = TclCompEvalObj(interp, objPtr);
+#else
+	result = TclCompEvalObj(interp, objPtr, invoker, word);
+#endif
 
 	/*
 	 * If we are again at the top level, process any unusual 
@@ -5570,4 +6082,12 @@ Tcl_GetVersion(majorV, minorV, patchLevelV, type)
         *type = TCL_RELEASE_LEVEL;
     }
 }
- 
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
+
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index c3402ef..6621714 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.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: tclCmdAH.c,v 1.27.2.15 2005/10/23 22:01:29 msofer Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.27.2.16 2006/11/28 22:20:00 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -235,6 +235,9 @@ Tcl_CatchObjCmd(dummy, interp, objc, objv)
 {
     Tcl_Obj *varNamePtr = NULL;
     int result;
+#ifdef TCL_TIP280
+    Interp* iPtr = (Interp*) interp;
+#endif
 
     if ((objc != 2) && (objc != 3)) {
 	Tcl_WrongNumArgs(interp, 1, objv, "command ?varName?");
@@ -245,7 +248,12 @@ Tcl_CatchObjCmd(dummy, interp, objc, objv)
 	varNamePtr = objv[2];
     }
 
+#ifndef TCL_TIP280
     result = Tcl_EvalObjEx(interp, objv[1], 0);
+#else
+    /* TIP #280. Make invoking context available to caught script */
+    result = TclEvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr,1);
+#endif
     
     if (objc == 3) {
 	if (Tcl_ObjSetVar2(interp, varNamePtr, NULL,
@@ -592,6 +600,9 @@ Tcl_EvalObjCmd(dummy, interp, objc, objv)
 {
     int result;
     register Tcl_Obj *objPtr;
+#ifdef TCL_TIP280
+    Interp* iPtr = (Interp*) interp;
+#endif
 
     if (objc < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?");
@@ -599,7 +610,13 @@ Tcl_EvalObjCmd(dummy, interp, objc, objv)
     }
     
     if (objc == 2) {
+#ifndef TCL_TIP280
 	result = Tcl_EvalObjEx(interp, objv[1], TCL_EVAL_DIRECT);
+#else
+	/* TIP #280. Make invoking context available to eval'd script */
+	result = TclEvalObjEx(interp, objv[1], TCL_EVAL_DIRECT,
+			      iPtr->cmdFramePtr,1);
+#endif
     } else {
 	/*
 	 * More than one argument: concatenate them together with spaces
@@ -607,7 +624,12 @@ Tcl_EvalObjCmd(dummy, interp, objc, objv)
 	 * the object when it decrements its refcount after eval'ing it.
 	 */
     	objPtr = Tcl_ConcatObj(objc-1, objv+1);
+#ifndef TCL_TIP280
 	result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT);
+#else
+	/* TIP #280. Make invoking context available to eval'd script */
+	result = TclEvalObjEx(interp, objPtr, TCL_EVAL_DIRECT, NULL, 0);
+#endif
     }
     if (result == TCL_ERROR) {
 	char msg[32 + TCL_INTEGER_SPACE];
@@ -1607,13 +1629,21 @@ Tcl_ForObjCmd(dummy, interp, objc, objv)
     Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
     int result, value;
+#ifdef TCL_TIP280
+    Interp* iPtr = (Interp*) interp;
+#endif
 
     if (objc != 5) {
         Tcl_WrongNumArgs(interp, 1, objv, "start test next command");
         return TCL_ERROR;
     }
 
+#ifndef TCL_TIP280
     result = Tcl_EvalObjEx(interp, objv[1], 0);
+#else
+    /* TIP #280. Make invoking context available to initial script */
+    result = TclEvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr,1);
+#endif
     if (result != TCL_OK) {
         if (result == TCL_ERROR) {
             Tcl_AddErrorInfo(interp, "\n    (\"for\" initial command)");
@@ -1635,7 +1665,12 @@ Tcl_ForObjCmd(dummy, interp, objc, objv)
         if (!value) {
             break;
         }
+#ifndef TCL_TIP280
         result = Tcl_EvalObjEx(interp, objv[4], 0);
+#else
+	/* TIP #280. Make invoking context available to loop body */
+        result = TclEvalObjEx(interp, objv[4], 0, iPtr->cmdFramePtr,4);
+#endif
         if ((result != TCL_OK) && (result != TCL_CONTINUE)) {
             if (result == TCL_ERROR) {
                 char msg[32 + TCL_INTEGER_SPACE];
@@ -1645,7 +1680,12 @@ Tcl_ForObjCmd(dummy, interp, objc, objv)
             }
             break;
         }
+#ifndef TCL_TIP280
         result = Tcl_EvalObjEx(interp, objv[3], 0);
+#else
+	/* TIP #280. Make invoking context available to next script */
+        result = TclEvalObjEx(interp, objv[3], 0, iPtr->cmdFramePtr,3);
+#endif
 	if (result == TCL_BREAK) {
             break;
         } else if (result != TCL_OK) {
@@ -1719,6 +1759,9 @@ Tcl_ForeachObjCmd(dummy, interp, objc, objv)
     Tcl_Obj ***varvList = varvListArray;   /* Array of var name lists */
     int *argcList = argcListArray;	   /* Array of value list sizes */
     Tcl_Obj ***argvList = argvListArray;   /* Array of value lists */
+#ifdef TCL_TIP280
+    Interp* iPtr = (Interp*) interp;
+#endif
 
     if (objc < 4 || (objc%2 != 0)) {
 	Tcl_WrongNumArgs(interp, 1, objv,
@@ -1848,7 +1891,12 @@ Tcl_ForeachObjCmd(dummy, interp, objc, objv)
 	    }
 	}
 
+#ifndef TCL_TIP280
 	result = Tcl_EvalObjEx(interp, bodyPtr, 0);
+#else
+	/* TIP #280. Make invoking context available to loop body */
+	result = TclEvalObjEx(interp, bodyPtr, 0, iPtr->cmdFramePtr,objc-1);
+#endif
 	if (result != TCL_OK) {
 	    if (result == TCL_CONTINUE) {
 		result = TCL_OK;
@@ -2394,3 +2442,12 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
     Tcl_DecrRefCount(resultPtr);
     return TCL_ERROR;
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
+
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index a867272..d44ba7a 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.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: tclCmdIL.c,v 1.47.2.9 2005/12/09 14:39:25 dkf Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.47.2.10 2006/11/28 22:20:00 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -109,6 +109,12 @@ static int		InfoDefaultCmd _ANSI_ARGS_((ClientData dummy,
 static int		InfoExistsCmd _ANSI_ARGS_((ClientData dummy,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *CONST objv[]));
+#ifdef TCL_TIP280
+/* TIP #280 - New 'info' subcommand 'frame' */
+static int		InfoFrameCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+#endif
 static int		InfoFunctionsCmd _ANSI_ARGS_((ClientData dummy,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *CONST objv[]));
@@ -188,6 +194,9 @@ Tcl_IfObjCmd(dummy, interp, objc, objv)
     Tcl_Obj *CONST objv[];		/* Argument objects. */
 {
     int thenScriptIndex = 0;	/* then script to be evaled after syntax check */
+#ifdef TCL_TIP280
+    Interp* iPtr = (Interp*) interp;
+#endif
     int i, result, value;
     char *clause;
     i = 1;
@@ -240,7 +249,13 @@ Tcl_IfObjCmd(dummy, interp, objc, objv)
 	i++;
 	if (i >= objc) {
 	    if (thenScriptIndex) {
+#ifndef TCL_TIP280
 		return Tcl_EvalObjEx(interp, objv[thenScriptIndex], 0);
+#else
+		/* TIP #280. Make invoking context available to branch */
+		return TclEvalObjEx(interp, objv[thenScriptIndex], 0,
+				    iPtr->cmdFramePtr,thenScriptIndex);
+#endif
 	    }
 	    return TCL_OK;
 	}
@@ -274,9 +289,19 @@ Tcl_IfObjCmd(dummy, interp, objc, objv)
 	return TCL_ERROR;
     }
     if (thenScriptIndex) {
+#ifndef TCL_TIP280
 	return Tcl_EvalObjEx(interp, objv[thenScriptIndex], 0);
+#else
+	/* TIP #280. Make invoking context available to branch/else */
+	return TclEvalObjEx(interp, objv[thenScriptIndex], 0,
+			    iPtr->cmdFramePtr,thenScriptIndex);
+#endif
     }
+#ifndef TCL_TIP280
     return Tcl_EvalObjEx(interp, objv[i], 0);
+#else
+    return TclEvalObjEx(interp, objv[i], 0, iPtr->cmdFramePtr,i);
+#endif
 }
 
 /*
@@ -397,16 +422,24 @@ Tcl_InfoObjCmd(clientData, interp, objc, objv)
     Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
     static CONST char *subCmds[] = {
-            "args", "body", "cmdcount", "commands",
-	     "complete", "default", "exists", "functions", "globals",
-	     "hostname", "level", "library", "loaded",
+	     "args", "body", "cmdcount", "commands",
+	     "complete", "default", "exists",
+#ifdef TCL_TIP280
+	     "frame",
+#endif
+	     "functions",
+	     "globals", "hostname", "level", "library", "loaded",
 	     "locals", "nameofexecutable", "patchlevel", "procs",
 	     "script", "sharedlibextension", "tclversion", "vars",
 	     (char *) NULL};
     enum ISubCmdIdx {
 	    IArgsIdx, IBodyIdx, ICmdCountIdx, ICommandsIdx,
-	    ICompleteIdx, IDefaultIdx, IExistsIdx, IFunctionsIdx, IGlobalsIdx,
-	    IHostnameIdx, ILevelIdx, ILibraryIdx, ILoadedIdx,
+	    ICompleteIdx, IDefaultIdx, IExistsIdx,
+#ifdef TCL_TIP280
+	    IFrameIdx,
+#endif
+	    IFunctionsIdx,
+	    IGlobalsIdx, IHostnameIdx, ILevelIdx, ILibraryIdx, ILoadedIdx,
 	    ILocalsIdx, INameOfExecutableIdx, IPatchLevelIdx, IProcsIdx,
 	    IScriptIdx, ISharedLibExtensionIdx, ITclVersionIdx, IVarsIdx
     };
@@ -445,6 +478,12 @@ Tcl_InfoObjCmd(clientData, interp, objc, objv)
 	case IExistsIdx:
 	    result = InfoExistsCmd(clientData, interp, objc, objv);
 	    break;
+#ifdef TCL_TIP280
+	case IFrameIdx:
+	    /* TIP #280 - New method 'frame' */
+	    result = InfoFrameCmd(clientData, interp, objc, objv);
+	    break;
+#endif
 	case IFunctionsIdx:
 	    result = InfoFunctionsCmd(clientData, interp, objc, objv);
 	    break;
@@ -997,6 +1036,243 @@ InfoExistsCmd(dummy, interp, objc, objv)
     return TCL_OK;
 }
 
+#ifdef TCL_TIP280
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoFrameCmd --
+ *	TIP #280
+ *
+ *      Called to implement the "info frame" command that returns the
+ *      location of either the currently executing command, or its caller.
+ *      Handles the following syntax:
+ *
+ *          info frame ?number?
+ *
+ * Results:
+ *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoFrameCmd(dummy, interp, objc, objv)
+     ClientData dummy;		/* Not used. */
+     Tcl_Interp *interp;		/* Current interpreter. */
+     int objc;			/* Number of arguments. */
+     Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Interp *iPtr = (Interp *) interp;
+
+    if (objc == 2) {
+	/* just "info frame" */
+        int levels = (iPtr->cmdFramePtr == NULL
+		      ? 0
+		      : iPtr->cmdFramePtr->level);
+
+        Tcl_SetIntObj(Tcl_GetObjResult(interp), levels);
+        return TCL_OK;
+
+    } else if (objc == 3) {
+	/* "info frame level" */
+        int       level;
+	CmdFrame *framePtr;
+
+        if (Tcl_GetIntFromObj(interp, objv[2], &level) != TCL_OK) {
+            return TCL_ERROR;
+        }
+        if (level <= 0) {
+	    /* Relative adressing */
+
+            if (iPtr->cmdFramePtr == NULL) {
+                levelError:
+		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+			"bad level \"",
+			Tcl_GetString(objv[2]),
+			"\"", (char *) NULL);
+                return TCL_ERROR;
+            }
+            /* Convert to absolute. */
+
+            level += iPtr->cmdFramePtr->level;
+        }
+        for (framePtr = iPtr->cmdFramePtr;
+	     framePtr != NULL;
+	     framePtr = framePtr->nextPtr) {
+
+	    if (framePtr->level == level) {
+                break;
+            }
+        }
+        if (framePtr == NULL) {
+            goto levelError;
+        }
+
+	/*
+	 * Pull the information and construct the dictionary to return, as
+	 * list. Regarding use of the CmdFrame fields see tclInt.h, and its
+	 * definition.
+	 */
+
+	{
+	    Tcl_Obj* lv [20]; /* Keep uptodate when more keys are added to the dict */
+	    int      lc = 0;
+
+	    /* This array is indexed by the TCL_LOCATION_... values, except
+	     * for _LAST.
+	     */
+
+	    static CONST char* typeString [TCL_LOCATION_LAST] = {
+	       "eval", "eval", "eval", "precompiled", "source", "proc"
+	    };
+
+	    switch (framePtr->type) {
+	    case TCL_LOCATION_EVAL:
+	        /* Evaluation, dynamic script. Type, line, cmd, the latter
+		 * through str. */
+
+	        lv [lc ++] = Tcl_NewStringObj ("type",-1);
+		lv [lc ++] = Tcl_NewStringObj (typeString [framePtr->type],-1);
+		lv [lc ++] = Tcl_NewStringObj ("line",-1);
+		lv [lc ++] = Tcl_NewIntObj    (framePtr->line[0]);
+		lv [lc ++] = Tcl_NewStringObj ("cmd",-1);
+		lv [lc ++] = Tcl_NewStringObj (framePtr->cmd.str.cmd,
+					       framePtr->cmd.str.len);
+		break;
+
+	    case TCL_LOCATION_EVAL_LIST:
+	        /* List optimized evaluation. Type, line, cmd, the latter
+		 * through listPtr, possibly a frame. */
+
+	        lv [lc ++] = Tcl_NewStringObj ("type",-1);
+		lv [lc ++] = Tcl_NewStringObj (typeString [framePtr->type],-1);
+		lv [lc ++] = Tcl_NewStringObj ("line",-1);
+		lv [lc ++] = Tcl_NewIntObj    (framePtr->line[0]);
+
+		/* We put a duplicate of the command list obj into the result
+		 * to ensure that the 'pure List'-property of the command
+		 * itself is not destroyed. Otherwise the query here would
+		 * disable the list optimization path in Tcl_EvalObjEx.
+		 */
+
+		lv [lc ++] =  Tcl_NewStringObj ("cmd",-1);
+		lv [lc ++] =  Tcl_DuplicateObj (framePtr->cmd.listPtr);
+		break;
+
+	    case TCL_LOCATION_PREBC:
+	        /* Precompiled. Result contains the type as signal, nothing
+		 * else */
+
+	        lv [lc ++] = Tcl_NewStringObj ("type",-1);
+		lv [lc ++] = Tcl_NewStringObj (typeString [framePtr->type],-1);
+		break;
+
+	    case TCL_LOCATION_BC: {
+	        /* Execution of bytecode. Talk to the BC engine to fill out
+		 * the frame. */
+
+	        CmdFrame f       =  *framePtr;
+	        Proc*    procPtr = f.framePtr ? f.framePtr->procPtr : NULL;
+
+		/* Note: Type BC => f.data.eval.path    is not used.
+		 *                  f.data.tebc.codePtr is used instead.
+		 */
+
+	        TclGetSrcInfoForPc (&f);
+		/* Now filled:        cmd.str.(cmd,len), line */
+		/* Possibly modified: type, path! */
+
+	        lv [lc ++] = Tcl_NewStringObj ("type",-1);
+		lv [lc ++] = Tcl_NewStringObj (typeString [f.type],-1);
+		lv [lc ++] = Tcl_NewStringObj ("line",-1);
+		lv [lc ++] = Tcl_NewIntObj    (f.line[0]);
+
+		if (f.type == TCL_LOCATION_SOURCE) {
+		    lv [lc ++] = Tcl_NewStringObj ("file",-1);
+		    lv [lc ++] = f.data.eval.path;
+		    /* Death of reference by TclGetSrcInfoForPc */
+		    Tcl_DecrRefCount (f.data.eval.path);
+		}
+
+		lv [lc ++] = Tcl_NewStringObj ("cmd",-1);
+		lv [lc ++] = Tcl_NewStringObj (f.cmd.str.cmd, f.cmd.str.len);
+
+		if (procPtr != NULL) {
+		    Tcl_HashEntry* namePtr  = procPtr->cmdPtr->hPtr;
+		    char*          procName = Tcl_GetHashKey (namePtr->tablePtr, namePtr);
+		    char*          nsName   = procPtr->cmdPtr->nsPtr->fullName;
+
+		    lv [lc ++] = Tcl_NewStringObj ("proc",-1);
+		    lv [lc ++] = Tcl_NewStringObj (nsName,-1);
+
+		    if (strcmp (nsName, "::") != 0) {
+		        Tcl_AppendToObj (lv [lc-1], "::", -1);
+		    }
+		    Tcl_AppendToObj (lv [lc-1], procName, -1);
+		}
+	        break;
+	    }
+
+	    case TCL_LOCATION_SOURCE:
+	        /* Evaluation of a script file */
+
+	        lv [lc ++] = Tcl_NewStringObj ("type",-1);
+		lv [lc ++] = Tcl_NewStringObj (typeString [framePtr->type],-1);
+		lv [lc ++] = Tcl_NewStringObj ("line",-1);
+		lv [lc ++] = Tcl_NewIntObj    (framePtr->line[0]);
+		lv [lc ++] = Tcl_NewStringObj ("file",-1);
+		lv [lc ++] = framePtr->data.eval.path;
+		/* Refcount framePtr->data.eval.path goes up when lv
+		 * is converted into the result list object.
+		 */
+		lv [lc ++] = Tcl_NewStringObj ("cmd",-1);
+		lv [lc ++] = Tcl_NewStringObj (framePtr->cmd.str.cmd,
+					       framePtr->cmd.str.len);
+		break;
+
+	    case TCL_LOCATION_PROC:
+		Tcl_Panic ("TCL_LOCATION_PROC found in standard frame");
+		break;
+	    }
+
+
+	    /* 'level'. Common to all frame types. Conditional on having an
+	     * associated _visible_ CallFrame */
+
+	    if ((framePtr->framePtr != NULL) && (iPtr->varFramePtr != NULL)) {
+	        CallFrame* current = framePtr->framePtr;
+		CallFrame* top     = iPtr->varFramePtr;
+		CallFrame* idx;
+
+		for (idx = top;
+		     idx != NULL;
+		     idx = idx->callerVarPtr) {
+		    if (idx == current) {
+		        int c = framePtr->framePtr->level;
+			int t = iPtr->varFramePtr->level;
+
+			lv [lc ++] = Tcl_NewStringObj ("level",-1);
+			lv [lc ++] = Tcl_NewIntObj (t - c);
+			break;
+		    }
+		}
+	    }
+
+	    Tcl_SetObjResult(interp, Tcl_NewListObj (lc, lv));
+	    return TCL_OK;
+	}
+    }
+
+    Tcl_WrongNumArgs(interp, 2, objv, "?number?");
+
+    return TCL_ERROR;
+}
+#endif
+
 /*
  *----------------------------------------------------------------------
  *
@@ -3993,3 +4269,12 @@ DictionaryCompare(left, right)
     }
     return diff;
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
+
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 1613799..d4a8732 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.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: tclCmdMZ.c,v 1.82.2.26 2006/04/11 14:37:04 dgp Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.82.2.27 2006/11/28 22:20:00 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -138,6 +138,10 @@ static void		TraceCommandProc _ANSI_ARGS_((ClientData clientData,
                             CONST char *newName, int flags));
 static Tcl_CmdObjTraceProc TraceExecutionProc;
 
+#ifdef TCL_TIP280
+static void             ListLines _ANSI_ARGS_((CONST char* listStr, int line,
+					       int n, int* lines));
+#endif
 /*
  *----------------------------------------------------------------------
  *
@@ -2729,6 +2733,15 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
     char *string, *pattern;
     Tcl_Obj *stringObj;
     Tcl_Obj *CONST *savedObjv = objv;
+#ifdef TCL_TIP280
+    Interp*  iPtr  = (Interp*) interp;
+    int      pc    = 0;
+    int      bidx  = 0;    /* Index of body argument */
+    Tcl_Obj* blist = NULL; /* List obj which is the body */
+    CmdFrame ctx;          /* Copy of the topmost cmdframe,
+			    * to allow us to mess with the
+			    * line information */
+#endif
     static CONST char *options[] = {
 	"-exact",	"-glob",	"-regexp",	"--", 
 	NULL
@@ -2763,16 +2776,25 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
     stringObj = objv[i];
     objc -= i + 1;
     objv += i + 1;
+#ifdef TCL_TIP280
+    bidx = i+1; /* First after the match string */
+#endif
 
     /*
      * If all of the pattern/command pairs are lumped into a single
      * argument, split them out again.
+     *
+     * TIP #280: Determine the lines the words in the list start at, based on
+     * the same data for the list word itself. The cmdFramePtr line information
+     * is manipulated directly.
      */
 
     splitObjs = 0;
     if (objc == 1) {
 	Tcl_Obj **listv;
-
+#ifdef TCL_TIP280
+	blist = objv[0];
+#endif
 	if (Tcl_ListObjGetElements(interp, objv[0], &objc, &listv) != TCL_OK) {
 	    return TCL_ERROR;
 	}
@@ -2871,8 +2893,58 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
 	/*
 	 * We've got a match. Find a body to execute, skipping bodies
 	 * that are "-".
+	 *
+	 * TIP#280: Now is also the time to determine a line number for the
+	 * single-word case.
 	 */
 
+#ifdef TCL_TIP280
+	ctx = *iPtr->cmdFramePtr;
+
+	if (splitObjs) {
+	    /* We have to perform the GetSrc and other type dependent handling
+	     * of the frame here because we are munging with the line numbers,
+	     * something the other commands like if, etc. are not doing. Them
+	     * are fine with simply passing the CmdFrame through and having
+	     * the special handling done in 'info frame', or the bc compiler
+	     */
+
+	    if (ctx.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;
+		/* The line information in the cmdFrame is now a copy we do
+		 * not own */
+	    }
+
+	    if (ctx.type == TCL_LOCATION_SOURCE) {
+		int bline = ctx.line [bidx];
+		if (bline >= 0) {
+		    ctx.line  = (int*) ckalloc (objc * sizeof(int));
+		    ctx.nline = objc;
+
+		    ListLines (Tcl_GetString (blist), bline, objc, ctx.line);
+		} else {
+		    int k;
+		    /* Dynamic code word ... All elements are relative to themselves */
+
+		    ctx.line  = (int*) ckalloc (objc * sizeof(int));
+		    ctx.nline = objc;
+		    for (k=0; k < objc; k++) {ctx.line[k] = -1;}
+		}
+	    } else {
+		int k;
+		/* Anything else ... No information, or dynamic ... */
+
+		ctx.line  = (int*) ckalloc (objc * sizeof(int));
+		ctx.nline = objc;
+		for (k=0; k < objc; k++) {ctx.line[k] = -1;}
+	    }
+	}
+#endif
+
 	for (j = i + 1; ; j += 2) {
 	    if (j >= objc) {
 		/*
@@ -2885,7 +2957,19 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
 		break;
 	    }
 	}
+#ifndef TCL_TIP280
 	result = Tcl_EvalObjEx(interp, objv[j], 0);
+#else
+	/* TIP #280. Make invoking context available to switch branch */
+	result = TclEvalObjEx(interp, objv[j], 0, &ctx, j);
+	if (splitObjs) {
+	    ckfree ((char*) ctx.line);
+	    if (pc && (ctx.type == TCL_LOCATION_SOURCE)) {
+		/* Death of SrcInfo reference */
+		Tcl_DecrRefCount (ctx.data.eval.path);
+	    }
+	}
+#endif
 	if (result == TCL_ERROR) {
 	    char msg[100 + TCL_INTEGER_SPACE];
 
@@ -4860,6 +4944,9 @@ Tcl_WhileObjCmd(dummy, interp, objc, objv)
     Tcl_Obj *CONST objv[];       	/* Argument objects. */
 {
     int result, value;
+#ifdef TCL_TIP280
+    Interp* iPtr = (Interp*) interp;
+#endif
 
     if (objc != 3) {
 	Tcl_WrongNumArgs(interp, 1, objv, "test command");
@@ -4874,7 +4961,12 @@ Tcl_WhileObjCmd(dummy, interp, objc, objv)
         if (!value) {
             break;
         }
+#ifndef TCL_TIP280
         result = Tcl_EvalObjEx(interp, objv[2], 0);
+#else
+	/* TIP #280. */
+        result = TclEvalObjEx(interp, objv[2], 0, iPtr->cmdFramePtr,2);
+#endif
         if ((result != TCL_OK) && (result != TCL_CONTINUE)) {
             if (result == TCL_ERROR) {
                 char msg[32 + TCL_INTEGER_SPACE];
@@ -4894,4 +4986,45 @@ Tcl_WhileObjCmd(dummy, interp, objc, objv)
     }
     return result;
 }
+
+#ifdef TCL_TIP280
+static void
+ListLines(listStr, line, n, lines)
+     CONST char* listStr; /* Pointer to string with list structure.
+			   * Assumed to be valid. Assumed to contain
+			   * n elements.
+			   */
+     int  line;           /* line the list as a whole starts on */
+     int  n;              /* #elements in lines */
+     int* lines;          /* Array of line numbers, to fill */
+{
+    int         i;
+    int         length  = strlen( listStr);
+    CONST char *element = NULL;
+    CONST char* next    = NULL;
+
+    for (i = 0; i < n; i++) {
+	TclFindElement(NULL, listStr, length, &element, &next, NULL, NULL);
+
+	TclAdvanceLines (&line, listStr, element); /* Leading whitespace */
+	lines [i] = line;
+	length   -= (next - listStr);
+	TclAdvanceLines (&line, element, next); /* Element */
+	listStr   = next;
+
+	if (*element == 0) {
+	    /* ASSERT i == n */
+	    break;
+	}
+    }
+}
+#endif
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
 
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 300feb2..0737ab2 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.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: tclCompCmds.c,v 1.39.2.3 2005/03/18 15:32:29 dgp Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.39.2.4 2006/11/28 22:20:00 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -23,9 +23,16 @@
 
 static ClientData	DupForeachInfo _ANSI_ARGS_((ClientData clientData));
 static void		FreeForeachInfo _ANSI_ARGS_((ClientData clientData));
+#ifndef TCL_TIP280
 static int		TclPushVarName _ANSI_ARGS_((Tcl_Interp *interp,
 	Tcl_Token *varTokenPtr, CompileEnv *envPtr, int flags,
 	int *localIndexPtr, int *simpleVarNamePtr, int *isScalarPtr));
+#else
+static int		TclPushVarName _ANSI_ARGS_((Tcl_Interp *interp,
+	Tcl_Token *varTokenPtr, CompileEnv *envPtr, int flags,
+	int *localIndexPtr, int *simpleVarNamePtr, int *isScalarPtr,
+	int line));
+#endif
 
 /*
  * Flags bits used by TclPushVarName.
@@ -78,6 +85,16 @@ TclCompileAppendCmd(interp, parsePtr, envPtr)
     int simpleVarName, isScalar, localIndex, numWords;
     int code = TCL_OK;
 
+#ifdef TCL_TIP280
+    /* TIP #280 : Remember the per-word line information of the current
+     * command. An index is used instead of a pointer as recursive compilation
+     * may reallocate, i.e. move, the array. This is also the reason to save
+     * the nuloc now, it may change during the course of the function.
+     */
+    ExtCmdLoc* mapPtr   = envPtr->extCmdMapPtr;
+    int        eclIndex = mapPtr->nuloc - 1;
+#endif
+
     numWords = parsePtr->numWords;
     if (numWords == 1) {
 	Tcl_ResetResult(interp);
@@ -109,7 +126,12 @@ TclCompileAppendCmd(interp, parsePtr, envPtr)
 	    + (parsePtr->tokenPtr->numComponents + 1);
 
     code = TclPushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
+#ifndef TCL_TIP280
 	    &localIndex, &simpleVarName, &isScalar);
+#else
+	    &localIndex, &simpleVarName, &isScalar,
+	    mapPtr->loc [eclIndex].line [1]);
+#endif
     if (code != TCL_OK) {
 	goto done;
     }
@@ -126,6 +148,9 @@ TclCompileAppendCmd(interp, parsePtr, envPtr)
 	    TclEmitPush(TclRegisterNewLiteral(envPtr, 
 		    valueTokenPtr[1].start, valueTokenPtr[1].size), envPtr);
 	} else {
+#ifdef TCL_TIP280
+	    envPtr->line = mapPtr->loc [eclIndex].line [2];
+#endif
 	    code = TclCompileTokens(interp, valueTokenPtr+1,
 	            valueTokenPtr->numComponents, envPtr);
 	    if (code != TCL_OK) {
@@ -246,6 +271,16 @@ TclCompileCatchCmd(interp, parsePtr, envPtr)
     int code;
     int savedStackDepth = envPtr->currStackDepth;
 
+#ifdef TCL_TIP280
+    /* TIP #280 : Remember the per-word line information of the current
+     * command. An index is used instead of a pointer as recursive compilation
+     * may reallocate, i.e. move, the array. This is also the reason to save
+     * the nuloc now, it may change during the course of the function.
+     */
+    ExtCmdLoc* mapPtr   = envPtr->extCmdMapPtr;
+    int        eclIndex = mapPtr->nuloc - 1;
+#endif
+
     if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
 	Tcl_ResetResult(interp);
 	Tcl_AppendToObj(Tcl_GetObjResult(interp),
@@ -308,6 +343,9 @@ TclCompileCatchCmd(interp, parsePtr, envPtr)
      * errors in the substitution are not catched [Bug 219184]
      */
 
+#ifdef TCL_TIP280
+    envPtr->line = mapPtr->loc [eclIndex].line [1];
+#endif
     if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
 	startOffset = (envPtr->codeNext - envPtr->codeStart);
 	code = TclCompileCmdWord(interp, cmdTokenPtr+1, 1, envPtr);
@@ -462,6 +500,11 @@ TclCompileExprCmd(interp, parsePtr, envPtr)
         return TCL_ERROR;
     }
 
+#ifdef TCL_TIP280
+    /* TIP #280 : Use the per-word line information of the current command.
+     */
+    envPtr->line = envPtr->extCmdMapPtr->loc [envPtr->extCmdMapPtr->nuloc - 1].line [1];
+#endif
     firstWordPtr = parsePtr->tokenPtr
 	    + (parsePtr->tokenPtr->numComponents + 1);
     return TclCompileExprWords(interp, firstWordPtr, (parsePtr->numWords-1),
@@ -500,6 +543,16 @@ TclCompileForCmd(interp, parsePtr, envPtr)
     char buffer[32 + TCL_INTEGER_SPACE];
     int savedStackDepth = envPtr->currStackDepth;
 
+#ifdef TCL_TIP280
+    /* TIP #280 : Remember the per-word line information of the current
+     * command. An index is used instead of a pointer as recursive compilation
+     * may reallocate, i.e. move, the array. This is also the reason to save
+     * the nuloc now, it may change during the course of the function.
+     */
+    ExtCmdLoc* mapPtr   = envPtr->extCmdMapPtr;
+    int        eclIndex = mapPtr->nuloc - 1;
+#endif
+
     if (parsePtr->numWords != 5) {
 	Tcl_ResetResult(interp);
 	Tcl_AppendToObj(Tcl_GetObjResult(interp),
@@ -548,6 +601,9 @@ TclCompileForCmd(interp, parsePtr, envPtr)
      * Inline compile the initial command.
      */
 
+#ifdef TCL_TIP280
+    envPtr->line = mapPtr->loc [eclIndex].line [1];
+#endif
     code = TclCompileCmdWord(interp, startTokenPtr+1,
 	    startTokenPtr->numComponents, envPtr);
     if (code != TCL_OK) {
@@ -579,6 +635,9 @@ TclCompileForCmd(interp, parsePtr, envPtr)
 
     bodyCodeOffset = (envPtr->codeNext - envPtr->codeStart);
 
+#ifdef TCL_TIP280
+    envPtr->line = mapPtr->loc [eclIndex].line [4];
+#endif
     code = TclCompileCmdWord(interp, bodyTokenPtr+1,
 	    bodyTokenPtr->numComponents, envPtr);
     envPtr->currStackDepth = savedStackDepth + 1;
@@ -601,6 +660,9 @@ TclCompileForCmd(interp, parsePtr, envPtr)
 
     nextCodeOffset = (envPtr->codeNext - envPtr->codeStart);
 
+#ifdef TCL_TIP280
+    envPtr->line = mapPtr->loc [eclIndex].line [3];
+#endif
     envPtr->currStackDepth = savedStackDepth;
     code = TclCompileCmdWord(interp, nextTokenPtr+1,
 	    nextTokenPtr->numComponents, envPtr);
@@ -631,7 +693,9 @@ TclCompileForCmd(interp, parsePtr, envPtr)
 	nextCodeOffset += 3;
 	testCodeOffset += 3;
     }
-    
+#ifdef TCL_TIP280
+    envPtr->line = mapPtr->loc [eclIndex].line [2];
+#endif
     envPtr->currStackDepth = savedStackDepth;
     code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
     if (code != TCL_OK) {
@@ -722,6 +786,17 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
     char buffer[32 + TCL_INTEGER_SPACE];
     int savedStackDepth = envPtr->currStackDepth;
 
+#ifdef TCL_TIP280
+    /* TIP #280 : Remember the per-word line information of the current
+     * command. An index is used instead of a pointer as recursive compilation
+     * may reallocate, i.e. move, the array. This is also the reason to save
+     * the nuloc now, it may change during the course of the function.
+     */
+    ExtCmdLoc* mapPtr   = envPtr->extCmdMapPtr;
+    int        eclIndex = mapPtr->nuloc - 1;
+    int        bodyIndex;
+#endif
+
     /*
      * We parse the variable list argument words and create two arrays:
      *    varcList[i] is number of variables in i-th var list
@@ -763,6 +838,9 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
     if (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
 	return TCL_OUT_LINE_COMPILE;
     }
+#ifdef TCL_TIP280
+    bodyIndex = i-1;
+#endif
 
     /*
      * Allocate storage for the varcList and varvList arrays if necessary.
@@ -886,6 +964,9 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
 	    i < numWords-1;
 	    i++, tokenPtr += (tokenPtr->numComponents + 1)) {
 	if ((i%2 == 0) && (i > 0)) {
+#ifdef TCL_TIP280
+	    envPtr->line = mapPtr->loc [eclIndex].line [i];
+#endif
 	    code = TclCompileTokens(interp, tokenPtr+1,
 		    tokenPtr->numComponents, envPtr);
 	    if (code != TCL_OK) {
@@ -923,6 +1004,9 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
      * Inline compile the loop body.
      */
 
+#ifdef TCL_TIP280
+    envPtr->line = mapPtr->loc [eclIndex].line [bodyIndex];
+#endif
     envPtr->exceptArrayPtr[range].codeOffset =
 	    (envPtr->codeNext - envPtr->codeStart);
     code = TclCompileCmdWord(interp, bodyTokenPtr+1,
@@ -1152,6 +1236,16 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
     int boolVal;                /* value of static condition */
     int compileScripts = 1;            
 
+#ifdef TCL_TIP280
+    /* TIP #280 : Remember the per-word line information of the current
+     * command. An index is used instead of a pointer as recursive compilation
+     * may reallocate, i.e. move, the array. This is also the reason to save
+     * the nuloc now, it may change during the course of the function.
+     */
+    ExtCmdLoc* mapPtr   = envPtr->extCmdMapPtr;
+    int        eclIndex = mapPtr->nuloc - 1;
+#endif
+
     /*
      * Only compile the "if" command if all arguments are simple
      * words, in order to insure correct substitution [Bug 219166]
@@ -1233,6 +1327,9 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
 		}
 	    } else {
 		Tcl_ResetResult(interp);
+#ifdef TCL_TIP280
+		envPtr->line = mapPtr->loc [eclIndex].line [wordIdx];
+#endif
 		code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
 		if (code != TCL_OK) {
 		    if (code == TCL_ERROR) {
@@ -1289,6 +1386,9 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
 	 */
 
 	if (compileScripts) {
+#ifdef TCL_TIP280
+	    envPtr->line = mapPtr->loc [eclIndex].line [wordIdx];
+#endif
 	    envPtr->currStackDepth = savedStackDepth;
 	    code = TclCompileCmdWord(interp, tokenPtr+1,
 	            tokenPtr->numComponents, envPtr);
@@ -1391,7 +1491,9 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
 	    /*
 	     * Compile the else command body.
 	     */
-	    
+#ifdef TCL_TIP280
+	    envPtr->line = mapPtr->loc [eclIndex].line [wordIdx];
+#endif
 	    code = TclCompileCmdWord(interp, tokenPtr+1,
 		    tokenPtr->numComponents, envPtr);
 	    if (code != TCL_OK) {
@@ -1503,6 +1605,16 @@ TclCompileIncrCmd(interp, parsePtr, envPtr)
     int simpleVarName, isScalar, localIndex, haveImmValue, immValue;
     int code = TCL_OK;
 
+#ifdef TCL_TIP280
+    /* TIP #280 : Remember the per-word line information of the current
+     * command. An index is used instead of a pointer as recursive compilation
+     * may reallocate, i.e. move, the array. This is also the reason to save
+     * the nuloc now, it may change during the course of the function.
+     */
+    ExtCmdLoc* mapPtr   = envPtr->extCmdMapPtr;
+    int        eclIndex = mapPtr->nuloc - 1;
+#endif
+
     if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
 	Tcl_ResetResult(interp);
 	Tcl_AppendToObj(Tcl_GetObjResult(interp),
@@ -1515,7 +1627,12 @@ TclCompileIncrCmd(interp, parsePtr, envPtr)
 
     code = TclPushVarName(interp, varTokenPtr, envPtr, 
 	    (TCL_NO_LARGE_INDEX | TCL_CREATE_VAR),
+#ifndef TCL_TIP280
 	    &localIndex, &simpleVarName, &isScalar);
+#else
+	    &localIndex, &simpleVarName, &isScalar,
+	    mapPtr->loc [eclIndex].line [1]);
+#endif
     if (code != TCL_OK) {
 	goto done;
     }
@@ -1555,6 +1672,9 @@ TclCompileIncrCmd(interp, parsePtr, envPtr)
 			TclRegisterNewLiteral(envPtr, word, numBytes), envPtr);
 	    }
 	} else {
+#ifdef TCL_TIP280
+	    envPtr->line = mapPtr->loc [eclIndex].line [2];
+#endif
 	    code = TclCompileTokens(interp, incrTokenPtr+1, 
 	            incrTokenPtr->numComponents, envPtr);
 	    if (code != TCL_OK) {
@@ -1647,6 +1767,16 @@ TclCompileLappendCmd(interp, parsePtr, envPtr)
     int simpleVarName, isScalar, localIndex, numWords;
     int code = TCL_OK;
 
+#ifdef TCL_TIP280
+    /* TIP #280 : Remember the per-word line information of the current
+     * command. An index is used instead of a pointer as recursive compilation
+     * may reallocate, i.e. move, the array. This is also the reason to save
+     * the nuloc now, it may change during the course of the function.
+     */
+    ExtCmdLoc* mapPtr   = envPtr->extCmdMapPtr;
+    int        eclIndex = mapPtr->nuloc - 1;
+#endif
+
     /*
      * If we're not in a procedure, don't compile.
      */
@@ -1680,7 +1810,12 @@ TclCompileLappendCmd(interp, parsePtr, envPtr)
 	    + (parsePtr->tokenPtr->numComponents + 1);
 
     code = TclPushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
+#ifndef TCL_TIP280
 	    &localIndex, &simpleVarName, &isScalar);
+#else
+	    &localIndex, &simpleVarName, &isScalar,
+	    mapPtr->loc [eclIndex].line [1]);
+#endif
     if (code != TCL_OK) {
 	goto done;
     }
@@ -1696,6 +1831,9 @@ TclCompileLappendCmd(interp, parsePtr, envPtr)
 	    TclEmitPush(TclRegisterNewLiteral(envPtr, 
 		    valueTokenPtr[1].start, valueTokenPtr[1].size), envPtr);
 	} else {
+#ifdef TCL_TIP280
+	    envPtr->line = mapPtr->loc [eclIndex].line [2];
+#endif
 	    code = TclCompileTokens(interp, valueTokenPtr+1,
 	            valueTokenPtr->numComponents, envPtr);
 	    if (code != TCL_OK) {
@@ -1773,6 +1911,16 @@ TclCompileLindexCmd(interp, parsePtr, envPtr)
     Tcl_Token *varTokenPtr;
     int code, i;
 
+#ifdef TCL_TIP280
+    /* TIP #280 : Remember the per-word line information of the current
+     * command. An index is used instead of a pointer as recursive compilation
+     * may reallocate, i.e. move, the array. This is also the reason to save
+     * the nuloc now, it may change during the course of the function.
+     */
+    ExtCmdLoc* mapPtr   = envPtr->extCmdMapPtr;
+    int        eclIndex = mapPtr->nuloc - 1;
+#endif
+
     int numWords;
     numWords = parsePtr->numWords;
 
@@ -1797,6 +1945,9 @@ TclCompileLindexCmd(interp, parsePtr, envPtr)
 		    TclRegisterNewLiteral( envPtr, varTokenPtr[1].start,
 		    varTokenPtr[1].size), envPtr);
 	} else {
+#ifdef TCL_TIP280
+	    envPtr->line = mapPtr->loc [eclIndex].line [i];
+#endif
 	    code = TclCompileTokens(interp, varTokenPtr+1,
 				    varTokenPtr->numComponents, envPtr);
 	    if (code != TCL_OK) {
@@ -1850,6 +2001,16 @@ TclCompileListCmd(interp, parsePtr, envPtr)
 				 * command created by Tcl_ParseCommand. */
     CompileEnv *envPtr;		/* Holds resulting instructions. */
 {
+#ifdef TCL_TIP280
+    /* TIP #280 : Remember the per-word line information of the current
+     * command. An index is used instead of a pointer as recursive compilation
+     * may reallocate, i.e. move, the array. This is also the reason to save
+     * the nuloc now, it may change during the course of the function.
+     */
+    ExtCmdLoc* mapPtr   = envPtr->extCmdMapPtr;
+    int        eclIndex = mapPtr->nuloc - 1;
+#endif
+
     /*
      * If we're not in a procedure, don't compile.
      */
@@ -1879,6 +2040,9 @@ TclCompileListCmd(interp, parsePtr, envPtr)
 		TclEmitPush(TclRegisterNewLiteral(envPtr,
 			valueTokenPtr[1].start, valueTokenPtr[1].size), envPtr);
 	    } else {
+#ifdef TCL_TIP280
+	        envPtr->line = mapPtr->loc [eclIndex].line [i];
+#endif
 		code = TclCompileTokens(interp, valueTokenPtr+1,
 			valueTokenPtr->numComponents, envPtr);
 		if (code != TCL_OK) {
@@ -1924,6 +2088,16 @@ TclCompileLlengthCmd(interp, parsePtr, envPtr)
     Tcl_Token *varTokenPtr;
     int code;
 
+#ifdef TCL_TIP280
+    /* TIP #280 : Remember the per-word line information of the current
+     * command. An index is used instead of a pointer as recursive compilation
+     * may reallocate, i.e. move, the array. This is also the reason to save
+     * the nuloc now, it may change during the course of the function.
+     */
+    ExtCmdLoc* mapPtr   = envPtr->extCmdMapPtr;
+    int        eclIndex = mapPtr->nuloc - 1;
+#endif
+
     if (parsePtr->numWords != 2) {
 	Tcl_SetResult(interp, "wrong # args: should be \"llength list\"",
 		TCL_STATIC);
@@ -1940,6 +2114,9 @@ TclCompileLlengthCmd(interp, parsePtr, envPtr)
 	TclEmitPush(TclRegisterNewLiteral(envPtr, varTokenPtr[1].start,
 		varTokenPtr[1].size), envPtr);
     } else {
+#ifdef TCL_TIP280
+        envPtr->line = mapPtr->loc [eclIndex].line [1];
+#endif
 	code = TclCompileTokens(interp, varTokenPtr+1,
 		varTokenPtr->numComponents, envPtr);
 	if (code != TCL_OK) {
@@ -2015,6 +2192,16 @@ TclCompileLsetCmd( interp, parsePtr, envPtr )
 
     int i;
 
+#ifdef TCL_TIP280
+    /* TIP #280 : Remember the per-word line information of the current
+     * command. An index is used instead of a pointer as recursive compilation
+     * may reallocate, i.e. move, the array. This is also the reason to save
+     * the nuloc now, it may change during the course of the function.
+     */
+    ExtCmdLoc* mapPtr   = envPtr->extCmdMapPtr;
+    int        eclIndex = mapPtr->nuloc - 1;
+#endif
+
     /* Check argument count */
 
     if ( parsePtr->numWords < 3 ) {
@@ -2033,7 +2220,12 @@ TclCompileLsetCmd( interp, parsePtr, envPtr )
     varTokenPtr = parsePtr->tokenPtr
 	    + (parsePtr->tokenPtr->numComponents + 1);
     result = TclPushVarName( interp, varTokenPtr, envPtr, 
+#ifndef TCL_TIP280
             TCL_CREATE_VAR, &localIndex, &simpleVarName, &isScalar );
+#else
+            TCL_CREATE_VAR, &localIndex, &simpleVarName, &isScalar,
+	    mapPtr->loc [eclIndex].line [1]);
+#endif
     if (result != TCL_OK) {
 	return result;
     }
@@ -2052,6 +2244,9 @@ TclCompileLsetCmd( interp, parsePtr, envPtr )
 	    TclEmitPush(TclRegisterNewLiteral( envPtr, varTokenPtr[1].start,
 		    varTokenPtr[1].size), envPtr);
 	} else {
+#ifdef TCL_TIP280
+	    envPtr->line = mapPtr->loc [eclIndex].line [i];
+#endif
 	    result = TclCompileTokens(interp, varTokenPtr+1,
 				      varTokenPtr->numComponents, envPtr);
 	    if ( result != TCL_OK ) {
@@ -2182,6 +2377,16 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr)
     int i, len, code, nocase, anchorLeft, anchorRight, start;
     char *str;
 
+#ifdef TCL_TIP280
+    /* TIP #280 : Remember the per-word line information of the current
+     * command. An index is used instead of a pointer as recursive compilation
+     * may reallocate, i.e. move, the array. This is also the reason to save
+     * the nuloc now, it may change during the course of the function.
+     */
+    ExtCmdLoc* mapPtr   = envPtr->extCmdMapPtr;
+    int        eclIndex = mapPtr->nuloc - 1;
+#endif
+
     /*
      * We are only interested in compiling simple regexp cases.
      * Currently supported compile cases are:
@@ -2329,6 +2534,9 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr)
 	TclEmitPush(TclRegisterNewLiteral(envPtr,
 		varTokenPtr[1].start, varTokenPtr[1].size), envPtr);
     } else {
+#ifdef TCL_TIP280
+        envPtr->line = mapPtr->loc [eclIndex].line [parsePtr->numWords-1];
+#endif
 	code = TclCompileTokens(interp, varTokenPtr+1,
 		varTokenPtr->numComponents, envPtr);
 	if (code != TCL_OK) {
@@ -2379,6 +2587,16 @@ TclCompileReturnCmd(interp, parsePtr, envPtr)
     int code;
     int index = envPtr->exceptArrayNext - 1;
 
+#ifdef TCL_TIP280
+    /* TIP #280 : Remember the per-word line information of the current
+     * command. An index is used instead of a pointer as recursive compilation
+     * may reallocate, i.e. move, the array. This is also the reason to save
+     * the nuloc now, it may change during the course of the function.
+     */
+    ExtCmdLoc* mapPtr   = envPtr->extCmdMapPtr;
+    int        eclIndex = mapPtr->nuloc - 1;
+#endif
+
     /*
      * If we're not in a procedure, don't compile.
      */
@@ -2436,6 +2654,9 @@ TclCompileReturnCmd(interp, parsePtr, envPtr)
 		 * "return" will be byte-compiled; otherwise it will be
 		 * out line compiled.
 		 */
+#ifdef TCL_TIP280
+	        envPtr->line = mapPtr->loc [eclIndex].line [1];
+#endif
 		code = TclCompileTokens(interp, varTokenPtr+1,
 			varTokenPtr->numComponents, envPtr);
 		if (code != TCL_OK) {
@@ -2496,6 +2717,16 @@ TclCompileSetCmd(interp, parsePtr, envPtr)
     int isAssignment, isScalar, simpleVarName, localIndex, numWords;
     int code = TCL_OK;
 
+#ifdef TCL_TIP280
+    /* TIP #280 : Remember the per-word line information of the current
+     * command. An index is used instead of a pointer as recursive compilation
+     * may reallocate, i.e. move, the array. This is also the reason to save
+     * the nuloc now, it may change during the course of the function.
+     */
+    ExtCmdLoc* mapPtr   = envPtr->extCmdMapPtr;
+    int        eclIndex = mapPtr->nuloc - 1;
+#endif
+
     numWords = parsePtr->numWords;
     if ((numWords != 2) && (numWords != 3)) {
 	Tcl_ResetResult(interp);
@@ -2517,7 +2748,12 @@ TclCompileSetCmd(interp, parsePtr, envPtr)
 	    + (parsePtr->tokenPtr->numComponents + 1);
 
     code = TclPushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
+#ifndef TCL_TIP280
 	    &localIndex, &simpleVarName, &isScalar);
+#else
+	    &localIndex, &simpleVarName, &isScalar,
+	    mapPtr->loc [eclIndex].line [1]);
+#endif
     if (code != TCL_OK) {
 	goto done;
     }
@@ -2532,6 +2768,9 @@ TclCompileSetCmd(interp, parsePtr, envPtr)
 	    TclEmitPush(TclRegisterNewLiteral(envPtr, valueTokenPtr[1].start,
 		    valueTokenPtr[1].size), envPtr);
 	} else {
+#ifdef TCL_TIP280
+	    envPtr->line = mapPtr->loc [eclIndex].line [2];
+#endif
 	    code = TclCompileTokens(interp, valueTokenPtr+1,
 	            valueTokenPtr->numComponents, envPtr);
 	    if (code != TCL_OK) {
@@ -2634,6 +2873,16 @@ TclCompileStringCmd(interp, parsePtr, envPtr)
 	STR_WORDEND,	STR_WORDSTART
     };	  
 
+#ifdef TCL_TIP280
+    /* TIP #280 : Remember the per-word line information of the current
+     * command. An index is used instead of a pointer as recursive compilation
+     * may reallocate, i.e. move, the array. This is also the reason to save
+     * the nuloc now, it may change during the course of the function.
+     */
+    ExtCmdLoc* mapPtr   = envPtr->extCmdMapPtr;
+    int        eclIndex = mapPtr->nuloc - 1;
+#endif
+
     if (parsePtr->numWords < 2) {
 	/* Fail at run time, not in compilation */
 	return TCL_OUT_LINE_COMPILE;
@@ -2695,6 +2944,9 @@ TclCompileStringCmd(interp, parsePtr, envPtr)
 		    TclEmitPush(TclRegisterNewLiteral(envPtr,
 			    varTokenPtr[1].start, varTokenPtr[1].size), envPtr);
 		} else {
+#ifdef TCL_TIP280
+		    envPtr->line = mapPtr->loc [eclIndex].line [i];
+#endif
 		    code = TclCompileTokens(interp, varTokenPtr+1,
 			    varTokenPtr->numComponents, envPtr);
 		    if (code != TCL_OK) {
@@ -2725,6 +2977,9 @@ TclCompileStringCmd(interp, parsePtr, envPtr)
 		    TclEmitPush(TclRegisterNewLiteral(envPtr,
 			    varTokenPtr[1].start, varTokenPtr[1].size), envPtr);
 		} else {
+#ifdef TCL_TIP280
+		    envPtr->line = mapPtr->loc [eclIndex].line [i];
+#endif
 		    code = TclCompileTokens(interp, varTokenPtr+1,
 			    varTokenPtr->numComponents, envPtr);
 		    if (code != TCL_OK) {
@@ -2755,6 +3010,9 @@ TclCompileStringCmd(interp, parsePtr, envPtr)
 		TclEmitPush(TclRegisterNewLiteral(envPtr, buf, len), envPtr);
 		return TCL_OK;
 	    } else {
+#ifdef TCL_TIP280
+	        envPtr->line = mapPtr->loc [eclIndex].line [2];
+#endif
 		code = TclCompileTokens(interp, varTokenPtr+1,
 			varTokenPtr->numComponents, envPtr);
 		if (code != TCL_OK) {
@@ -2812,6 +3070,9 @@ TclCompileStringCmd(interp, parsePtr, envPtr)
 		    TclEmitPush(
 			    TclRegisterNewLiteral(envPtr, str, length), envPtr);
 		} else {
+#ifdef TCL_TIP280
+		    envPtr->line = mapPtr->loc [eclIndex].line [i];
+#endif
 		    code = TclCompileTokens(interp, varTokenPtr+1,
 			    varTokenPtr->numComponents, envPtr);
 		    if (code != TCL_OK) {
@@ -2928,6 +3189,16 @@ TclCompileWhileCmd(interp, parsePtr, envPtr)
     Tcl_Obj *boolObj;
     int boolVal;
 
+#ifdef TCL_TIP280
+    /* TIP #280 : Remember the per-word line information of the current
+     * command. An index is used instead of a pointer as recursive compilation
+     * may reallocate, i.e. move, the array. This is also the reason to save
+     * the nuloc now, it may change during the course of the function.
+     */
+    ExtCmdLoc* mapPtr   = envPtr->extCmdMapPtr;
+    int        eclIndex = mapPtr->nuloc - 1;
+#endif
+
     if (parsePtr->numWords != 3) {
 	Tcl_ResetResult(interp);
 	Tcl_AppendToObj(Tcl_GetObjResult(interp),
@@ -3013,6 +3284,9 @@ TclCompileWhileCmd(interp, parsePtr, envPtr)
      * Compile the loop body.
      */
 
+#ifdef TCL_TIP280
+    envPtr->line = mapPtr->loc [eclIndex].line [2];
+#endif
     bodyCodeOffset = (envPtr->codeNext - envPtr->codeStart);
     code = TclCompileCmdWord(interp, bodyTokenPtr+1,
 	    bodyTokenPtr->numComponents, envPtr);
@@ -3042,6 +3316,9 @@ TclCompileWhileCmd(interp, parsePtr, envPtr)
 	    testCodeOffset += 3;
 	}
 	envPtr->currStackDepth = savedStackDepth;
+#ifdef TCL_TIP280
+	envPtr->line = mapPtr->loc [eclIndex].line [1];
+#endif
 	code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
 	if (code != TCL_OK) {
 	    if (code == TCL_ERROR) {
@@ -3114,7 +3391,11 @@ TclCompileWhileCmd(interp, parsePtr, envPtr)
 
 static int
 TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
+#ifndef TCL_TIP280
 	simpleVarNamePtr, isScalarPtr)
+#else
+	simpleVarNamePtr, isScalarPtr, line)
+#endif
     Tcl_Interp *interp;		/* Used for error reporting. */
     Tcl_Token *varTokenPtr;	/* Points to a variable token. */
     CompileEnv *envPtr;		/* Holds resulting instructions. */
@@ -3123,6 +3404,9 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
     int *localIndexPtr;		/* must not be NULL */
     int *simpleVarNamePtr;	/* must not be NULL */
     int *isScalarPtr;		/* must not be NULL */
+#ifdef TCL_TIP280
+    int line;                   /* line the token starts on */
+#endif
 {
     register CONST char *p;
     CONST char *name, *elName;
@@ -3304,6 +3588,9 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
 
 	if (elName != NULL) {
 	    if (elNameChars) {
+#ifdef TCL_TIP280
+	        envPtr->line = line;
+#endif
 		code = TclCompileTokens(interp, elemTokenPtr,
                         elemTokenCount, envPtr);
 		if (code != TCL_OK) {
@@ -3318,6 +3605,9 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
 	 * The var name isn't simple: compile and push it.
 	 */
 
+#ifdef TCL_TIP280
+        envPtr->line = line;
+#endif
 	code = TclCompileTokens(interp, varTokenPtr+1,
 		varTokenPtr->numComponents, envPtr);
 	if (code != TCL_OK) {
@@ -3337,3 +3627,12 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
     *isScalarPtr	= (elName == NULL);
     return code;
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
+
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index bedf35d..3ff749b 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -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: tclCompExpr.c,v 1.13.2.2 2005/11/27 02:34:41 das Exp $
+ * RCS: @(#) $Id: tclCompExpr.c,v 1.13.2.3 2006/11/28 22:20:00 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -258,6 +258,11 @@ TclCompileExpr(interp, script, numBytes, envPtr)
 	goto done;
     }
 
+#ifdef TCL_TIP280
+    /* TIP #280 : Track Lines within the expression */
+    TclAdvanceLines (&envPtr->line, script, parse.tokenPtr->start);
+#endif
+
     code = CompileSubExpr(parse.tokenPtr, &info, envPtr);
     if (code != TCL_OK) {
 	Tcl_FreeParse(&parse);
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 88f029c..4a6fac5 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.43.2.6 2004/06/08 19:45:26 msofer Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.43.2.7 2006/11/28 22:20:00 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -301,6 +301,16 @@ static void		RecordByteCodeStats _ANSI_ARGS_((
 static int		SetByteCodeFromAny _ANSI_ARGS_((Tcl_Interp *interp,
 			    Tcl_Obj *objPtr));
 
+#ifdef TCL_TIP280
+/* TIP #280 : Helper for building the per-word line information of all
+ * compiled commands */
+static void		EnterCmdWordData _ANSI_ARGS_((
+    			    ExtCmdLoc *eclPtr, int srcOffset, Tcl_Token* tokenPtr,
+			    CONST char* cmd, int len, int numWords, int line,
+			    int** lines));
+#endif
+
+
 /*
  * The structure below defines the bytecode Tcl object type by
  * means of procedures that can be invoked by generic object code.
@@ -374,7 +384,19 @@ TclSetByteCodeFromAny(interp, objPtr, hookProc, clientData)
 	nested = 0;
     }
     string = Tcl_GetStringFromObj(objPtr, &length);
+#ifndef TCL_TIP280
     TclInitCompileEnv(interp, &compEnv, string, length);
+#else
+    /*
+     * 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, string, length,
+		      iPtr->invokeCmdFramePtr, iPtr->invokeWord);
+#endif
     result = TclCompileScript(interp, string, length, nested, &compEnv);
 
     if (result == TCL_OK) {
@@ -566,6 +588,9 @@ TclCleanupByteCode(codePtr)
     register ByteCode *codePtr;	/* Points to the ByteCode to free. */
 {
     Tcl_Interp *interp = (Tcl_Interp *) *codePtr->interpHandle;
+#ifdef TCL_TIP280
+    Interp* iPtr = (Interp*) interp;
+#endif
     int numLitObjects = codePtr->numLitObjects;
     int numAuxDataItems = codePtr->numAuxDataItems;
     register Tcl_Obj **objArrayPtr;
@@ -663,6 +688,38 @@ TclCleanupByteCode(codePtr)
 	auxDataPtr++;
     }
 
+#ifdef TCL_TIP280
+    /*
+     * 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);
+	}
+    }
+#endif
+
     TclHandleRelease(codePtr->interpHandle);
     ckfree((char *) codePtr);
 }
@@ -685,13 +742,22 @@ TclCleanupByteCode(codePtr)
  */
 
 void
+#ifndef TCL_TIP280
 TclInitCompileEnv(interp, envPtr, string, numBytes)
+#else
+TclInitCompileEnv(interp, envPtr, string, numBytes, invoker, word)
+#endif
     Tcl_Interp *interp;		 /* The interpreter for which a CompileEnv
 				  * structure is initialized. */
     register CompileEnv *envPtr; /* Points to the CompileEnv structure to
 				  * initialize. */
     char *string;		 /* The source string to be compiled. */
     int numBytes;		 /* Number of bytes in source string. */
+#ifdef TCL_TIP280
+    CONST CmdFrame* invoker;     /* Location context invoking the bcc */
+    int word;                    /* Index of the word in that context
+				  * getting compiled */
+#endif
 {
     Interp *iPtr = (Interp *) interp;
     
@@ -724,7 +790,74 @@ TclInitCompileEnv(interp, envPtr, string, numBytes)
     envPtr->cmdMapPtr = envPtr->staticCmdMapSpace;
     envPtr->cmdMapEnd = COMPILEENV_INIT_CMD_MAP_SIZE;
     envPtr->mallocedCmdMap = 0;
-    
+
+#ifdef TCL_TIP280
+    /*
+     * 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);
+		}
+	    }
+	}
+    }
+#endif
+
     envPtr->auxDataArrayPtr = envPtr->staticAuxDataArraySpace;
     envPtr->auxDataArrayNext = 0;
     envPtr->auxDataArrayEnd = COMPILEENV_INIT_AUX_DATA_SIZE;
@@ -774,6 +907,54 @@ TclFreeCompileEnv(envPtr)
     }
 }
 
+#ifdef TCL_TIP280
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclWordKnownAtCompileTime --
+ *
+ *	Test whether the value of a token is completely known at compile time.
+ *
+ * Results:
+ *	Returns true if the tokenPtr argument points to a word value that is
+ *	completely known at compile time. Generally, values that are known at
+ *	compile time can be compiled to their values, while values that cannot
+ *	be known until substitution at runtime must be compiled to bytecode
+ *	instructions that perform that substitution. For several commands,
+ *	whether or not arguments are known at compile time determine whether
+ *	it is worthwhile to compile at all.
+ *
+ * Side effects:
+ *	None.
+ *
+ * TIP #280
+ *----------------------------------------------------------------------
+ */
+
+int
+TclWordKnownAtCompileTime (tokenPtr)
+     Tcl_Token* tokenPtr;
+{
+    int        i;
+    Tcl_Token* sub;
+
+    if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {return 1;};
+    if (tokenPtr->type != TCL_TOKEN_WORD)        {return 0;};
+
+    /* Check the sub tokens of the word. It is a literal if we find
+     * only BS and TEXT tokens */
+
+    for (i=0, sub = tokenPtr + 1;
+	 i < tokenPtr->numComponents;
+	 i++, sub ++) {
+      if (sub->type == TCL_TOKEN_TEXT) continue;
+      if (sub->type == TCL_TOKEN_BS)   continue;
+      return 0;
+    }
+    return 1;
+}
+#endif
+
 /*
  *----------------------------------------------------------------------
  *
@@ -828,6 +1009,13 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
     int commandLength, objIndex, code;
     Tcl_DString ds;
 
+#ifdef TCL_TIP280
+    /* TIP #280 */
+    ExtCmdLoc* eclPtr = envPtr->extCmdMapPtr;
+    int* wlines;
+    int  wlineat, cmdLine;
+#endif
+
     Tcl_DStringInit(&ds);
 
     if (numBytes < 0) {
@@ -844,6 +1032,10 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
     p = script;
     bytesLeft = numBytes;
     gotParse = 0;
+#ifdef TCL_TIP280
+    cmdLine = envPtr->line;
+#endif
+
     do {
 	if (Tcl_ParseCommand(interp, p, bytesLeft, nested, &parse) != TCL_OK) {
 	    code = TCL_ERROR;
@@ -952,10 +1144,28 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
 	    startCodeOffset = (envPtr->codeNext - envPtr->codeStart);
 	    EnterCmdStartData(envPtr, currCmdIndex,
 	            (parse.commandStart - envPtr->source), startCodeOffset);
-	    
+
+#ifdef TCL_TIP280
+	    /* 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;
+#endif
+
 	    for (wordIdx = 0, tokenPtr = parse.tokenPtr;
 		    wordIdx < parse.numWords;
 		    wordIdx++, tokenPtr += (tokenPtr->numComponents + 1)) {
+#ifdef TCL_TIP280
+	        envPtr->line = eclPtr->loc [wlineat].line [wordIdx];
+#endif
 		if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
 		    /*
 		     * If this is the first word and the command has a
@@ -1039,7 +1249,6 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
 		    /*
 		     * The word is not a simple string of characters.
 		     */
-		    
 		    code = TclCompileTokens(interp, tokenPtr+1,
 			    tokenPtr->numComponents, envPtr);
 		    if (code != TCL_OK) {
@@ -1070,15 +1279,27 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
 	    EnterCmdExtentData(envPtr, currCmdIndex, commandLength,
 		    (envPtr->codeNext-envPtr->codeStart) - startCodeOffset);
 	    isFirstCmd = 0;
+
+#ifdef TCL_TIP280
+	    /* 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;
+#endif
 	} /* end if parse.numWords > 0 */
 
 	/*
 	 * Advance to the next command in the script.
 	 */
-	
+
 	next = parse.commandStart + parse.commandSize;
 	bytesLeft -= (next - p);
 	p = next;
+#ifdef TCL_TIP280
+	/* TIP #280 : Track lines in the just compiled command */
+	TclAdvanceLines (&cmdLine, parse.commandStart, p);
+#endif
 	Tcl_FreeParse(&parse);
 	gotParse = 0;
 	if (nested && (*parse.term == ']')) {
@@ -1551,6 +1772,9 @@ TclInitByteCodeObj(objPtr, envPtr)
     int numLitObjects = envPtr->literalArrayNext;
     Namespace *namespacePtr;
     int i;
+#ifdef TCL_TIP280
+    int new;
+#endif
     Interp *iPtr;
 
     iPtr = envPtr->iPtr;
@@ -1662,6 +1886,16 @@ TclInitByteCodeObj(objPtr, envPtr)
     }
     objPtr->internalRep.otherValuePtr = (VOID *) codePtr;
     objPtr->typePtr = &tclByteCodeType;
+
+#ifdef TCL_TIP280
+    /* 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;
+#endif
 }
 
 /*
@@ -2135,6 +2369,98 @@ EnterCmdExtentData(envPtr, cmdIndex, numSrcBytes, numCodeBytes)
     cmdLocPtr->numCodeBytes = numCodeBytes;
 }
 
+#ifdef TCL_TIP280
+/*
+ *----------------------------------------------------------------------
+ * 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)
+				? wordLine
+				: -1);
+	ePtr->line [wordIdx] = wordLine;
+	last = tokenPtr->start;
+    }
+
+    *wlines = wwlines;
+    eclPtr->nuloc ++;
+}
+#endif
+
 /*
  *----------------------------------------------------------------------
  *
@@ -3483,3 +3809,12 @@ RecordByteCodeStats(codePtr)
     statsPtr->currentCmdMapBytes += (double) codePtr->numCmdLocBytes;
 }
 #endif /* TCL_COMPILE_STATS */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
+
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index de6bf24..1769a76 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -8,7 +8,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.33 2002/10/09 11:54:05 das Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.33.2.1 2006/11/28 22:20:00 andreas_kupries Exp $
  */
 
 #ifndef _TCLCOMPILATION
@@ -121,6 +121,33 @@ typedef struct CmdLocation {
     int numSrcBytes;		/* Number of command source chars. */
 } CmdLocation;
 
+#ifdef TCL_TIP280
+/*
+ * TIP #280
+ * Structure to record additional location information for byte code.
+ * This information is internal and not saved. I.e. tbcload'ed code
+ * will not have this information. It records the lines for all words
+ * of all commands found in the byte code. The association with a
+ * ByteCode structure BC is done through the 'lineBCPtr' HashTable in
+ * Interp, keyed by the address of BC. Also recorded is information
+ * coming from the context, i.e. type of the frame and associated
+ * information, like the path of a sourced file.
+ */
+
+typedef struct ECL {
+  int  srcOffset; /* cmd location to find the entry */
+  int  nline;
+  int* line;      /* line information for all words in the command */
+} ECL;
+typedef struct ExtCmdLoc {
+  int      type;  /* Context type */
+  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' */
+} ExtCmdLoc;
+#endif
+
 /*
  * CompileProcs need the ability to record information during compilation
  * that can be used by bytecode instructions during execution. The AuxData
@@ -264,6 +291,14 @@ typedef struct CompileEnv {
                                 /* Initial storage for cmd location map. */
     AuxData staticAuxDataArraySpace[COMPILEENV_INIT_AUX_DATA_SIZE];
                                 /* Initial storage for aux data array. */
+#ifdef TCL_TIP280
+    /* TIP #280 */
+    ExtCmdLoc* extCmdMapPtr;    /* Extended command location information
+				 * for 'info frame'. */
+    int        line;            /* First line of the script, based on the
+				 * invoking context, then the line of the
+				 * command currently compiled. */
+#endif
 } CompileEnv;
 
 /*
@@ -727,8 +762,14 @@ EXTERN int              TclInterpReady _ANSI_ARGS_((Tcl_Interp *interp));
  *----------------------------------------------------------------
  */
 
+#ifndef TCL_TIP280
 EXTERN int		TclCompEvalObj _ANSI_ARGS_((Tcl_Interp *interp,
 			    Tcl_Obj *objPtr));
+#else
+EXTERN int		TclCompEvalObj _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr, CONST CmdFrame* invoker,
+			    int word));
+#endif
 
 /*
  *----------------------------------------------------------------
@@ -784,9 +825,15 @@ EXTERN void		TclInitAuxDataTypeTable _ANSI_ARGS_((void));
 EXTERN void		TclInitByteCodeObj _ANSI_ARGS_((Tcl_Obj *objPtr,
 			    CompileEnv *envPtr));
 EXTERN void		TclInitCompilation _ANSI_ARGS_((void));
+#ifndef TCL_TIP280
 EXTERN void		TclInitCompileEnv _ANSI_ARGS_((Tcl_Interp *interp,
 			    CompileEnv *envPtr, char *string,
 			    int numBytes));
+#else
+EXTERN void		TclInitCompileEnv _ANSI_ARGS_((Tcl_Interp *interp,
+			    CompileEnv *envPtr, char *string,
+			    int numBytes, CONST CmdFrame* invoker, int word));
+#endif
 EXTERN void		TclInitJumpFixupArray _ANSI_ARGS_((
 			    JumpFixupArray *fixupArrayPtr));
 EXTERN void		TclInitLiteralTable _ANSI_ARGS_((
@@ -1039,8 +1086,3 @@ EXTERN int		TclCompileVariableCmd _ANSI_ARGS_((
 # define TCL_STORAGE_CLASS DLLIMPORT
 
 #endif /* _TCLCOMPILATION */
-
-
-
-
-
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 4717ae2..59412b8 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.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: tclExecute.c,v 1.94.2.19 2006/05/04 12:34:38 dgp Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.94.2.20 2006/11/28 22:20:00 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -747,7 +747,12 @@ Tcl_ExprObj(interp, objPtr, resultPtrPtr)
 	}
     }
     if (objPtr->typePtr != &tclByteCodeType) {
+#ifndef TCL_TIP280
 	TclInitCompileEnv(interp, &compEnv, string, length);
+#else
+	/* TIP #280 : No invoker (yet) - Expression compilation */
+	TclInitCompileEnv(interp, &compEnv, string, length, NULL, 0);
+#endif
 	result = TclCompileExpr(interp, string, length, &compEnv);
 
 	/*
@@ -877,9 +882,17 @@ Tcl_ExprObj(interp, objPtr, resultPtrPtr)
  */
 
 int
+#ifndef TCL_TIP280
 TclCompEvalObj(interp, objPtr)
+#else
+TclCompEvalObj(interp, objPtr, invoker, word)
+#endif
     Tcl_Interp *interp;
     Tcl_Obj *objPtr;
+#ifdef TCL_TIP280
+    CONST CmdFrame* invoker; /* Frame of the command doing the eval  */
+    int             word;    /* Index of the word which is in objPtr */
+#endif
 {
     register Interp *iPtr = (Interp *) interp;
     register ByteCode* codePtr;		/* Tcl Internal type of bytecode. */
@@ -917,7 +930,22 @@ TclCompEvalObj(interp, objPtr)
     if (objPtr->typePtr != &tclByteCodeType) {
         recompileObj:
 	iPtr->errorLine = 1; 
+
+#ifdef TCL_TIP280
+	/* TIP #280. Remember the invoker for a moment in the interpreter
+	 * structures so that the byte code compiler can pick it up when
+	 * initializing the compilation environment, i.e. the extended
+	 * location information.
+	 */
+
+	iPtr->invokeCmdFramePtr = invoker;
+	iPtr->invokeWord        = word;
+#endif
 	result = tclByteCodeType.setFromAnyProc(interp, objPtr);
+#ifdef TCL_TIP280
+	iPtr->invokeCmdFramePtr = NULL;
+#endif
+
 	if (result != TCL_OK) {
 	    iPtr->numLevels--;
 	    return result;
@@ -1077,6 +1105,12 @@ TclExecuteByteCode(interp, codePtr)
     char *part1, *part2;
     Var *varPtr, *arrayPtr;
     CallFrame *varFramePtr = iPtr->varFramePtr;
+
+#ifdef TCL_TIP280
+    /* TIP #280 : Structures for tracking lines */
+    CmdFrame bcFrame;
+#endif
+
 #ifdef TCL_COMPILE_DEBUG
     int traceInstructions = (tclTraceExec == 3);
     char cmdNameBuf[21];
@@ -1094,6 +1128,26 @@ TclExecuteByteCode(interp, codePtr)
     int *catchStackPtr = catchStackStorage;
     int catchTop = -1;
 
+#ifdef TCL_TIP280
+    /* TIP #280 : Initialize the frame. Do not push it yet. */
+
+    bcFrame.type      = ((codePtr->flags & TCL_BYTECODE_PRECOMPILED)
+			 ? TCL_LOCATION_PREBC
+			 : TCL_LOCATION_BC);
+    bcFrame.level     = (iPtr->cmdFramePtr == NULL ?
+			 1 :
+			 iPtr->cmdFramePtr->level + 1);
+    bcFrame.framePtr  = iPtr->framePtr;
+    bcFrame.nextPtr   = iPtr->cmdFramePtr;
+    bcFrame.nline     = 0;
+    bcFrame.line      = NULL;
+
+    bcFrame.data.tebc.codePtr  = codePtr;
+    bcFrame.data.tebc.pc       = NULL;
+    bcFrame.cmd.str.cmd        = NULL;
+    bcFrame.cmd.str.len        = 0;
+#endif
+
 #ifdef TCL_COMPILE_DEBUG
     if (tclTraceExec >= 2) {
 	PrintByteCodeInfo(codePtr);
@@ -1411,13 +1465,23 @@ TclExecuteByteCode(interp, codePtr)
 	    ++*preservedStackRefCountPtr;
 
 	    /*
-	     * Finally, let TclEvalObjvInternal handle the command. 
+	     * Finally, let TclEvalObjvInternal handle the command.
+	     *
+	     * TIP #280 : Record the last piece of info needed by
+	     * 'TclGetSrcInfoForPc', and push the frame.
 	     */
 
+#ifdef TCL_TIP280
+	    bcFrame.data.tebc.pc = pc;
+	    iPtr->cmdFramePtr = &bcFrame;
+#endif
 	    DECACHE_STACK_INFO();
 	    Tcl_ResetResult(interp);
 	    result = TclEvalObjvInternal(interp, objc, objv, bytes, length, 0);
 	    CACHE_STACK_INFO();
+#ifdef TCL_TIP280
+	    iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
+#endif
 
 	    /*
 	     * If the old stack is going to be released, it is
@@ -1475,7 +1539,16 @@ TclExecuteByteCode(interp, codePtr)
 
 	objPtr = stackPtr[stackTop];
 	DECACHE_STACK_INFO();
+#ifndef TCL_TIP280
 	result = TclCompEvalObj(interp, objPtr);
+#else
+	/* TIP #280: The invoking context is left NULL for a dynamically
+	 * constructed command. We cannot match its lines to the outer
+	 * context.
+	 */
+
+	result = TclCompEvalObj(interp, objPtr, NULL,0);
+#endif
 	CACHE_STACK_INFO();
 	if (result == TCL_OK) {
 	    /*
@@ -4609,7 +4682,7 @@ IllegalExprOperandType(interp, pc, opndPtr)
 /*
  *----------------------------------------------------------------------
  *
- * GetSrcInfoForPc --
+ * TclGetSrcInfoForPc, GetSrcInfoForPc --
  *
  *	Given a program counter value, finds the closest command in the
  *	bytecode code unit's CmdLocation array and returns information about
@@ -4630,6 +4703,63 @@ IllegalExprOperandType(interp, pc, opndPtr)
  *----------------------------------------------------------------------
  */
 
+#ifdef TCL_TIP280
+void
+TclGetSrcInfoForPc (cfPtr)
+     CmdFrame* cfPtr;
+{
+    ByteCode* codePtr = (ByteCode*) cfPtr->data.tebc.codePtr;
+
+    if (cfPtr->cmd.str.cmd == NULL) {
+        cfPtr->cmd.str.cmd = GetSrcInfoForPc((char*) cfPtr->data.tebc.pc,
+					     codePtr,
+					     &cfPtr->cmd.str.len);
+    }
+
+    if (cfPtr->cmd.str.cmd != NULL) {
+        /* We now have the command. We can get the srcOffset back and
+	 * from there find the list of word locations for this command
+	 */
+
+	ExtCmdLoc*     eclPtr;
+	ECL*           locPtr = NULL;
+	int            srcOffset;
+
+        Interp*        iPtr  = (Interp*) *codePtr->interpHandle;
+	Tcl_HashEntry* hePtr = Tcl_FindHashEntry (iPtr->lineBCPtr, (char *) codePtr);
+
+	if (!hePtr) return;
+
+	srcOffset = cfPtr->cmd.str.cmd - codePtr->source;
+	eclPtr    = (ExtCmdLoc*) Tcl_GetHashValue (hePtr);
+
+	{
+	    int i;
+	    for (i=0; i < eclPtr->nuloc; i++) {
+		if (eclPtr->loc [i].srcOffset == srcOffset) {
+		    locPtr = &(eclPtr->loc [i]);
+		    break;
+		}
+	    }
+	}
+
+	if (locPtr == NULL) {Tcl_Panic ("LocSearch failure");}
+
+	cfPtr->line           = locPtr->line;
+	cfPtr->nline          = locPtr->nline;
+	cfPtr->type           = eclPtr->type;
+
+	if (eclPtr->type == TCL_LOCATION_SOURCE) {
+	    cfPtr->data.eval.path = eclPtr->path;
+	    Tcl_IncrRefCount (cfPtr->data.eval.path);
+	}
+	/* Do not set cfPtr->data.eval.path NULL for non-SOURCE
+	 * Needed for cfPtr->data.tebc.codePtr.
+	 */
+    }
+}
+#endif
+
 static char *
 GetSrcInfoForPc(pc, codePtr, lengthPtr)
     unsigned char *pc;		/* The program counter value for which to
@@ -6314,3 +6444,12 @@ StringForResultCode(result)
     return buf;
 }
 #endif /* TCL_COMPILE_DEBUG */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
+
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 61cd561..bda1cab 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -17,7 +17,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclIOUtil.c,v 1.77.2.32 2006/10/17 04:36:44 dgp Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.77.2.33 2006/11/28 22:20:01 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -1762,6 +1762,12 @@ Tcl_FSEvalFile(interp, pathPtr)
     iPtr->scriptFile = pathPtr;
     Tcl_IncrRefCount(iPtr->scriptFile);
     string = Tcl_GetStringFromObj(objPtr, &length);
+
+#ifdef TCL_TIP280
+    /* TIP #280 Force the evaluator to open a frame for a sourced
+     * file. */
+    iPtr->evalFlags |= TCL_EVAL_FILE;
+#endif
     result = Tcl_EvalEx(interp, string, length, 0);
     /* 
      * Now we have to be careful; the script may have changed the
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 27681f8..57e9e31 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -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: tclInt.h,v 1.118.2.25 2006/10/17 04:36:44 dgp Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.118.2.26 2006/11/28 22:20:01 andreas_kupries Exp $
  */
 
 #ifndef _TCLINT
@@ -804,6 +804,113 @@ typedef struct CallFrame {
 				 * using an index into this array. */
 } CallFrame;
 
+#ifdef TCL_TIP280
+/*
+ * TIP #280
+ * The structure below defines a command frame. A command frame
+ * provides location information for all commands executing a tcl
+ * script (source, eval, uplevel, procedure bodies, ...). The runtime
+ * structure essentially contains the stack trace as it would be if
+ * the currently executing command were to throw an error.
+ *
+ * For commands where it makes sense it refers to the associated
+ * CallFrame as well.
+ *
+ * The structures are chained in a single list, with the top of the
+ * stack anchored in the Interp structure.
+ *
+ * Instances can be allocated on the C stack, or the heap, the former
+ * making cleanup a bit simpler.
+ */
+
+typedef struct CmdFrame {
+  /* General data. Always available. */
+
+  int              type;     /* Values see below */
+  int              level;    /* #Frames in stack, prevent O(n) scan of list */
+  int*             line;     /* Lines the words of the command start on */
+  int              nline;
+
+  CallFrame*       framePtr; /* Procedure activation record, may be NULL */
+  struct CmdFrame* nextPtr;  /* Link to calling frame */
+
+  /* Data needed for Eval vs TEBC
+   *
+   * EXECUTION CONTEXTS and usage of CmdFrame
+   *
+   * Field      TEBC            EvalEx          EvalObjEx
+   * =======    ====            ======          =========
+   * level      yes             yes             yes
+   * type       BC/PREBC        SRC/EVAL        EVAL_LIST
+   * line0      yes             yes             yes
+   * framePtr   yes             yes             yes
+   * =======    ====            ======          =========
+   *
+   * =======    ====            ======          ========= union data
+   * line1      -               yes             -
+   * line3      -               yes             -
+   * path       -               yes             -
+   * -------    ----            ------          ---------
+   * codePtr    yes             -               -
+   * pc         yes             -               -
+   * =======    ====            ======          =========
+   *
+   * =======    ====            ======          ========= | union cmd
+   * listPtr    -               -               yes       |
+   * -------    ----            ------          --------- |
+   * cmd        yes             yes             -         |
+   * cmdlen     yes             yes             -         |
+   * -------    ----            ------          --------- |
+   */
+
+  union {
+    struct {
+      Tcl_Obj*     path;     /* Path of the sourced file the command
+			      * is in. */
+    } eval;
+    struct {
+      CONST void*  codePtr;  /* Byte code currently executed */
+      CONST char*  pc;       /* and instruction pointer.     */
+    } tebc;
+  } data;
+
+  union {
+    struct {
+      CONST char*  cmd;      /* The executed command, if possible */
+      int          len;      /* And its length */
+    } str;
+    Tcl_Obj*       listPtr;  /* Tcl_EvalObjEx, cmd list */
+  } cmd;
+
+} CmdFrame;
+
+/* 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 location data referenced via the 'baseLocPtr'.
+ *
+ * TCL_LOCATION_EVAL      : Frame is for a script evaluated by EvalEx.
+ * TCL_LOCATION_EVAL_LIST : Frame is for a script evaluated by the list
+ *                          optimization path of EvalObjEx.
+ * TCL_LOCATION_BC        : Frame is for bytecode. 
+ * TCL_LOCATION_PREBC     : Frame is for precompiled bytecode.
+ * TCL_LOCATION_SOURCE    : Frame is for a script evaluated by EvalEx,
+ *                          from a sourced file.
+ * TCL_LOCATION_PROC      : Frame is for bytecode of a procedure.
+ *
+ * A TCL_LOCATION_BC type in a frame can be overridden by _SOURCE and
+ * _PROC types, per the context of the byte code in execution.
+ */
+
+#define TCL_LOCATION_EVAL      (0) /* Location in a dynamic eval script */
+#define TCL_LOCATION_EVAL_LIST (1) /* Location in a dynamic eval script, list-path */
+#define TCL_LOCATION_BC        (2) /* Location in byte code */
+#define TCL_LOCATION_PREBC     (3) /* Location in precompiled byte code, no location */
+#define TCL_LOCATION_SOURCE    (4) /* Location in a file */
+#define TCL_LOCATION_PROC      (5) /* Location in a dynamic proc */
+
+#define TCL_LOCATION_LAST      (6) /* Number of values in the enum */
+#endif
+
 /*
  *----------------------------------------------------------------
  * Data structures and procedures related to TclHandles, which
@@ -1363,6 +1470,32 @@ typedef struct Interp {
     int tracesForbiddingInline; /* Count of traces (in the list headed by
 				 * tracePtr) that forbid inline bytecode
 				 * compilation */
+#ifdef TCL_TIP280
+    /* TIP #280 */
+    CmdFrame* cmdFramePtr;      /* Points to the command frame containing
+				 * the location information for the current
+				 * command. */
+    CONST CmdFrame* invokeCmdFramePtr; /* Points to the command frame which is the
+				  * invoking context of the bytecode compiler.
+				  * NULL when the byte code compiler is not
+				  * active */
+    int invokeWord;             /* Index of the word in the command which
+				 * is getting compiled. */
+    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.
+				 */
+    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.
+				 */
+#endif
 #ifdef TCL_TIP268
     /*
      * TIP #268.
@@ -1395,6 +1528,10 @@ typedef struct Interp {
 
 #define TCL_BRACKET_TERM	  1
 #define TCL_ALLOW_EXCEPTIONS	  4
+#ifdef TCL_TIP280
+#define TCL_EVAL_FILE             2
+#define TCL_EVAL_CTX              8
+#endif
 
 /*
  * Flag bits for Interp structures:
@@ -1671,11 +1808,24 @@ extern char		tclEmptyString;
  *----------------------------------------------------------------
  */
 
+#ifdef TCL_TIP280
+EXTERN void             TclAdvanceLines _ANSI_ARGS_((int* line, CONST char* start,
+						     CONST char* end));
+#endif
 EXTERN int		TclArraySet _ANSI_ARGS_((Tcl_Interp *interp,
 			    Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj));
 EXTERN int		TclCheckBadOctal _ANSI_ARGS_((Tcl_Interp *interp,
 			    CONST char *value));
 EXTERN void		TclDeleteNamespaceVars _ANSI_ARGS_((Namespace *nsPtr));
+
+#ifdef TCL_TIP280
+EXTERN int              TclEvalObjEx _ANSI_ARGS_((Tcl_Interp *interp,
+						  register Tcl_Obj *objPtr,
+						  int flags,
+						  CONST CmdFrame* invoker,
+						  int word));
+#endif
+
 EXTERN void		TclExpandTokenArray _ANSI_ARGS_((
 			    Tcl_Parse *parsePtr));
 EXTERN int		TclFileAttrsCmd _ANSI_ARGS_((Tcl_Interp *interp,
@@ -1707,6 +1857,9 @@ EXTERN void		TclFinalizeSynchronization _ANSI_ARGS_((void));
 EXTERN void		TclFinalizeThreadData _ANSI_ARGS_((void));
 EXTERN int		TclGetEncodingFromObj _ANSI_ARGS_((Tcl_Interp *interp,
 			    Tcl_Obj *objPtr, Tcl_Encoding *encodingPtr));
+#ifdef TCL_TIP280
+EXTERN void             TclGetSrcInfoForPc _ANSI_ARGS_((CmdFrame* cfPtr));
+#endif
 EXTERN int		TclGlob _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *pattern, Tcl_Obj *unquotedPrefix, 
 			    int globFlags, Tcl_GlobTypeData* types));
@@ -1749,6 +1902,9 @@ EXTERN int		TclParseInteger _ANSI_ARGS_((CONST char *string,
 			    int numBytes));
 EXTERN int		TclParseWhiteSpace _ANSI_ARGS_((CONST char *src,
 			    int numBytes, Tcl_Parse *parsePtr, char *typePtr));
+#ifdef TCL_TIP280
+EXTERN int              TclWordKnownAtCompileTime _ANSI_ARGS_((Tcl_Token* token));
+#endif
 EXTERN int		TclpObjAccess _ANSI_ARGS_((Tcl_Obj *filename,
 			    int mode));
 EXTERN int              TclpObjLstat _ANSI_ARGS_((Tcl_Obj *pathPtr, 
@@ -2160,7 +2316,12 @@ EXTERN Tcl_Obj *TclPtrIncrVar _ANSI_ARGS_((Tcl_Interp *interp, Var *varPtr,
     (objPtr)->length   = 0; \
     (objPtr)->typePtr  = NULL
 
-#define TclDecrRefCount(objPtr) \
+
+#ifdef TCL_MEM_DEBUG
+#   define TclDecrRefCount(objPtr) \
+	Tcl_DbDecrRefCount(objPtr, __FILE__, __LINE__)
+#else
+#   define TclDecrRefCount(objPtr) \
     if (--(objPtr)->refCount <= 0) { \
 	if (((objPtr)->typePtr != NULL) \
 		&& ((objPtr)->typePtr->freeIntRepProc != NULL)) { \
@@ -2173,6 +2334,7 @@ EXTERN Tcl_Obj *TclPtrIncrVar _ANSI_ARGS_((Tcl_Interp *interp, Var *varPtr,
         TclFreeObjStorage(objPtr); \
 	TclIncrObjsFreed(); \
     }
+#endif
 
 #ifdef TCL_MEM_DEBUG
 #  define TclAllocObjStorage(objPtr) \
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 851123d..7fae90a 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -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: tclInterp.c,v 1.20.2.2 2003/05/12 22:35:40 dgp Exp $
+ * RCS: @(#) $Id: tclInterp.c,v 1.20.2.3 2006/11/28 22:20:02 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -2091,7 +2091,13 @@ SlaveEval(interp, slaveInterp, objc, objv)
     Tcl_AllowExceptions(slaveInterp);
 
     if (objc == 1) {
+#ifndef TCL_TIP280
 	result = Tcl_EvalObjEx(slaveInterp, objv[0], 0);
+#else
+        /* TIP #280 : Make invoker available to eval'd script */
+        Interp* iPtr = (Interp*) interp;
+	result = TclEvalObjEx(slaveInterp, objv[0], 0, iPtr->cmdFramePtr,0);
+#endif
     } else {
 	objPtr = Tcl_ConcatObj(objc, objv);
 	Tcl_IncrRefCount(objPtr);
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 9955e02..4f72e4c 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -19,7 +19,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.31.2.12 2006/05/31 23:29:31 hobbs Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.31.2.13 2006/11/28 22:20:02 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -2997,7 +2997,13 @@ NamespaceEvalCmd(dummy, interp, objc, objv)
     frame.objv = objv;  /* ref counts do not need to be incremented here */
 
     if (objc == 4) {
+#ifndef TCL_TIP280
         result = Tcl_EvalObjEx(interp, objv[3], 0);
+#else
+        /* TIP #280 : Make invoker available to eval'd script */
+        Interp* iPtr = (Interp*) interp;
+        result = TclEvalObjEx(interp, objv[3], 0, iPtr->cmdFramePtr,3);
+#endif
     } else {
 	/*
 	 * More than one argument: concatenate them together with spaces
@@ -3005,7 +3011,12 @@ NamespaceEvalCmd(dummy, interp, objc, objv)
 	 * the object when it decrements its refcount after eval'ing it.
 	 */
         objPtr = Tcl_ConcatObj(objc-3, objv+3);
+#ifndef TCL_TIP280
         result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT);
+#else
+	/* TIP #280. Make invoking context available to eval'd script */
+	result = TclEvalObjEx(interp, objPtr, TCL_EVAL_DIRECT, NULL, 0);
+#endif
     }
     if (result == TCL_ERROR) {
         char msg[256 + TCL_INTEGER_SPACE];
diff --git a/generic/tclProc.c b/generic/tclProc.c
index aae5008..3ecf243 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.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: tclProc.c,v 1.44.2.5 2006/05/15 16:07:04 dgp Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.44.2.6 2006/11/28 22:20:02 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -152,6 +152,65 @@ Tcl_ProcObjCmd(dummy, interp, objc, objv)
     
     procPtr->cmdPtr = (Command *) cmd;
 
+#ifdef TCL_TIP280
+    /* TIP #280 Remember the line the procedure body is starting on. In a
+     * Byte code context we ask the engine to provide us with the necessary
+     * information. This is for the initialization of the byte code compiler
+     * when the body is used for the first time.
+     */
+
+    if (iPtr->cmdFramePtr) {
+        CmdFrame context = *iPtr->cmdFramePtr;
+
+	if (context.type == TCL_LOCATION_BC) {
+	    TclGetSrcInfoForPc (&context);
+	    /* May get path in context */
+	} else if (context.type == TCL_LOCATION_SOURCE) {
+	    /* context now holds another reference */
+	    Tcl_IncrRefCount (context.data.eval.path);
+	}
+
+	/* type == TCL_LOCATION_PREBC implies that 'line' is NULL here!  We
+	 * cannot assume that 'line' is valid here, we have to check. If the
+	 * outer context is an eval (bc, prebc, eval) we do not save any
+	 * information. Counting relative to the beginning of the proc body is
+	 * more sensible than counting relative to the outer eval block.
+	 */
+
+	if ((context.type == TCL_LOCATION_SOURCE) &&
+	    context.line &&
+	    (context.nline >= 4) &&
+	    (context.line [3] >= 0)) {
+	    int       new;
+	    CmdFrame* cfPtr = (CmdFrame*) ckalloc (sizeof (CmdFrame));
+
+	    cfPtr->level    = -1;
+	    cfPtr->type     = context.type;
+	    cfPtr->line     = (int*) ckalloc (sizeof (int));
+	    cfPtr->line [0] = context.line [3];
+	    cfPtr->nline    = 1;
+	    cfPtr->framePtr = NULL;
+	    cfPtr->nextPtr  = NULL;
+
+	    if (context.type == TCL_LOCATION_SOURCE) {
+	        cfPtr->data.eval.path = context.data.eval.path;
+		/* Transfer of reference. The reference going away (release of
+		 * the context) is replaced by the reference in the
+		 * constructed cmdframe */
+	    } else {
+	        cfPtr->type = TCL_LOCATION_EVAL;
+		cfPtr->data.eval.path = NULL;
+	    }
+
+	    cfPtr->cmd.str.cmd = NULL;
+	    cfPtr->cmd.str.len = 0;
+
+	    Tcl_SetHashValue (Tcl_CreateHashEntry (iPtr->linePBodyPtr,
+						   (char*) procPtr, &new),
+			      cfPtr);
+	}
+    }
+#endif
 
     /*
      * Optimize for noop procs: if the body is not precompiled (like a TclPro
@@ -1101,7 +1160,15 @@ TclObjInterpProc(clientData, interp, objc, objv)
 
     iPtr->returnCode = TCL_OK;
     procPtr->refCount++;
+#ifndef TCL_TIP280
     result = TclCompEvalObj(interp, procPtr->bodyPtr);
+#else
+    /* TIP #280: No need to set the invoking context here. The body has
+     * already been compiled, so the part of CompEvalObj using it is bypassed.
+     */
+
+    result = TclCompEvalObj(interp, procPtr->bodyPtr, NULL, 0);
+#endif
     procPtr->refCount--;
     if (procPtr->refCount <= 0) {
 	TclProcCleanupProc(procPtr);
@@ -1313,7 +1380,24 @@ ProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description,
 		(Tcl_Namespace*)nsPtr, /* isProcCallFrame */ 0);
  
  	if (result == TCL_OK) {
+#ifdef TCL_TIP280
+	    /* TIP #280. We get the invoking context from the cmdFrame
+	     * which was saved by 'Tcl_ProcObjCmd' (using linePBodyPtr).
+	     */
+
+	    Tcl_HashEntry* hePtr = Tcl_FindHashEntry (iPtr->linePBodyPtr, (char *) procPtr);
+
+	    /* Constructed saved frame has body as word 0. See Tcl_ProcObjCmd.
+	     */
+	    iPtr->invokeWord        = 0;
+	    iPtr->invokeCmdFramePtr = (hePtr
+				       ? (CmdFrame*) Tcl_GetHashValue (hePtr)
+				       : NULL);
+#endif
 	    result = tclByteCodeType.setFromAnyProc(interp, bodyPtr);
+#ifdef TCL_TIP280
+	    iPtr->invokeCmdFramePtr = NULL;
+#endif
 	    Tcl_PopCallFrame(interp);
 	}
  
@@ -1492,6 +1576,11 @@ TclProcCleanupProc(procPtr)
     Tcl_Obj *bodyPtr = procPtr->bodyPtr;
     Tcl_Obj *defPtr;
     Tcl_ResolvedVarInfo *resVarInfo;
+#ifdef TCL_TIP280
+    Tcl_HashEntry* hePtr = NULL;
+    CmdFrame*      cfPtr = NULL;
+    Interp*        iPtr  = procPtr->iPtr;
+#endif
 
     if (bodyPtr != NULL) {
 	Tcl_DecrRefCount(bodyPtr);
@@ -1516,6 +1605,28 @@ TclProcCleanupProc(procPtr)
 	localPtr = nextPtr;
     }
     ckfree((char *) procPtr);
+
+#ifdef TCL_TIP280
+    /* TIP #280. Release the location data associated with this Proc
+     * structure, if any. The interpreter may not exist (For example for
+     * procbody structurues created by tbcload.
+     */
+
+    if (!iPtr) return;
+
+    hePtr = Tcl_FindHashEntry (iPtr->linePBodyPtr, (char *) procPtr);
+    if (!hePtr) return;
+
+    cfPtr = (CmdFrame*) Tcl_GetHashValue (hePtr);
+
+    if (cfPtr->type == TCL_LOCATION_SOURCE) {
+        Tcl_DecrRefCount (cfPtr->data.eval.path);
+	cfPtr->data.eval.path = NULL;
+    }
+    ckfree ((char*) cfPtr->line); cfPtr->line = NULL;
+    ckfree ((char*) cfPtr);
+    Tcl_DeleteHashEntry (hePtr);
+#endif
 }
 
 /*
@@ -1821,6 +1932,12 @@ TclCompileNoOp(interp, parsePtr, envPtr)
     TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr);
     return TCL_OK;
 }
-
-
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
 
diff --git a/tests/info.test b/tests/info.test
index 7a31b27..3c300dc 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -1,3 +1,4 @@
+# -*- tcl -*-
 # Commands covered:  info
 #
 # This file contains a collection of tests for one or more of the Tcl
@@ -7,11 +8,12 @@
 # Copyright (c) 1991-1994 The Regents of the University of California.
 # Copyright (c) 1994-1997 Sun Microsystems, Inc.
 # Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 2006      ActiveState
 #
 # 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.24.2.4 2005/07/29 14:57:28 dkf Exp $
+# RCS: @(#) $Id: info.test,v 1.24.2.5 2006/11/28 22:20:02 andreas_kupries Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -29,6 +31,9 @@ namespace eval test_ns_info1 {
     proc q {{y 27} {z {}}} {return "y=$y"}
 }
 
+testConstraint tip280  [info exists tcl_platform(tip,280)]
+testConstraint !tip280 [expr {![info exists tcl_platform(tip,280)]}]
+
 
 test info-1.1 {info args option} {
     proc t1 {a bbb c} {return foo}
@@ -651,18 +656,424 @@ test info-20.5 {info functions option} {
 test info-21.1 {miscellaneous error conditions} {
     list [catch {info} msg] $msg
 } {1 {wrong # args: should be "info option ?arg arg ...?"}}
-test info-21.2 {miscellaneous error conditions} {
+test info-21.2 {miscellaneous error conditions} !tip280 {
     list [catch {info gorp} msg] $msg
 } {1 {bad option "gorp": must be args, body, cmdcount, commands, complete, default, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
-test info-21.3 {miscellaneous error conditions} {
+test info-21.2-280 {miscellaneous error conditions} tip280 {
+    list [catch {info gorp} msg] $msg
+} {1 {bad option "gorp": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
+test info-21.3 {miscellaneous error conditions} !tip280 {
     list [catch {info c} msg] $msg
 } {1 {ambiguous option "c": must be args, body, cmdcount, commands, complete, default, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
-test info-21.4 {miscellaneous error conditions} {
+test info-21.3-280 {miscellaneous error conditions} tip280 {
+    list [catch {info c} msg] $msg
+} {1 {ambiguous option "c": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
+test info-21.4 {miscellaneous error conditions} !tip280 {
     list [catch {info l} msg] $msg
 } {1 {ambiguous option "l": must be args, body, cmdcount, commands, complete, default, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
-test info-21.5 {miscellaneous error conditions} {
+test info-21.4-280 {miscellaneous error conditions} tip280 {
+    list [catch {info l} msg] $msg
+} {1 {ambiguous option "l": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
+test info-21.5 {miscellaneous error conditions} !tip280 {
     list [catch {info s} msg] $msg
 } {1 {ambiguous option "s": must be args, body, cmdcount, commands, complete, default, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
+test info-21.5-280 {miscellaneous error conditions} tip280 {
+    list [catch {info s} msg] $msg
+} {1 {ambiguous option "s": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
+
+##
+# ### ### ### ######### ######### #########
+## info frame
+
+## Helper
+# For the more complex results we cut the file name down to remove
+# path dependencies, and we use only part of the first line of the
+# reported command. The latter is required because otherwise the whole
+# test case may appear in some results, but the result is part of the
+# testcase. An infinite string would be required to describe that. The
+# cutting-down breaks this.
+
+proc reduce {frame} {
+    set pos [lsearch -exact $frame cmd]
+    incr pos
+    set cmd   [lindex $frame $pos]
+    if {[regexp \n $cmd]} {
+	set first [string range [lindex [split $cmd \n] 0] 0 end-11]
+	set frame [lreplace $frame $pos $pos $first]
+    }
+    set pos [lsearch -exact $frame file]
+    if {$pos >=0} {
+	incr pos
+	set tail  [file tail [lindex $frame $pos]]
+	set frame [lreplace $frame $pos $pos $tail]
+    }
+    set frame
+}
+
+## Helper
+# Generate a stacktrace from the current location to top.  This code
+# not only depends on the exact location of things, but also on the
+# implementation of tcltest. Any changes and these tests will have to
+# be updated.
+
+proc etrace {} {
+    set res {}
+    set level [info frame]
+    while {$level} {
+	lappend res [list $level [reduce [info frame $level]]]
+	incr level -1
+    }
+    return $res
+}
+
+##
+
+test info-22.0 {info frame, levels} tip280 {
+    info frame
+} 7
+
+test info-22.1 {info frame, bad level relative} tip280 {
+    # catch is another level!, i.e. we have 8, not 7
+    catch {info frame -8} msg
+    set msg
+} {bad level "-8"}
+
+test info-22.2 {info frame, bad level absolute} tip280 {
+    # catch is another level!, i.e. we have 8, not 7
+    catch {info frame 9} msg
+    set msg
+} {bad level "9"}
+
+test info-22.3 {info frame, current, relative} tip280 {
+    info frame 0
+} {type eval line 2 cmd {info frame 0}}
+
+test info-22.4 {info frame, current, relative, nested} tip280 {
+    set res [info frame 0]
+} {type eval line 2 cmd {info frame 0}}
+
+test info-22.5 {info frame, current, absolute} tip280 {
+    reduce [info frame 7]
+} {type eval line 2 cmd {info frame 7}}
+
+test info-22.6 {info frame, global, relative} tip280 {
+    reduce [info frame -6]
+} {type source line 759 file info.test cmd test\ info-22.6\ \{info\ frame,\ global,\ relativ}
+
+test info-22.7 {info frame, global, absolute} tip280 {
+    reduce [info frame 1]
+} {type source line 763 file info.test cmd test\ info-22.7\ \{info\ frame,\ global,\ absolut}
+
+test info-22.8 {info frame, basic trace} tip280 {
+    join [etrace] \n
+} {8 {type source line 723 file info.test cmd {info frame $level} proc ::etrace level 0}
+7 {type eval line 2 cmd etrace}
+6 {type source line 2277 file tcltest.tcl cmd {uplevel 1 $script} proc ::tcltest::RunTest}
+5 {type eval line 1 cmd {::tcltest::RunTest }}
+4 {type source line 1619 file tcltest.tcl cmd {uplevel 1 $script} proc ::tcltest::Eval}
+3 {type eval line 1 cmd ::tcltest::Eval\ \{::tcltest::RunTest\ }
+2 {type source line 1966 file tcltest.tcl cmd {uplevel 1 [list [namespace origin Eval] $command 1]} proc ::tcltest::test}
+1 {type source line 767 file info.test cmd test\ info-22.8\ \{info\ frame,\ basic\ trac}}
+## The line 1966 is off by 5 from the true value of 1971. This is a knownBug, see testcase 30.0
+test info-23.0 {eval'd info frame} tip280 {
+    eval {info frame}
+} 8
+
+test info-23.1 {eval'd info frame, semi-dynamic} tip280 {
+    eval info frame
+} 8
+
+test info-23.2 {eval'd info frame, dynamic} tip280 {
+    set script {info frame}
+    eval $script
+} 8
+
+test info-23.3 {eval'd info frame, literal} tip280 {
+    eval {
+	info frame 0
+    }
+} {type eval line 2 cmd {info frame 0}}
+
+test info-23.4 {eval'd info frame, semi-dynamic} tip280 {
+    eval info frame 0
+} {type eval line 1 cmd {info frame 0}}
+
+test info-23.5 {eval'd info frame, dynamic} tip280 {
+    set script {info frame 0}
+    eval $script
+} {type eval line 1 cmd {info frame 0}}
+
+test info-23.6 {eval'd info frame, trace} tip280 {
+    set script {etrace}
+    join [eval $script] \n
+} {9 {type source line 723 file info.test cmd {info frame $level} proc ::etrace level 0}
+8 {type eval line 1 cmd etrace}
+7 {type eval line 3 cmd {eval $script}}
+6 {type source line 2277 file tcltest.tcl cmd {uplevel 1 $script} proc ::tcltest::RunTest}
+5 {type eval line 1 cmd {::tcltest::RunTest }}
+4 {type source line 1619 file tcltest.tcl cmd {uplevel 1 $script} proc ::tcltest::Eval}
+3 {type eval line 1 cmd ::tcltest::Eval\ \{::tcltest::RunTest\ }
+2 {type source line 1966 file tcltest.tcl cmd {uplevel 1 [list [namespace origin Eval] $command 1]} proc ::tcltest::test}
+1 {type source line 806 file info.test cmd test\ info-23.6\ \{eval'd\ info\ frame,\ trac}}
+## The line 1966 is off by 5 from the true value of 1971. This is a knownBug, see testcase 30.0
+# -------------------------------------------------------------------------
+
+# Procedures defined in scripts which are arguments to control
+# structures (like 'namespace eval', 'interp eval', 'if', 'while',
+# 'switch', 'catch', 'for', 'foreach', etc.) have no absolute
+# location. The command implementations execute such scripts through
+# Tcl_EvalObjEx. Flag 0 causes it to use the bytecode compiler. This
+# causes the connection to the context to be lost. Currently only
+# procedure bodies are able to remember their context.
+
+# -------------------------------------------------------------------------
+
+namespace eval foo {
+    proc bar {} {info frame 0}
+}
+
+test info-24.0 {info frame, interaction, namespace eval} tip280 {
+    reduce [foo::bar]
+} {type source line 832 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+namespace delete foo
+
+# -------------------------------------------------------------------------
+
+set flag 1
+if {$flag} {
+    namespace eval foo {}
+    proc ::foo::bar {} {info frame 0}
+}
+
+test info-24.1 {info frame, interaction, if} tip280 {
+    reduce [foo::bar]
+} {type source line 846 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+namespace delete foo
+
+# -------------------------------------------------------------------------
+
+set flag 1
+while {$flag} {
+    namespace eval foo {}
+    proc ::foo::bar {} {info frame 0}
+    set flag 0
+}
+
+test info-24.2 {info frame, interaction, while} tip280 {
+    reduce [foo::bar]
+} {type source line 860 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+namespace delete foo
+
+# -------------------------------------------------------------------------
+
+catch {
+    namespace eval foo {}
+    proc ::foo::bar {} {info frame 0}
+}
+
+test info-24.3 {info frame, interaction, catch} tip280 {
+    reduce [foo::bar]
+} {type source line 874 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+namespace delete foo
+
+# -------------------------------------------------------------------------
+
+foreach var val {
+    namespace eval foo {}
+    proc ::foo::bar {} {info frame 0}
+    break
+}
+
+test info-24.4 {info frame, interaction, foreach} tip280 {
+    reduce [foo::bar]
+} {type source line 887 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+namespace delete foo
+
+# -------------------------------------------------------------------------
+
+for {} {1} {} {
+    namespace eval foo {}
+    proc ::foo::bar {} {info frame 0}
+    break
+}
+
+test info-24.5 {info frame, interaction, for} tip280 {
+    reduce [foo::bar]
+} {type source line 901 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+namespace delete foo
+
+# -------------------------------------------------------------------------
+
+eval {
+    proc bar {} {info frame 0}
+}
+
+test info-25.0 {info frame, proc in eval} tip280 {
+    reduce [bar]
+} {type source line 914 file info.test cmd {info frame 0} proc ::bar level 0}
+
+proc bar {} {info frame 0}
+test info-25.1 {info frame, regular proc} tip280 {
+    reduce [bar]
+} {type source line 921 file info.test cmd {info frame 0} proc ::bar level 0}
+rename bar {}
+
+
+
+test info-30.0 {bs+nl in literal words} {tip280 knownBug} {
+    if {1} {
+	set res \
+	    [reduce [info frame 0]]
+    }
+    set res
+    # This is reporting line 3 instead of the correct 4 because the
+    # bs+nl combination is subst by the parser before the 'if'
+    # command, and the the bcc sees the word. To fix record the
+    # offsets of all bs+nl sequences in literal words, then use the
+    # information in the bcc to bump line numbers when parsing over
+    # the location. Also affected: testcases 22.8 and 23.6.
+} {type eval line 4 cmd {info frame 0} proc ::tcltest::RunTest}
+
+
+
+# -------------------------------------------------------------------------
+# See 24.0 - 24.5 for similar situations, using literal scripts.
+
+set body {set flag 0
+    set a c
+    set res [info frame 0]} ;# line 3!
+
+test info-31.0 {ns eval, script in variable} tip280 {
+    namespace eval foo $body
+    set res
+} {type eval line 3 cmd {info frame 0} level 0}
+catch {namespace delete foo}
+
+
+test info-31.1 {if, script in variable} tip280 {
+    if 1 $body
+    set res
+} {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-31.1a {if, script in variable} tip280 {
+    if 1 then $body
+    set res
+} {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
+
+
+
+test info-31.2 {while, script in variable} tip280 {
+    set flag 1
+    while {$flag} $body
+    set res
+} {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
+
+# .3 - proc - scoping prevent return of result ...
+
+test info-31.4 {foreach, script in variable} tip280 {
+    foreach var val $body
+    set res
+} {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-31.5 {for, script in variable} tip280 {
+    set flag 1
+    for {} {$flag} {} $body
+    set res
+} {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-31.6 {eval, script in variable} tip280 {
+    eval $body
+    set res
+} {type eval line 3 cmd {info frame 0}}
+
+# -------------------------------------------------------------------------
+
+namespace eval foo {}
+set x foo
+switch -exact -- $x {
+    foo {
+	proc ::foo::bar {} {info frame 0}
+    }
+}
+
+test info-24.6.0 {info frame, interaction, switch, list body} tip280 {
+    reduce [foo::bar]
+} {type source line 1001 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+namespace delete foo
+unset x
+
+# -------------------------------------------------------------------------
+
+namespace eval foo {}
+set x foo
+switch -exact -- $x foo {
+    proc ::foo::bar {} {info frame 0}
+}
+
+test info-24.6.1 {info frame, interaction, switch, multi-body} tip280 {
+    reduce [foo::bar]
+} {type source line 1017 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+namespace delete foo
+unset x
+
+# -------------------------------------------------------------------------
+
+namespace eval foo {}
+set x foo
+switch -exact -- $x [list foo {
+    proc ::foo::bar {} {info frame 0}
+}]
+
+test info-24.6.2 {info frame, interaction, switch, list body, dynamic} tip280 {
+    reduce [foo::bar]
+} {type proc line 1 cmd {info frame 0} proc ::foo::bar level 0}
+
+namespace delete foo
+unset x
+
+# -------------------------------------------------------------------------
+
+set body {
+    foo {
+	proc ::foo::bar {} {info frame 0}
+    }
+}
+
+namespace eval foo {}
+set x foo
+switch -exact -- $x $body
+
+test info-31.7 {info frame, interaction, switch, dynamic} tip280 {
+    reduce [foo::bar]
+} {type proc line 1 cmd {info frame 0} proc ::foo::bar level 0}
+
+namespace delete foo
+unset x
+
+# -------------------------------------------------------------------------
+
+set body {
+    proc ::foo::bar {} {info frame 0}
+}
+
+namespace eval foo {}
+eval $body
+
+test info-32.0 {info frame, dynamic procedure} tip280 {
+    reduce [foo::bar]
+} {type proc line 1 cmd {info frame 0} proc ::foo::bar level 0}
+
+namespace delete foo
+
+# -------------------------------------------------------------------------
 
 # cleanup
 catch {namespace delete test_ns_info1 test_ns_info2}
diff --git a/tests/platform.test b/tests/platform.test
index 01bf787..ce72211 100644
--- a/tests/platform.test
+++ b/tests/platform.test
@@ -23,6 +23,7 @@ test platform-1.1 {TclpSetVariables: tcl_platform} {
     i eval {catch {unset tcl_platform(debug)}}
     i eval {catch {unset tcl_platform(threaded)}}
     i eval {catch {unset tcl_platform(tip,268)}}
+    i eval {catch {unset tcl_platform(tip,280)}}
     set result [i eval {lsort [array names tcl_platform]}]
     interp delete i
     set result
diff --git a/tests/safe.test b/tests/safe.test
index 15dfa85..938e247 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -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: safe.test,v 1.13.2.2 2006/09/22 01:26:24 andreas_kupries Exp $
+# RCS: @(#) $Id: safe.test,v 1.13.2.3 2006/11/28 22:20:03 andreas_kupries Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -191,6 +191,10 @@ test safe-6.3 {test safe interpreters knowledge of the world} {
     if {$tip != -1} {
 	set r [lreplace $r $tip $tip]
     }
+    set tip [lsearch $r "tip,280"]
+    if {$tip != -1} {
+	set r [lreplace $r $tip $tip]
+    }
     set r
 } {byteOrder platform wordSize}
author	andreas_kupries <akupries@shaw.ca>	2006-11-28 22:19:57 (GMT)
committer	andreas_kupries <akupries@shaw.ca>	2006-11-28 22:19:57 (GMT)
commit	bf08959966d3a565773dbddb52b0be2e0747ec3a (patch)
tree	dfdbbd337f6bf772d6f99a7a6ea50aaaab685d00
parent	78afab8ec5cb163b94f8fed86fb67d9e339d9268 (diff)
download	tcl-bf08959966d3a565773dbddb52b0be2e0747ec3a.zip tcl-bf08959966d3a565773dbddb52b0be2e0747ec3a.tar.gz tcl-bf08959966d3a565773dbddb52b0be2e0747ec3a.tar.bz2