From 1ddb66bfdaba5d875111c7b0f6ebecc8d5e69f35 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 9 Apr 2013 19:04:04 +0000
Subject: Use the double-secret iPtr->lookupNsPtr field to get post-enter-trace
 re-resolutions of commands done in the right context for oo forwards.

---
 generic/tclOOMethod.c | 1 +
 1 file changed, 1 insertion(+)

diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index 98b4078..5296397 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -1429,6 +1429,7 @@ InvokeForwardMethod(
 		contextPtr->oPtr->namespacePtr, 0 /* normal lookup */);
     }
     Tcl_NRAddCallback(interp, FinalizeForwardCall, argObjs, NULL, NULL, NULL);
+    ((Interp *)interp)->lookupNsPtr = contextPtr->oPtr->namespacePtr;
     return TclNREvalObjv(interp, len, argObjs, TCL_EVAL_INVOKE, cmdPtr);
 }
 
-- 
cgit v0.12


From b6b0d1b8dd33bb6eb9c97217ec0c813452cafaed Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Tue, 9 Apr 2013 20:01:08 +0000
Subject: added some test cases, based on bug report

---
 tests/oo.test | 63 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 63 insertions(+)

diff --git a/tests/oo.test b/tests/oo.test
index 49fe150..84e6236 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -936,6 +936,69 @@ test oo-6.18 {Bug 3408830: more forwarding cases} -setup {
 } -returnCodes error -cleanup {
     fooClass destroy
 } -result {wrong # args: should be "::foo len string"}
+test oo-6.19 {Bug 3610404: forwarding resolution + traces} -setup {
+    oo::object create foo
+    unset -nocomplain ::result
+    set ::result {}
+} -body {
+    proc ::my {method} {lappend ::result global}
+    oo::objdefine foo {
+	method target {} {lappend ::result instance}
+	forward bar my target
+	method bump {} {
+	    set ns [info object namespace ::foo]
+	    rename ${ns}::my ${ns}::
+	    rename ${ns}:: ${ns}::my
+	}
+    }
+    proc harness {} {
+	foo target
+	foo bar
+	foo target
+    }
+    trace add execution harness enterstep {apply {{cmd args} {foo bump}}}
+    foo target
+    foo bar
+    foo bump
+    foo bar
+    harness
+} -cleanup {
+    catch {rename harness {}}
+    catch {rename ::my {}}
+    foo destroy
+} -result {instance instance instance instance instance instance}
+test oo-6.20 {Bug 3610404: forwarding resolution + traces} -setup {
+    oo::class create fooClass
+    fooClass create foo
+    unset -nocomplain ::result
+    set ::result {}
+} -body {
+    proc ::my {method} {lappend ::result global}
+    oo::define fooClass {
+	method target {} {lappend ::result class}
+	forward bar my target
+	method bump {} {
+	    set ns [info object namespace [self]]
+	    rename ${ns}::my ${ns}::
+	    rename ${ns}:: ${ns}::my
+	}
+    }
+    proc harness {} {
+	foo target
+	foo bar
+	foo target
+    }
+    trace add execution harness enterstep {apply {{cmd args} {foo bump}}}
+    foo target
+    foo bar
+    foo bump
+    foo bar
+    harness
+} -cleanup {
+    catch {rename harness {}}
+    catch {rename ::my {}}
+    fooClass destroy
+} -result {class class class class class class}
 
 test oo-7.1 {OO: inheritance 101} -setup {
     oo::class create superClass
-- 
cgit v0.12


From dc4782f5951c5d881c932ff0a4c194ca89193702 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 25 Jun 2013 14:19:39 +0000
Subject: Branch for rewriting TclCompileScript() and related routines, with
 the intent to generally simplify and make more readable, as well as find and
 eliminate duplication with ensemble machinery and improve mergeability to
 other branches.  Work in Progress.  Doesn't work at all right now.

---
 generic/tclCompile.c | 124 +++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 124 insertions(+)

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 8cb53f5..eafecbc 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1737,6 +1737,37 @@ FindCompiledCommandFromToken(
  *----------------------------------------------------------------------
  */
 
+#if 1
+static void
+CompileCommandTokens(
+    Tcl_Interp *interp,
+    Tcl_Parse *parsePtr,
+    CompileEnv *envPtr)
+{
+    Tcl_Obj *cmdObj;
+    Tcl_Token *cmdTokenPtr = parsePtr->tokenPtr;
+	
+
+    if (parsePtr->numWords == 0) {
+	return 0;
+    }
+
+    if (!TclWordKnownAtCompileTime(cmdTokenPtr, cmdObj)) {
+	/*
+	 * Command is not known until runtime substitution is complete.
+	 * Emit instructions to perform that substitution.
+	 */
+	CompileTokens(interp, cmdTokenPtr, envPtr);
+
+    }
+
+    
+
+    TclEmitOpcode(INST_POP, envPtr);
+
+}
+#endif
+
 void
 TclCompileScript(
     Tcl_Interp *interp,		/* Used for error and status reporting. Also
@@ -1748,6 +1779,98 @@ TclCompileScript(
 				 * first null character. */
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
+#if 1
+    unsigned char *entryCodeNext = envPtr->codeNext;
+    const char *p;
+    int cmdLine, *clNext;
+
+    if (envPtr->iPtr == NULL) {
+	Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv");
+    }
+
+    /*
+     * Each iteration through the following loop compiles the next command
+     * from the script.
+     */
+
+    p = script;
+    cmdLine = envPtr->line;
+    clNext = envPtr->clNext;
+    while (numBytes > 0) {
+	Tcl_Parse parse;
+	const char *next;
+
+	/* TODO: can we relocate this to happen less frequently? */
+	Tcl_ResetResult(interp);
+	if (TCL_OK != Tcl_ParseCommand(interp, p, numBytes, 0, &parse)) {
+	    /*
+	     * Compile bytecodes to report the parse error at runtime.
+	     */
+
+	    Tcl_LogCommandInfo(interp, script, parse.commandStart,
+		    parse.term - parse.commandStart);
+	    TclCompileSyntaxError(interp, envPtr);
+	    break;
+	}
+
+	/*
+	 * TIP #280: Count newlines before the command start.
+	 * (See test info-30.33).
+	 */
+
+	TclAdvanceLines(&cmdLine, p, parse.commandStart);
+	TclAdvanceContinuations(&cmdLine, &clNext,
+		parse.commandStart - envPtr->source);
+
+#ifdef TCL_COMPILE_DEBUG
+	/*
+	 * If tracing, print a line for each top level command compiled.
+	 */
+
+	if ((tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) {
+	    fprintf(stdout, "  Compiling: ");
+	    TclPrintSource(stdout, parse.commandStart,
+		    TclMin(parse.term - parse.commandStart, 55));
+	    fprintf(stdout, "\n");
+	}
+#endif
+
+	CompileCommandTokens(interp, &parse, envPtr);
+
+	/*
+	 * Advance to the next command in the script.
+	 */
+
+	next = parse.commandStart + parse.commandSize;
+	numBytes -= next - p;
+	p = next;
+
+	/*
+	 * TIP #280: Track lines in the just compiled command.
+	 */
+
+	TclAdvanceLines(&cmdLine, parsePtr->commandStart, p);
+	TclAdvanceContinuations(&cmdLine, &clNext, p - envPtr->source);
+	Tcl_FreeParse(&parse);
+    }
+
+    /*
+     * TIP #280: Bring the line counts in the CompEnv up to date.
+     *	See tests info-30.33,34,35 .
+     */
+
+    envPtr->line = cmdLine;
+    envPtr->clNext = clNext;
+
+    /*
+     * If the source script yielded no instructions (e.g., if it was empty),
+     * push an empty string as the command's result.
+     */
+
+    if (envPtr->codeNext == entryCodeNext) {
+	PushStringLiteral(envPtr, "");
+    }
+#else
     int lastTopLevelCmdIndex = -1;
 				/* Index of most recent toplevel command in
 				 * the command location table. Initialized to
@@ -2192,6 +2315,7 @@ TclCompileScript(
     if (envPtr->codeNext == entryCodeNext) {
 	PushStringLiteral(envPtr, "");
     }
+#endif
 }
 
 /*
-- 
cgit v0.12


From 11f1a88c1296f43cc886843ce15a820243ff2c12 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 25 Jun 2013 20:22:31 +0000
Subject: Nearly functional now, but leaky and not yet as tidy as I'm hoping
 for.

---
 generic/tclCompile.c | 301 +++++++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 289 insertions(+), 12 deletions(-)

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 01320cf..2c6af46 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1744,27 +1744,295 @@ CompileCommandTokens(
     Tcl_Parse *parsePtr,
     CompileEnv *envPtr)
 {
-    Tcl_Obj *cmdObj;
-    Tcl_Token *cmdTokenPtr = parsePtr->tokenPtr;
-	
+    Interp *iPtr = (Interp *) interp;
+    Tcl_Obj *cmdObj = Tcl_NewObj();
+    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
+    Command *cmdPtr = NULL;
+    int wordIdx, cmdKnown, expand = 0, numWords = parsePtr->numWords;
+    ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
+    int *wlines, wlineat;
 
-    if (parsePtr->numWords == 0) {
-	return 0;
+    if (numWords == 0) {
+	return;
+    }
+ 
+    for (wordIdx = 0; wordIdx < numWords;
+	    wordIdx++, tokenPtr += tokenPtr->numComponents + 1) {
+	if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
+	    expand = 1;
+	    break;
+	}
     }
 
-    if (!TclWordKnownAtCompileTime(cmdTokenPtr, cmdObj)) {
+    Tcl_IncrRefCount(cmdObj);
+    tokenPtr = parsePtr->tokenPtr;
+    cmdKnown = TclWordKnownAtCompileTime(tokenPtr, cmdObj);
+
+    if (cmdKnown && !(iPtr->flags & DONT_COMPILE_CMDS_INLINE)) {
+	cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj);
+	if (cmdPtr) {
+	    /*
+	     * Found a command.  Test all the ways we can be told
+	     * not to attempt to compile it.
+	     */
+	    if ((cmdPtr->compileProc == NULL)
+		    || (cmdPtr->nsPtr->flags & NS_SUPPRESS_COMPILATION)
+		    || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)
+		    || (expand && !(cmdPtr->flags & CMD_COMPILES_EXPANDED))) {
+		cmdPtr = NULL;
+	    }
+	}
+    }
+
+    /* Pre-Compile */
+int lastTopLevelCmdIndex, currCmdIndex, startCodeOffset;
+
+int    cmdLine = envPtr->line;
+int    *clNext = envPtr->clNext;
+
+    lastTopLevelCmdIndex = currCmdIndex = envPtr->numCommands;
+    envPtr->numCommands++;
+    startCodeOffset = envPtr->codeNext - envPtr->codeStart;
+    EnterCmdStartData(envPtr, currCmdIndex,
+	    parsePtr->commandStart - envPtr->source, startCodeOffset);
+
+    if (expand && !cmdPtr) {
+	StartExpanding(envPtr);
+    }
+
+    /*
+     * 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'.
+     */
+
+    EnterCmdWordData(eclPtr, parsePtr->commandStart - envPtr->source,
+	    parsePtr->tokenPtr, parsePtr->commandStart,
+	    parsePtr->commandSize, parsePtr->numWords, cmdLine,
+	    clNext, &wlines, envPtr);
+    wlineat = eclPtr->nuloc - 1;
+
+    envPtr->line = eclPtr->loc[wlineat].line[0];
+    envPtr->clNext = eclPtr->loc[wlineat].next[0];
+
+    if (cmdPtr) {
+	int savedNumCmds = envPtr->numCommands;
+	int update = 0;
+	int startStackDepth = envPtr->currStackDepth;
+
+	/*
+	 * Mark the start of the command; the proper bytecode
+	 * length will be updated later. There is no need to
+	 * do this for the first bytecode in the compile env,
+	 * as the check is done before calling
+	 * TclNRExecuteByteCode(). Do emit an INST_START_CMD
+	 * in special cases where the first bytecode is in a
+	 * loop, to insure that the corresponding command is
+	 * counted properly. Compilers for commands able to
+	 * produce such a beast (currently 'while 1' only) set
+	 * envPtr->atCmdStart to 0 in order to signal this
+	 * case. [Bug 1752146]
+	 *
+	 * Note that the environment is initialised with
+	 * atCmdStart=1 to avoid emitting ISC for the first
+	 * command.
+	 */
+
+	if (envPtr->atCmdStart == 1) {
+	    if (startCodeOffset) {
+		/*
+		 * Increase the number of commands being
+		 * started at the current point. Note that
+		 * this depends on the exact layout of the
+		 * INST_START_CMD's operands, so be careful!
+		 */
+
+		TclIncrUInt4AtPtr(envPtr->codeNext - 4, 1)
+	    }
+	} else if (envPtr->atCmdStart == 0) {
+	    TclEmitInstInt4(INST_START_CMD, 0, envPtr);
+	    TclEmitInt4(1, envPtr);
+	    update = 1;
+	}
+
+	if (TCL_OK == cmdPtr->compileProc(interp, parsePtr, cmdPtr, envPtr)) {
+
+#ifdef TCL_COMPILE_DEBUG
+	    /*
+	     * Confirm that the command compiler generated a
+	     * single value on the stack as its result. This
+	     * is only done in debugging mode, as it *should*
+	     * be correct and normal users have no reasonable
+	     * way to fix it anyway.
+	     */
+
+	    int diff = envPtr->currStackDepth - startStackDepth;
+
+	    if (diff != 1) {
+		Tcl_Panic("bad stack adjustment when compiling"
+			" %.*s (was %d instead of 1)",
+			parsePtr->tokenPtr->size,
+			parsePtr->tokenPtr->start, diff);
+	    }
+#endif
+	    if (update) {
+		/*
+		 * Fix the bytecode length.
+		 */
+
+		unsigned char *fixPtr = envPtr->codeStart + startCodeOffset + 1;
+		unsigned fixLen = envPtr->codeNext - fixPtr + 1;
+
+		TclStoreInt4AtPtr(fixLen, fixPtr);
+	    }
+	    goto finishCommand;
+	}
+
+	if (envPtr->atCmdStart == 1 && startCodeOffset != 0) {
+	    /*
+	     * Decrease the number of commands being started
+	     * at the current point. Note that this depends on
+	     * the exact layout of the INST_START_CMD's
+	     * operands, so be careful!
+	     */
+
+	    TclIncrUInt4AtPtr(envPtr->codeNext - 4, -1);
+	}
+
 	/*
-	 * Command is not known until runtime substitution is complete.
-	 * Emit instructions to perform that substitution.
+	 * Restore numCommands, codeNext, and currStackDepth  to their
+	 * correct values, removing any commands compiled before the
+	 * failure to produce bytecode got reported.
+	 * [Bugs 705406, 735055, 3614102]
 	 */
-	CompileTokens(interp, cmdTokenPtr, envPtr);
 
+	envPtr->numCommands = savedNumCmds;
+	envPtr->codeNext = envPtr->codeStart + startCodeOffset;
+	envPtr->currStackDepth = startStackDepth;
+
+	envPtr->line = eclPtr->loc[wlineat].line[0];
+	envPtr->clNext = eclPtr->loc[wlineat].next[0];
+
+	/* TODO: Can this happen?  If so, is this right? */
+	if (expand) {
+	    StartExpanding(envPtr);
+	}
     }
 
-    
+    /*
+     * No complile attempted, or it failed.
+     * Need to emit instructions to invoke, with expansion if needed.
+     */
+
+    wordIdx = 0;
+    tokenPtr = parsePtr->tokenPtr;
+    if (cmdKnown) {
+	int cmdLitIdx, numBytes;
+	const char *bytes = Tcl_GetStringFromObj(cmdObj, &numBytes);
+
+	cmdLitIdx = TclRegisterNewCmdLiteral(envPtr, bytes, numBytes);
+	cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj);
+	if (cmdPtr) {
+	    TclSetCmdNameObj(interp,
+		    TclFetchLiteral(envPtr, cmdLitIdx), cmdPtr);
+	}
+	TclEmitPush(cmdLitIdx, envPtr);
 
+	wordIdx = 1;
+	tokenPtr += tokenPtr->numComponents + 1;
+    }
+
+    for (; wordIdx < numWords;
+	    wordIdx++, tokenPtr += tokenPtr->numComponents + 1) {
+	int objIdx;
+
+	envPtr->line = eclPtr->loc[wlineat].line[wordIdx];
+	envPtr->clNext = eclPtr->loc[wlineat].next[wordIdx];
+
+	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	    CompileTokens(envPtr, tokenPtr, interp);
+	    if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
+		TclEmitInstInt4(INST_EXPAND_STKTOP,
+			envPtr->currStackDepth, envPtr);
+	    }
+	    continue;
+	}
+
+	objIdx = TclRegisterNewLiteral(envPtr,
+		tokenPtr[1].start, tokenPtr[1].size);
+	if (envPtr->clNext) {
+	    TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx),
+		    tokenPtr[1].start - envPtr->source,
+		    eclPtr->loc[wlineat].next[wordIdx]);
+	}
+	TclEmitPush(objIdx, envPtr);
+    }
+
+    /*
+     * Emit an invoke instruction for the command. We skip this if a
+     * compile procedure was found for the command.
+     */
+
+    if (expand) {
+	/*
+	 * The stack depth during argument expansion can only be
+	 * managed at runtime, as the number of elements in the
+	 * expanded lists is not known at compile time. We adjust here
+	 * the stack depth estimate so that it is correct after the
+	 * command with expanded arguments returns.
+	 *
+	 * The end effect of this command's invocation is that all the
+	 * words of the command are popped from the stack, and the
+	 * result is pushed: the stack top changes by (1-wordIdx).
+	 *
+	 * Note that the estimates are not correct while the command
+	 * is being prepared and run, INST_EXPAND_STKTOP is not
+	 * stack-neutral in general.
+	 */
+
+	TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr);
+	envPtr->expandCount--;
+	TclAdjustStackDepth(1 - wordIdx, envPtr);
+    } else {
+	/*
+	 * Save PC -> command map for the TclArgumentBC* functions.
+	 */
+
+	int isnew;
+	Tcl_HashEntry *hePtr = Tcl_CreateHashEntry(&eclPtr->litInfo,
+		INT2PTR(envPtr->codeNext - envPtr->codeStart), &isnew);
+
+	Tcl_SetHashValue(hePtr, INT2PTR(wlineat));
+	if (wordIdx <= 255) {
+	    TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr);
+	} else {
+	    TclEmitInstInt4(INST_INVOKE_STK4, wordIdx, envPtr);
+	}
+    }
+
+finishCommand:
     TclEmitOpcode(INST_POP, envPtr);
+    EnterCmdExtentData(envPtr, currCmdIndex,
+	    parsePtr->term - parsePtr->commandStart,
+	    (envPtr->codeNext-envPtr->codeStart) - startCodeOffset);
 
+    if (cmdKnown) {
+	Tcl_DecrRefCount(cmdObj);
+    }
+
+    /*
+     * TIP #280: Free full form of per-word line data and insert the
+     * reduced form now
+     */
+
+    envPtr->line = cmdLine;
+    envPtr->clNext = clNext;
+    ckfree(eclPtr->loc[wlineat].line);
+    ckfree(eclPtr->loc[wlineat].next);
+    eclPtr->loc[wlineat].line = wlines;
+    eclPtr->loc[wlineat].next = NULL;
 }
 #endif
 
@@ -1828,14 +2096,19 @@ TclCompileScript(
 	 */
 
 	if ((tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) {
+	    int commandLength = parse.term - parse.commandStart;
 	    fprintf(stdout, "  Compiling: ");
 	    TclPrintSource(stdout, parse.commandStart,
-		    TclMin(parse.term - parse.commandStart, 55));
+		    TclMin(commandLength, 55));
 	    fprintf(stdout, "\n");
 	}
 #endif
 
+    envPtr->line = cmdLine;
+    envPtr->clNext = clNext;
 	CompileCommandTokens(interp, &parse, envPtr);
+    cmdLine = envPtr->line;
+    clNext = envPtr->clNext;
 
 	/*
 	 * Advance to the next command in the script.
@@ -1849,7 +2122,7 @@ TclCompileScript(
 	 * TIP #280: Track lines in the just compiled command.
 	 */
 
-	TclAdvanceLines(&cmdLine, parsePtr->commandStart, p);
+	TclAdvanceLines(&cmdLine, parse.commandStart, p);
 	TclAdvanceContinuations(&cmdLine, &clNext, p - envPtr->source);
 	Tcl_FreeParse(&parse);
     }
@@ -1869,6 +2142,10 @@ TclCompileScript(
 
     if (envPtr->codeNext == entryCodeNext) {
 	PushStringLiteral(envPtr, "");
+    } else {
+	/* Remove the surplus INST_POP */
+	envPtr->codeNext--;
+	TclAdjustStackDepth(1, envPtr);
     }
 #else
     int lastTopLevelCmdIndex = -1;
-- 
cgit v0.12


From 5eecd400b721e762d5bb10f1582cf43b278f34b1 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 26 Jun 2013 03:46:54 +0000
Subject: A few bug fixes from failing tests; still leaky.

---
 generic/tclCompile.c | 7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 955078c..626c5ae 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -2076,7 +2076,10 @@ TclCompileScript(
 	     */
 
 	    Tcl_LogCommandInfo(interp, script, parse.commandStart,
-		    parse.term - parse.commandStart);
+		    /* Drop the command terminator (";","]") if appropriate */
+		    (parse.term ==
+		    parse.commandStart + parse.commandSize - 1)?
+		    parse.commandSize - 1 : parse.commandSize);
 	    TclCompileSyntaxError(interp, envPtr);
 	    break;
 	}
@@ -2142,7 +2145,7 @@ TclCompileScript(
 
     if (envPtr->codeNext == entryCodeNext) {
 	PushStringLiteral(envPtr, "");
-    } else {
+    } else if (envPtr->codeNext[-1] == INST_POP) {
 	/* Remove the surplus INST_POP */
 	envPtr->codeNext--;
 	TclAdjustStackDepth(1, envPtr);
-- 
cgit v0.12


From ae7b32a706d7f69fc2e4ce06f546a99325f9716f Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 26 Jun 2013 16:06:44 +0000
Subject: Fix bytecode ranges in the cmdMapPtr.  still leaky.

---
 generic/tclCompile.c | 13 +++++++++----
 1 file changed, 9 insertions(+), 4 deletions(-)

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 626c5ae..62943b2 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1742,7 +1742,8 @@ static void
 CompileCommandTokens(
     Tcl_Interp *interp,
     Tcl_Parse *parsePtr,
-    CompileEnv *envPtr)
+    CompileEnv *envPtr,
+    int *lastPopPtr)
 {
     Interp *iPtr = (Interp *) interp;
     Tcl_Obj *cmdObj = Tcl_NewObj();
@@ -2017,6 +2018,8 @@ finishCommand:
     EnterCmdExtentData(envPtr, currCmdIndex,
 	    parsePtr->term - parsePtr->commandStart,
 	    (envPtr->codeNext-envPtr->codeStart) - startCodeOffset);
+    *lastPopPtr = currCmdIndex;
+    
 
     if (cmdKnown) {
 	Tcl_DecrRefCount(cmdObj);
@@ -2051,6 +2054,7 @@ TclCompileScript(
     unsigned char *entryCodeNext = envPtr->codeNext;
     const char *p;
     int cmdLine, *clNext;
+    int lastPop = -1;
 
     if (envPtr->iPtr == NULL) {
 	Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv");
@@ -2081,6 +2085,7 @@ TclCompileScript(
 		    parse.commandStart + parse.commandSize - 1)?
 		    parse.commandSize - 1 : parse.commandSize);
 	    TclCompileSyntaxError(interp, envPtr);
+	    lastPop = -1;
 	    break;
 	}
 
@@ -2109,7 +2114,7 @@ TclCompileScript(
 
     envPtr->line = cmdLine;
     envPtr->clNext = clNext;
-	CompileCommandTokens(interp, &parse, envPtr);
+	CompileCommandTokens(interp, &parse, envPtr, &lastPop);
     cmdLine = envPtr->line;
     clNext = envPtr->clNext;
 
@@ -2145,8 +2150,8 @@ TclCompileScript(
 
     if (envPtr->codeNext == entryCodeNext) {
 	PushStringLiteral(envPtr, "");
-    } else if (envPtr->codeNext[-1] == INST_POP) {
-	/* Remove the surplus INST_POP */
+    } else if (lastPop >= 0) {
+	envPtr->cmdMapPtr[lastPop].numCodeBytes--;
 	envPtr->codeNext--;
 	TclAdjustStackDepth(1, envPtr);
     }
-- 
cgit v0.12


From 7070acfea16b0c6906cd488877c1bb74afca5275 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 27 Jun 2013 13:11:53 +0000
Subject: plug memory leaks

---
 generic/tclCompile.c | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 62943b2..416078c 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1746,7 +1746,7 @@ CompileCommandTokens(
     int *lastPopPtr)
 {
     Interp *iPtr = (Interp *) interp;
-    Tcl_Obj *cmdObj = Tcl_NewObj();
+    Tcl_Obj *cmdObj;
     Tcl_Token *tokenPtr = parsePtr->tokenPtr;
     Command *cmdPtr = NULL;
     int wordIdx, cmdKnown, expand = 0, numWords = parsePtr->numWords;
@@ -1765,6 +1765,7 @@ CompileCommandTokens(
 	}
     }
 
+    cmdObj = Tcl_NewObj();
     Tcl_IncrRefCount(cmdObj);
     tokenPtr = parsePtr->tokenPtr;
     cmdKnown = TclWordKnownAtCompileTime(tokenPtr, cmdObj);
@@ -2085,6 +2086,7 @@ TclCompileScript(
 		    parse.commandStart + parse.commandSize - 1)?
 		    parse.commandSize - 1 : parse.commandSize);
 	    TclCompileSyntaxError(interp, envPtr);
+	    Tcl_FreeParse(&parse);
 	    lastPop = -1;
 	    break;
 	}
-- 
cgit v0.12


From a47b03577bd612657a8cc1c7844231c00bc6d313 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 27 Jun 2013 20:10:41 +0000
Subject: Stop the compileProc routines leaving behind error messages in
 interp. (Nicer way to solve [Bug 20a81392ec].)  Make simplifications in
 TclCompileScript() make possible by the new structure.  Still a work in
 progress.

---
 generic/tclAssembly.c   |  32 +++++++++++++-
 generic/tclCompCmds.c   |   5 ++-
 generic/tclCompCmdsGR.c |   1 +
 generic/tclCompile.c    | 109 ++++++++++++++++++++++--------------------------
 4 files changed, 83 insertions(+), 64 deletions(-)

diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 62641e6..1a061f0 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -930,6 +930,12 @@ TclCompileAssembleCmd(
 {
     Tcl_Token *tokenPtr;	/* Token in the input script */
 
+#if 0
+    int numCommands = envPtr->numCommands;
+    int offset = envPtr->codeNext - envPtr->codeStart;
+    int depth = envPtr->currStackDepth;
+#endif
+
     /*
      * Make sure that the command has a single arg that is a simple word.
      */
@@ -943,10 +949,32 @@ TclCompileAssembleCmd(
     }
 
     /*
-     * Compile the code and return any error from the compilation.
+     * Compile the code and convert any error from the compilation into
+     * bytecode reporting the error;
      */
 
-    return TclAssembleCode(envPtr, tokenPtr[1].start, tokenPtr[1].size, 0);
+    if (TCL_ERROR == TclAssembleCode(envPtr, tokenPtr[1].start,
+	    tokenPtr[1].size, TCL_EVAL_DIRECT)) {
+
+    /*
+     * TODO: Finish working out how to capture syntax errors captured
+     * during compile and make them bytecode reporting the error.
+     */
+#if 0
+	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+		"\n    (\"%.*s\" body, line %d)",
+		parsePtr->tokenPtr->size, parsePtr->tokenPtr->start,
+		Tcl_GetErrorLine(interp)));
+	envPtr->numCommands = numCommands;
+	envPtr->codeNext = envPtr->codeStart + offset;
+	envPtr->currStackDepth = depth;
+	TclCompileSyntaxError(interp, envPtr);
+#else
+	Tcl_ResetResult(interp);
+	return TCL_ERROR;
+#endif
+    }
+    return TCL_OK;
 }
 
 /*
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index fddf152..18295eb 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -2544,7 +2544,7 @@ CompileEachloopCmd(
 
 	Tcl_DStringInit(&varList);
 	TclDStringAppendToken(&varList, &tokenPtr[1]);
-	code = Tcl_SplitList(interp, Tcl_DStringValue(&varList),
+	code = Tcl_SplitList(NULL, Tcl_DStringValue(&varList),
 		&varcList[loopIndex], &varvList[loopIndex]);
 	Tcl_DStringFree(&varList);
 	if (code != TCL_OK) {
@@ -2988,7 +2988,8 @@ TclCompileFormatCmd(
     ckfree(objv);
     Tcl_DecrRefCount(formatObj);
     if (tmpObj == NULL) {
-	return TCL_ERROR;
+	TclCompileSyntaxError(interp, envPtr);
+	return TCL_OK;
     }
 
     /*
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index f7c15e6..4de8cf2 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -2534,6 +2534,7 @@ TclCompileSyntaxError(
     TclEmitPush(TclRegisterNewLiteral(envPtr, bytes, numBytes), envPtr);
     CompileReturnInternal(envPtr, INST_SYNTAX, TCL_ERROR, 0,
 	    TclNoErrorStack(interp, Tcl_GetReturnOptions(interp, TCL_ERROR)));
+    Tcl_ResetResult(interp);
 }
 
 /*
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 416078c..5a8524c 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1738,24 +1738,25 @@ FindCompiledCommandFromToken(
  */
 
 #if 1
-static void
+static int
 CompileCommandTokens(
     Tcl_Interp *interp,
     Tcl_Parse *parsePtr,
-    CompileEnv *envPtr,
-    int *lastPopPtr)
+    CompileEnv *envPtr)
 {
     Interp *iPtr = (Interp *) interp;
-    Tcl_Obj *cmdObj;
     Tcl_Token *tokenPtr = parsePtr->tokenPtr;
+    ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
+    Tcl_Obj *cmdObj = Tcl_NewObj();
     Command *cmdPtr = NULL;
     int wordIdx, cmdKnown, expand = 0, numWords = parsePtr->numWords;
-    ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
     int *wlines, wlineat;
+    int cmdLine = envPtr->line;
+    int *clNext = envPtr->clNext;
+    int cmdIdx = envPtr->numCommands;
+    int startCodeOffset = envPtr->codeNext - envPtr->codeStart;
 
-    if (numWords == 0) {
-	return;
-    }
+    assert (numWords > 0);
  
     for (wordIdx = 0; wordIdx < numWords;
 	    wordIdx++, tokenPtr += tokenPtr->numComponents + 1) {
@@ -1765,7 +1766,6 @@ CompileCommandTokens(
 	}
     }
 
-    cmdObj = Tcl_NewObj();
     Tcl_IncrRefCount(cmdObj);
     tokenPtr = parsePtr->tokenPtr;
     cmdKnown = TclWordKnownAtCompileTime(tokenPtr, cmdObj);
@@ -1787,15 +1787,9 @@ CompileCommandTokens(
     }
 
     /* Pre-Compile */
-int lastTopLevelCmdIndex, currCmdIndex, startCodeOffset;
-
-int    cmdLine = envPtr->line;
-int    *clNext = envPtr->clNext;
 
-    lastTopLevelCmdIndex = currCmdIndex = envPtr->numCommands;
     envPtr->numCommands++;
-    startCodeOffset = envPtr->codeNext - envPtr->codeStart;
-    EnterCmdStartData(envPtr, currCmdIndex,
+    EnterCmdStartData(envPtr, cmdIdx,
 	    parsePtr->commandStart - envPtr->source, startCodeOffset);
 
     if (expand && !cmdPtr) {
@@ -2016,11 +2010,9 @@ int    *clNext = envPtr->clNext;
 
 finishCommand:
     TclEmitOpcode(INST_POP, envPtr);
-    EnterCmdExtentData(envPtr, currCmdIndex,
+    EnterCmdExtentData(envPtr, cmdIdx,
 	    parsePtr->term - parsePtr->commandStart,
 	    (envPtr->codeNext-envPtr->codeStart) - startCodeOffset);
-    *lastPopPtr = currCmdIndex;
-    
 
     if (cmdKnown) {
 	Tcl_DecrRefCount(cmdObj);
@@ -2037,6 +2029,8 @@ finishCommand:
     ckfree(eclPtr->loc[wlineat].next);
     eclPtr->loc[wlineat].line = wlines;
     eclPtr->loc[wlineat].next = NULL;
+
+    return cmdIdx;
 }
 #endif
 
@@ -2052,10 +2046,8 @@ TclCompileScript(
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
 #if 1
-    unsigned char *entryCodeNext = envPtr->codeNext;
-    const char *p;
-    int cmdLine, *clNext;
-    int lastPop = -1;
+    int lastCmdIdx = -1;
+    const char *p = script;
 
     if (envPtr->iPtr == NULL) {
 	Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv");
@@ -2066,40 +2058,34 @@ TclCompileScript(
      * from the script.
      */
 
-    p = script;
-    cmdLine = envPtr->line;
-    clNext = envPtr->clNext;
+    /* TODO: Figure out when/why we need this */
+#if 0
+if (Tcl_GetStringResult(interp)[0] != '\0') {
+    fprintf(stdout, "INIT: '%s'\n", Tcl_GetStringResult(interp));
+    fflush(stdout);
+}
+#endif
+    Tcl_ResetResult(interp);
     while (numBytes > 0) {
 	Tcl_Parse parse;
 	const char *next;
 
-	/* TODO: can we relocate this to happen less frequently? */
-	Tcl_ResetResult(interp);
 	if (TCL_OK != Tcl_ParseCommand(interp, p, numBytes, 0, &parse)) {
 	    /*
 	     * Compile bytecodes to report the parse error at runtime.
 	     */
 
 	    Tcl_LogCommandInfo(interp, script, parse.commandStart,
+/* TODO: Make this more sensible, f. ex. [eval {foo \$x(}] */
 		    /* Drop the command terminator (";","]") if appropriate */
 		    (parse.term ==
 		    parse.commandStart + parse.commandSize - 1)?
 		    parse.commandSize - 1 : parse.commandSize);
 	    TclCompileSyntaxError(interp, envPtr);
 	    Tcl_FreeParse(&parse);
-	    lastPop = -1;
-	    break;
+	    return;
 	}
 
-	/*
-	 * TIP #280: Count newlines before the command start.
-	 * (See test info-30.33).
-	 */
-
-	TclAdvanceLines(&cmdLine, p, parse.commandStart);
-	TclAdvanceContinuations(&cmdLine, &clNext,
-		parse.commandStart - envPtr->source);
-
 #ifdef TCL_COMPILE_DEBUG
 	/*
 	 * If tracing, print a line for each top level command compiled.
@@ -2114,48 +2100,51 @@ TclCompileScript(
 	}
 #endif
 
-    envPtr->line = cmdLine;
-    envPtr->clNext = clNext;
-	CompileCommandTokens(interp, &parse, envPtr, &lastPop);
-    cmdLine = envPtr->line;
-    clNext = envPtr->clNext;
+	/*
+	 * TIP #280: Count newlines before the command start.
+	 * (See test info-30.33).
+	 */
+
+	TclAdvanceLines(&envPtr->line, p, parse.commandStart);
+	TclAdvanceContinuations(&envPtr->line, &envPtr->clNext,
+		parse.commandStart - envPtr->source);
 
 	/*
-	 * Advance to the next command in the script.
+	 * Advance parser to the next command in the script.
 	 */
 
 	next = parse.commandStart + parse.commandSize;
 	numBytes -= next - p;
 	p = next;
 
+	if (parse.numWords == 0) {
+	    /* TODO: Document justification */
+	    continue;
+	}
+
+	lastCmdIdx = CompileCommandTokens(interp, &parse, envPtr);
+
 	/*
 	 * TIP #280: Track lines in the just compiled command.
 	 */
 
-	TclAdvanceLines(&cmdLine, parse.commandStart, p);
-	TclAdvanceContinuations(&cmdLine, &clNext, p - envPtr->source);
+	TclAdvanceLines(&envPtr->line, parse.commandStart, p);
+	TclAdvanceContinuations(&envPtr->line, &envPtr->clNext,
+		p - envPtr->source);
 	Tcl_FreeParse(&parse);
     }
 
     /*
-     * TIP #280: Bring the line counts in the CompEnv up to date.
-     *	See tests info-30.33,34,35 .
-     */
-
-    envPtr->line = cmdLine;
-    envPtr->clNext = clNext;
-
-    /*
      * If the source script yielded no instructions (e.g., if it was empty),
      * push an empty string as the command's result.
      */
 
-    if (envPtr->codeNext == entryCodeNext) {
-	PushStringLiteral(envPtr, "");
-    } else if (lastPop >= 0) {
-	envPtr->cmdMapPtr[lastPop].numCodeBytes--;
+    if (lastCmdIdx >= 0) {
+	envPtr->cmdMapPtr[lastCmdIdx].numCodeBytes--;
 	envPtr->codeNext--;
-	TclAdjustStackDepth(1, envPtr);
+	envPtr->currStackDepth++;
+    } else {
+	PushStringLiteral(envPtr, "");
     }
 #else
     int lastTopLevelCmdIndex = -1;
-- 
cgit v0.12


From 05fb0c0810d175e0affff7d4d7e507141aa0c5ff Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 28 Jun 2013 02:58:15 +0000
Subject: More elimination of error message litter to fix [Bug 20a81392ec].

---
 generic/tclCompCmdsSZ.c |  3 +++
 generic/tclCompile.c    |  8 --------
 generic/tclExecute.c    | 18 +++++++-----------
 3 files changed, 10 insertions(+), 19 deletions(-)

diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 855dd8f..026b214 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -748,6 +748,9 @@ TclSubstCompile(
     Tcl_InterpState state = NULL;
 
     TclSubstParse(interp, bytes, numBytes, flags, &parse, &state);
+    if (state != NULL) {
+	Tcl_ResetResult(interp);
+    }
 
     /*
      * Tricky point! If the first token does not result in a *guaranteed* push
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 5a8524c..1f72aa7 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -2058,14 +2058,6 @@ TclCompileScript(
      * from the script.
      */
 
-    /* TODO: Figure out when/why we need this */
-#if 0
-if (Tcl_GetStringResult(interp)[0] != '\0') {
-    fprintf(stdout, "INIT: '%s'\n", Tcl_GetStringResult(interp));
-    fflush(stdout);
-}
-#endif
-    Tcl_ResetResult(interp);
     while (numBytes > 0) {
 	Tcl_Parse parse;
 	const char *next;
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index d3a0d32..37bf072 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -1426,17 +1426,12 @@ Tcl_NRExprObj(
     Tcl_Obj *resultPtr)
 {
     ByteCode *codePtr;
+    Tcl_InterpState state = Tcl_SaveInterpState(interp, TCL_OK);
 
-    /* TODO: consider saving whole state? */
-    Tcl_Obj *saveObjPtr = Tcl_GetObjResult(interp);
-
-    Tcl_IncrRefCount(saveObjPtr);
-
+    Tcl_ResetResult(interp);
     codePtr = CompileExprObj(interp, objPtr);
 
-    /* TODO: Confirm reset not required? */
-    /*Tcl_ResetResult(interp);*/
-    Tcl_NRAddCallback(interp, ExprObjCallback, saveObjPtr, resultPtr,
+    Tcl_NRAddCallback(interp, ExprObjCallback, state, resultPtr,
 	    NULL, NULL);
     return TclNRExecuteByteCode(interp, codePtr);
 }
@@ -1447,14 +1442,15 @@ ExprObjCallback(
     Tcl_Interp *interp,
     int result)
 {
-    Tcl_Obj *saveObjPtr = data[0];
+    Tcl_InterpState state = data[0];
     Tcl_Obj *resultPtr = data[1];
 
     if (result == TCL_OK) {
 	TclSetDuplicateObj(resultPtr, Tcl_GetObjResult(interp));
-	Tcl_SetObjResult(interp, saveObjPtr);
+	(void) Tcl_RestoreInterpState(interp, state);
+    } else {
+	Tcl_DiscardInterpState(state);
     }
-    TclDecrRefCount(saveObjPtr);
     return result;
 }
 
-- 
cgit v0.12


From aec5846c12ee4a0dc9b655a8e127c567b248d29f Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 1 Jul 2013 20:58:15 +0000
Subject: More Work In Progress.

---
 generic/tclCompile.c | 55 ++++++++++++++++++++++++++++++++--------------------
 tests/misc.test      |  7 +------
 2 files changed, 35 insertions(+), 27 deletions(-)

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 1f72aa7..6f5ef50 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -16,6 +16,8 @@
 #include "tclCompile.h"
 #include <assert.h>
 
+#define REWRITE
+
 /*
  * Table of all AuxData types.
  */
@@ -562,8 +564,10 @@ static void		EnterCmdExtentData(CompileEnv *envPtr,
 			    int cmdNumber, int numSrcBytes, int numCodeBytes);
 static void		EnterCmdStartData(CompileEnv *envPtr,
 			    int cmdNumber, int srcOffset, int codeOffset);
+#ifndef REWRITE
 static Command *	FindCompiledCommandFromToken(Tcl_Interp *interp,
 			    Tcl_Token *tokenPtr);
+#endif
 static void		FreeByteCodeInternalRep(Tcl_Obj *objPtr);
 static void		FreeSubstCodeInternalRep(Tcl_Obj *objPtr);
 static int		GetCmdLocEncodingSize(CompileEnv *envPtr);
@@ -1671,6 +1675,7 @@ TclWordKnownAtCompileTime(
     return 1;
 }
 
+#ifndef REWRITE
 /*
  * ---------------------------------------------------------------------
  *
@@ -1718,6 +1723,7 @@ FindCompiledCommandFromToken(
     Tcl_DStringFree(&ds);
     return cmdPtr;
 }
+#endif
 
 /*
  *----------------------------------------------------------------------
@@ -1737,7 +1743,7 @@ FindCompiledCommandFromToken(
  *----------------------------------------------------------------------
  */
 
-#if 1
+#ifdef REWRITE
 static int
 CompileCommandTokens(
     Tcl_Interp *interp,
@@ -2045,18 +2051,18 @@ TclCompileScript(
 				 * first null character. */
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
-#if 1
-    int lastCmdIdx = -1;
-    const char *p = script;
+#ifdef REWRITE
+    int lastCmdIdx = -1;	/* Index into envPtr->cmdMapPtr of the last
+				 * command this routine compiles into bytecode.
+				 * Initial value of -1 indicates this routine
+				 * has not yet generated any bytecode. */
+    const char *p = script;	/* Where we are in our compile. */
 
     if (envPtr->iPtr == NULL) {
 	Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv");
     }
 
-    /*
-     * Each iteration through the following loop compiles the next command
-     * from the script.
-     */
+    /* Each iteration compiles one command from the script. */
 
     while (numBytes > 0) {
 	Tcl_Parse parse;
@@ -2068,11 +2074,7 @@ TclCompileScript(
 	     */
 
 	    Tcl_LogCommandInfo(interp, script, parse.commandStart,
-/* TODO: Make this more sensible, f. ex. [eval {foo \$x(}] */
-		    /* Drop the command terminator (";","]") if appropriate */
-		    (parse.term ==
-		    parse.commandStart + parse.commandSize - 1)?
-		    parse.commandSize - 1 : parse.commandSize);
+		    parse.term + 1 - parse.commandStart);
 	    TclCompileSyntaxError(interp, envPtr);
 	    Tcl_FreeParse(&parse);
 	    return;
@@ -2126,17 +2128,28 @@ TclCompileScript(
 	Tcl_FreeParse(&parse);
     }
 
-    /*
-     * If the source script yielded no instructions (e.g., if it was empty),
-     * push an empty string as the command's result.
-     */
-
-    if (lastCmdIdx >= 0) {
+    if (lastCmdIdx == -1) {
+	/*
+	 * Compiling the script yielded no bytecode.  The script must be
+	 * all whitespace, comments, and empty commands.  Such scripts
+	 * are defined to successfully produce the empty string result,
+	 * so we emit the simple bytecode that makes that happen.
+	 */
+	PushStringLiteral(envPtr, "");
+    } else {
+	/*
+	 * We compiled at least one command to bytecode.  The routine
+	 * CompileCommandTokens() follows the bytecode of each compiled
+	 * command with an INST_POP, so that stack balance is maintained
+	 * when several commands are in sequence.  (The result of each
+	 * command is thrown away before moving on to the next command).
+	 * For the last command compiled, we need to undo that INST_POP
+	 * so that the result of the last command becomes the result of
+	 * the script.  These code here removes that trailing INST_POP.
+	 */
 	envPtr->cmdMapPtr[lastCmdIdx].numCodeBytes--;
 	envPtr->codeNext--;
 	envPtr->currStackDepth++;
-    } else {
-	PushStringLiteral(envPtr, "");
     }
 #else
     int lastTopLevelCmdIndex = -1;
diff --git a/tests/misc.test b/tests/misc.test
index 6ddc718..d4ece74 100644
--- a/tests/misc.test
+++ b/tests/misc.test
@@ -59,12 +59,7 @@ test misc-1.2 {error in variable ref. in command in array reference} {
 missing close-brace for variable name
 missing close-brace for variable name
     while executing
-"set tst $a([winfo name $\{zz)
-	# this is a bogus comment
-	# this is a bogus comment
-	# this is a bogus comment
-	# this is a bogus comment
-	# this is a ..."
+"set tst $a([winfo name $\{"
     (procedure "tstProc" line 4)
     invoked from within
 "tstProc"}]
-- 
cgit v0.12


From 88731d9d93913d8f5ce27cd5153be02c84e5eb7a Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 2 Jul 2013 10:36:32 +0000
Subject: comment improvements

---
 generic/tclCompile.c | 22 ++++++++++++++++++++--
 1 file changed, 20 insertions(+), 2 deletions(-)

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 6f5ef50..05daabf 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1764,6 +1764,7 @@ CompileCommandTokens(
 
     assert (numWords > 0);
  
+    /* Determine whether any words of the command require expansion */
     for (wordIdx = 0; wordIdx < numWords;
 	    wordIdx++, tokenPtr += tokenPtr->numComponents + 1) {
 	if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
@@ -1772,6 +1773,7 @@ CompileCommandTokens(
 	}
     }
 
+    /* Do we know the command  word? */
     Tcl_IncrRefCount(cmdObj);
     tokenPtr = parsePtr->tokenPtr;
     cmdKnown = TclWordKnownAtCompileTime(tokenPtr, cmdObj);
@@ -1791,6 +1793,7 @@ CompileCommandTokens(
 	    }
 	}
     }
+    /* If cmdPtr != NULL, we will try to call cmdPtr->compileProc */
 
     /* Pre-Compile */
 
@@ -2112,7 +2115,22 @@ TclCompileScript(
 	p = next;
 
 	if (parse.numWords == 0) {
-	    /* TODO: Document justification */
+	    /*
+	     * The "command" parsed has no words.  In this case
+	     * we can skip the rest of the loop body.  With no words,
+	     * clearly CompileCommandTokens() has nothing to do.  Since
+	     * the parser aggressively sucks up leading comment and white
+	     * space, including newlines, parse.commandStart must be 
+	     * pointing at either the end of script, or a command-terminating
+	     * semi-colon.  In either case, the TclAdvance*() calls have
+	     * nothing to do.  Finally, when no words are parsed, no
+	     * tokens have been allocated at parse.tokenPtr so there's
+	     * also nothing for Tcl_FreeParse() to do.
+	     *
+	     * The advantage of this shortcut is that CompileCommandTokens()
+	     * can be written with an assumption that parse.numWords > 0,
+	     * with the implication the CCT() always generates bytecode.
+	     */
 	    continue;
 	}
 
@@ -2145,7 +2163,7 @@ TclCompileScript(
 	 * command is thrown away before moving on to the next command).
 	 * For the last command compiled, we need to undo that INST_POP
 	 * so that the result of the last command becomes the result of
-	 * the script.  These code here removes that trailing INST_POP.
+	 * the script.  The code here removes that trailing INST_POP.
 	 */
 	envPtr->cmdMapPtr[lastCmdIdx].numCodeBytes--;
 	envPtr->codeNext--;
-- 
cgit v0.12


From de31df63e799b702d1ebfe1ac588b4d2efa3e6cd Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 8 Jul 2013 06:49:44 +0000
Subject: Build stub objects with -DSTATIC_BUILD on all platforms. Only
 important on win32 (already done) and cygwin, on other platforms it should
 not have any effect.

---
 unix/Makefile.in | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/unix/Makefile.in b/unix/Makefile.in
index 34c7165..f6c4424 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -1529,7 +1529,7 @@ waitpid.o: $(COMPAT_DIR)/waitpid.c
 # even though they will be placed in a static archive
 
 tclStubLib.o: $(GENERIC_DIR)/tclStubLib.c
-	$(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tclStubLib.c
+	$(CC) -c $(STUB_CC_SWITCHES) -DSTATIC_BUILD $(GENERIC_DIR)/tclStubLib.c
 
 .c.o:
 	$(CC) -c $(CC_SWITCHES) $<
-- 
cgit v0.12


From d2b490f552aaf53f2f3d66b630c40a5db14157d1 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 8 Jul 2013 14:31:14 +0000
Subject: The routines StartExpanding() and EnterCmdWordData() are orthogonal,
 so it's ok to reverse the order in which they are called.

---
 generic/tclCompile.c | 7 +++----
 1 file changed, 3 insertions(+), 4 deletions(-)

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 5aab69c..0dc30e2 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1802,10 +1802,6 @@ CompileCommandTokens(
     EnterCmdStartData(envPtr, cmdIdx,
 	    parsePtr->commandStart - envPtr->source, startCodeOffset);
 
-    if (expand && !cmdPtr) {
-	StartExpanding(envPtr);
-    }
-
     /*
      * TIP #280. Scan the words and compute the extended location
      * information. The map first contain full per-word line
@@ -1823,6 +1819,9 @@ CompileCommandTokens(
     envPtr->line = eclPtr->loc[wlineat].line[0];
     envPtr->clNext = eclPtr->loc[wlineat].next[0];
 
+    if (expand && !cmdPtr) {
+	StartExpanding(envPtr);
+    }
     if (cmdPtr) {
 	int savedNumCmds = envPtr->numCommands;
 	int update = 0;
-- 
cgit v0.12


From 0dec640514ea686e9617b9813107057e7972300d Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 8 Jul 2013 15:00:02 +0000
Subject: Consolidate the StartExpanding() calls.

---
 generic/tclCompile.c | 10 +++-------
 1 file changed, 3 insertions(+), 7 deletions(-)

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 0dc30e2..cbb93d9 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1819,9 +1819,6 @@ CompileCommandTokens(
     envPtr->line = eclPtr->loc[wlineat].line[0];
     envPtr->clNext = eclPtr->loc[wlineat].next[0];
 
-    if (expand && !cmdPtr) {
-	StartExpanding(envPtr);
-    }
     if (cmdPtr) {
 	int savedNumCmds = envPtr->numCommands;
 	int update = 0;
@@ -1919,11 +1916,10 @@ CompileCommandTokens(
 
 	envPtr->line = eclPtr->loc[wlineat].line[0];
 	envPtr->clNext = eclPtr->loc[wlineat].next[0];
+    }
 
-	/* TODO: Can this happen?  If so, is this right? */
-	if (expand) {
-	    StartExpanding(envPtr);
-	}
+    if (expand) {
+	StartExpanding(envPtr);
     }
 
     /*
-- 
cgit v0.12


From da4296c06f86f3d4ff58fb77959049d42698d52a Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 8 Jul 2013 15:24:56 +0000
Subject: Defer expansion request detection as much as possible.

---
 generic/tclCompile.c | 43 ++++++++++++++++++++++++++++++-------------
 1 file changed, 30 insertions(+), 13 deletions(-)

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index cbb93d9..052dc8e 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1744,6 +1744,22 @@ FindCompiledCommandFromToken(
  */
 
 #ifdef REWRITE
+
+static int
+ExpandRequested(
+    Tcl_Token *tokenPtr,
+    int numWords)
+{
+    /* Determine whether any words of the command require expansion */
+    while (numWords--) {
+	if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
+	    return 1;
+	}
+	tokenPtr += tokenPtr->numComponents + 1;
+    }
+    return 0;
+}
+
 static int
 CompileCommandTokens(
     Tcl_Interp *interp,
@@ -1755,7 +1771,7 @@ CompileCommandTokens(
     ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
     Tcl_Obj *cmdObj = Tcl_NewObj();
     Command *cmdPtr = NULL;
-    int wordIdx, cmdKnown, expand = 0, numWords = parsePtr->numWords;
+    int wordIdx, cmdKnown, expand = -1, numWords = parsePtr->numWords;
     int *wlines, wlineat;
     int cmdLine = envPtr->line;
     int *clNext = envPtr->clNext;
@@ -1763,15 +1779,6 @@ CompileCommandTokens(
     int startCodeOffset = envPtr->codeNext - envPtr->codeStart;
 
     assert (numWords > 0);
- 
-    /* Determine whether any words of the command require expansion */
-    for (wordIdx = 0; wordIdx < numWords;
-	    wordIdx++, tokenPtr += tokenPtr->numComponents + 1) {
-	if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
-	    expand = 1;
-	    break;
-	}
-    }
 
     /* Do we know the command word? */
     Tcl_IncrRefCount(cmdObj);
@@ -1783,13 +1790,19 @@ CompileCommandTokens(
 	cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj);
 	if (cmdPtr) {
 	    /*
-	     * Found a command.  Test all the ways we can be told
+	     * Found a command.  Test the ways we can be told
 	     * not to attempt to compile it.
 	     */
 	    if ((cmdPtr->compileProc == NULL)
 		    || (cmdPtr->nsPtr->flags & NS_SUPPRESS_COMPILATION)
-		    || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)
-		    || (expand && !(cmdPtr->flags & CMD_COMPILES_EXPANDED))) {
+		    || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {
+		cmdPtr = NULL;
+	    }
+	}
+	if (cmdPtr && !(cmdPtr->flags & CMD_COMPILES_EXPANDED)) {
+	    expand = ExpandRequested(parsePtr->tokenPtr, parsePtr->numWords);
+	    if (expand) {
+		/* We need to expand, but compileProc cannot. */
 		cmdPtr = NULL;
 	    }
 	}
@@ -1918,6 +1931,10 @@ CompileCommandTokens(
 	envPtr->clNext = eclPtr->loc[wlineat].next[0];
     }
 
+    if (expand < 0) {
+	expand = ExpandRequested(parsePtr->tokenPtr, parsePtr->numWords);
+    }
+
     if (expand) {
 	StartExpanding(envPtr);
     }
-- 
cgit v0.12


From 582824087ddfbdc099f0f7d8a8f0dc6a858de7d3 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 8 Jul 2013 15:39:55 +0000
Subject: Move TIP 280 and command extent housekeeping to the periphery.

---
 generic/tclCompile.c | 54 ++++++++++++++++++++++++++--------------------------
 1 file changed, 27 insertions(+), 27 deletions(-)

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 052dc8e..388b8a0 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1780,6 +1780,29 @@ CompileCommandTokens(
 
     assert (numWords > 0);
 
+    /* Pre-Compile */
+
+    envPtr->numCommands++;
+    EnterCmdStartData(envPtr, cmdIdx,
+	    parsePtr->commandStart - envPtr->source, startCodeOffset);
+
+    /*
+     * 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'.
+     */
+
+    EnterCmdWordData(eclPtr, parsePtr->commandStart - envPtr->source,
+	    parsePtr->tokenPtr, parsePtr->commandStart,
+	    parsePtr->commandSize, parsePtr->numWords, cmdLine,
+	    clNext, &wlines, envPtr);
+    wlineat = eclPtr->nuloc - 1;
+
+    envPtr->line = eclPtr->loc[wlineat].line[0];
+    envPtr->clNext = eclPtr->loc[wlineat].next[0];
+
     /* Do we know the command word? */
     Tcl_IncrRefCount(cmdObj);
     tokenPtr = parsePtr->tokenPtr;
@@ -1809,29 +1832,6 @@ CompileCommandTokens(
     }
     /* If cmdPtr != NULL, we will try to call cmdPtr->compileProc */
 
-    /* Pre-Compile */
-
-    envPtr->numCommands++;
-    EnterCmdStartData(envPtr, cmdIdx,
-	    parsePtr->commandStart - envPtr->source, startCodeOffset);
-
-    /*
-     * 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'.
-     */
-
-    EnterCmdWordData(eclPtr, parsePtr->commandStart - envPtr->source,
-	    parsePtr->tokenPtr, parsePtr->commandStart,
-	    parsePtr->commandSize, parsePtr->numWords, cmdLine,
-	    clNext, &wlines, envPtr);
-    wlineat = eclPtr->nuloc - 1;
-
-    envPtr->line = eclPtr->loc[wlineat].line[0];
-    envPtr->clNext = eclPtr->loc[wlineat].next[0];
-
     if (cmdPtr) {
 	int savedNumCmds = envPtr->numCommands;
 	int update = 0;
@@ -2031,15 +2031,15 @@ CompileCommandTokens(
     }
 
 finishCommand:
+    if (cmdKnown) {
+	Tcl_DecrRefCount(cmdObj);
+    }
+
     TclEmitOpcode(INST_POP, envPtr);
     EnterCmdExtentData(envPtr, cmdIdx,
 	    parsePtr->term - parsePtr->commandStart,
 	    (envPtr->codeNext-envPtr->codeStart) - startCodeOffset);
 
-    if (cmdKnown) {
-	Tcl_DecrRefCount(cmdObj);
-    }
-
     /*
      * TIP #280: Free full form of per-word line data and insert the
      * reduced form now
-- 
cgit v0.12


From c10c796a466cd52d2fd3d2999801eb66a575388d Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 8 Jul 2013 18:08:01 +0000
Subject: Plug memory leak;  Break three compilation mechanisms into routines.

---
 generic/tclCompile.c | 462 +++++++++++++++++++++++++++++----------------------
 1 file changed, 266 insertions(+), 196 deletions(-)

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 388b8a0..1958d47 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1760,6 +1760,255 @@ ExpandRequested(
     return 0;
 }
 
+static void
+CompileInvocation(
+    Tcl_Interp *interp,
+    Tcl_Token *tokenPtr,
+    Tcl_Obj *cmdObj,
+    int numWords,
+    int wlineat,
+    CompileEnv *envPtr)
+{
+    int isnew, wordIdx = 0;
+    ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
+
+    if (cmdObj) {
+	int numBytes;
+	const char *bytes = Tcl_GetStringFromObj(cmdObj, &numBytes);
+	int cmdLitIdx = TclRegisterNewCmdLiteral(envPtr, bytes, numBytes);
+	Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj);
+
+	if (cmdPtr) {
+	    TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLitIdx),
+		    cmdPtr);
+	}
+	TclEmitPush(cmdLitIdx, envPtr);
+
+	wordIdx = 1;
+	tokenPtr += tokenPtr->numComponents + 1;
+    }
+
+    for (; wordIdx < numWords;
+	    wordIdx++, tokenPtr += tokenPtr->numComponents + 1) {
+	int objIdx;
+
+	envPtr->line = eclPtr->loc[wlineat].line[wordIdx];
+	envPtr->clNext = eclPtr->loc[wlineat].next[wordIdx];
+
+	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	    CompileTokens(envPtr, tokenPtr, interp);
+	    continue;
+	}
+
+	objIdx = TclRegisterNewLiteral(envPtr,
+		tokenPtr[1].start, tokenPtr[1].size);
+	if (envPtr->clNext) {
+	    TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx),
+		    tokenPtr[1].start - envPtr->source,
+		    eclPtr->loc[wlineat].next[wordIdx]);
+	}
+	TclEmitPush(objIdx, envPtr);
+    }
+
+    /*
+     * Save PC -> command map for the TclArgumentBC* functions.
+     */
+
+    Tcl_SetHashValue(Tcl_CreateHashEntry(&eclPtr->litInfo,
+	    INT2PTR(envPtr->codeNext - envPtr->codeStart), &isnew),
+	    INT2PTR(wlineat));
+
+    if (wordIdx <= 255) {
+	TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr);
+    } else {
+	TclEmitInstInt4(INST_INVOKE_STK4, wordIdx, envPtr);
+    }
+}
+
+static void
+CompileExpanded(
+    Tcl_Interp *interp,
+    Tcl_Token *tokenPtr,
+    Tcl_Obj *cmdObj,
+    int numWords,
+    int wlineat,
+    CompileEnv *envPtr)
+{
+    int wordIdx = 0;
+    ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
+
+    StartExpanding(envPtr);
+    if (cmdObj) {
+	int numBytes;
+	const char *bytes = Tcl_GetStringFromObj(cmdObj, &numBytes);
+	int cmdLitIdx = TclRegisterNewCmdLiteral(envPtr, bytes, numBytes);
+	Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj);
+
+	if (cmdPtr) {
+	    TclSetCmdNameObj(interp,
+		    TclFetchLiteral(envPtr, cmdLitIdx), cmdPtr);
+	}
+	TclEmitPush(cmdLitIdx, envPtr);
+
+	wordIdx = 1;
+	tokenPtr += tokenPtr->numComponents + 1;
+    }
+
+    for (; wordIdx < numWords;
+	    wordIdx++, tokenPtr += tokenPtr->numComponents + 1) {
+	int objIdx;
+
+	envPtr->line = eclPtr->loc[wlineat].line[wordIdx];
+	envPtr->clNext = eclPtr->loc[wlineat].next[wordIdx];
+
+	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	    CompileTokens(envPtr, tokenPtr, interp);
+	    if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
+		TclEmitInstInt4(INST_EXPAND_STKTOP,
+			envPtr->currStackDepth, envPtr);
+	    }
+	    continue;
+	}
+
+	objIdx = TclRegisterNewLiteral(envPtr,
+		tokenPtr[1].start, tokenPtr[1].size);
+	if (envPtr->clNext) {
+	    TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx),
+		    tokenPtr[1].start - envPtr->source,
+		    eclPtr->loc[wlineat].next[wordIdx]);
+	}
+	TclEmitPush(objIdx, envPtr);
+    }
+
+    /*
+     * The stack depth during argument expansion can only be
+     * managed at runtime, as the number of elements in the
+     * expanded lists is not known at compile time. We adjust here
+     * the stack depth estimate so that it is correct after the
+     * command with expanded arguments returns.
+     *
+     * The end effect of this command's invocation is that all the
+     * words of the command are popped from the stack, and the
+     * result is pushed: the stack top changes by (1-wordIdx).
+     *
+     * Note that the estimates are not correct while the command
+     * is being prepared and run, INST_EXPAND_STKTOP is not
+     * stack-neutral in general.
+     */
+
+    TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr);
+    envPtr->expandCount--;
+    TclAdjustStackDepth(1 - wordIdx, envPtr);
+}
+
+static int 
+CompileCmdCompileProc(
+    Tcl_Interp *interp,
+    Tcl_Parse *parsePtr,
+    Command *cmdPtr,
+    int startCodeOffset,
+    CompileEnv *envPtr)
+{
+    ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
+    int savedNumCmds = envPtr->numCommands;
+    int startStackDepth = envPtr->currStackDepth;
+    int wlineat = eclPtr->nuloc - 1;
+    int update = 0;
+
+    /*
+     * Mark the start of the command; the proper bytecode
+     * length will be updated later. There is no need to
+     * do this for the first bytecode in the compile env,
+     * as the check is done before calling
+     * TclNRExecuteByteCode(). Do emit an INST_START_CMD
+     * in special cases where the first bytecode is in a
+     * loop, to insure that the corresponding command is
+     * counted properly. Compilers for commands able to
+     * produce such a beast (currently 'while 1' only) set
+     * envPtr->atCmdStart to 0 in order to signal this
+     * case. [Bug 1752146]
+     *
+     * Note that the environment is initialised with
+     * atCmdStart=1 to avoid emitting ISC for the first
+     * command.
+     */
+
+    if (envPtr->atCmdStart == 1) {
+	if (startCodeOffset) {
+	    /*
+	     * Increase the number of commands being
+	     * started at the current point. Note that
+	     * this depends on the exact layout of the
+	     * INST_START_CMD's operands, so be careful!
+	     */
+
+	    TclIncrUInt4AtPtr(envPtr->codeNext - 4, 1)
+	}
+    } else if (envPtr->atCmdStart == 0) {
+	TclEmitInstInt4(INST_START_CMD, 0, envPtr);
+	TclEmitInt4(1, envPtr);
+	update = 1;
+    }
+
+    if (TCL_OK == cmdPtr->compileProc(interp, parsePtr, cmdPtr, envPtr)) {
+
+#ifdef TCL_COMPILE_DEBUG
+	/*
+	 * Confirm that the command compiler generated a
+	 * single value on the stack as its result. This
+	 * is only done in debugging mode, as it *should*
+	 * be correct and normal users have no reasonable
+	 * way to fix it anyway.
+	 */
+
+	int diff = envPtr->currStackDepth - startStackDepth;
+
+	if (diff != 1) {
+	    Tcl_Panic("bad stack adjustment when compiling"
+		    " %.*s (was %d instead of 1)", parsePtr->tokenPtr->size,
+		    parsePtr->tokenPtr->start, diff);
+	}
+#endif
+	if (update) {
+	    /*
+	     * Fix the bytecode length.
+	     */
+
+	    unsigned char *fixPtr = envPtr->codeStart + startCodeOffset + 1;
+	    unsigned fixLen = envPtr->codeNext - fixPtr + 1;
+
+	    TclStoreInt4AtPtr(fixLen, fixPtr);
+	}
+	return TCL_OK;
+    }
+
+    if (envPtr->atCmdStart == 1 && startCodeOffset != 0) {
+	/*
+	 * Decrease the number of commands being started
+	 * at the current point. Note that this depends on
+	 * the exact layout of the INST_START_CMD's
+	 * operands, so be careful!
+	 */
+
+	TclIncrUInt4AtPtr(envPtr->codeNext - 4, -1);
+    }
+
+    /*
+     * Restore numCommands, codeNext, and currStackDepth  to their
+     * correct values, removing any commands compiled before the
+     * failure to produce bytecode got reported.
+     * [Bugs 705406, 735055, 3614102]
+     */
+
+    envPtr->numCommands = savedNumCmds;
+    envPtr->codeNext = envPtr->codeStart + startCodeOffset;
+    envPtr->currStackDepth = startStackDepth;
+
+    envPtr->line = eclPtr->loc[wlineat].line[0];
+    envPtr->clNext = eclPtr->loc[wlineat].next[0];
+    return TCL_ERROR;
+}
+
 static int
 CompileCommandTokens(
     Tcl_Interp *interp,
@@ -1771,14 +2020,15 @@ CompileCommandTokens(
     ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
     Tcl_Obj *cmdObj = Tcl_NewObj();
     Command *cmdPtr = NULL;
-    int wordIdx, cmdKnown, expand = -1, numWords = parsePtr->numWords;
+    int code = TCL_ERROR;
+    int cmdKnown, expand = -1;
     int *wlines, wlineat;
     int cmdLine = envPtr->line;
     int *clNext = envPtr->clNext;
     int cmdIdx = envPtr->numCommands;
     int startCodeOffset = envPtr->codeNext - envPtr->codeStart;
 
-    assert (numWords > 0);
+    assert (parsePtr->numWords > 0);
 
     /* Pre-Compile */
 
@@ -1830,210 +2080,30 @@ CompileCommandTokens(
 	    }
 	}
     }
-    /* If cmdPtr != NULL, we will try to call cmdPtr->compileProc */
 
+    /* If cmdPtr != NULL, we will try to call cmdPtr->compileProc */
     if (cmdPtr) {
-	int savedNumCmds = envPtr->numCommands;
-	int update = 0;
-	int startStackDepth = envPtr->currStackDepth;
-
-	/*
-	 * Mark the start of the command; the proper bytecode
-	 * length will be updated later. There is no need to
-	 * do this for the first bytecode in the compile env,
-	 * as the check is done before calling
-	 * TclNRExecuteByteCode(). Do emit an INST_START_CMD
-	 * in special cases where the first bytecode is in a
-	 * loop, to insure that the corresponding command is
-	 * counted properly. Compilers for commands able to
-	 * produce such a beast (currently 'while 1' only) set
-	 * envPtr->atCmdStart to 0 in order to signal this
-	 * case. [Bug 1752146]
-	 *
-	 * Note that the environment is initialised with
-	 * atCmdStart=1 to avoid emitting ISC for the first
-	 * command.
-	 */
-
-	if (envPtr->atCmdStart == 1) {
-	    if (startCodeOffset) {
-		/*
-		 * Increase the number of commands being
-		 * started at the current point. Note that
-		 * this depends on the exact layout of the
-		 * INST_START_CMD's operands, so be careful!
-		 */
-
-		TclIncrUInt4AtPtr(envPtr->codeNext - 4, 1)
-	    }
-	} else if (envPtr->atCmdStart == 0) {
-	    TclEmitInstInt4(INST_START_CMD, 0, envPtr);
-	    TclEmitInt4(1, envPtr);
-	    update = 1;
-	}
-
-	if (TCL_OK == cmdPtr->compileProc(interp, parsePtr, cmdPtr, envPtr)) {
-
-#ifdef TCL_COMPILE_DEBUG
-	    /*
-	     * Confirm that the command compiler generated a
-	     * single value on the stack as its result. This
-	     * is only done in debugging mode, as it *should*
-	     * be correct and normal users have no reasonable
-	     * way to fix it anyway.
-	     */
-
-	    int diff = envPtr->currStackDepth - startStackDepth;
-
-	    if (diff != 1) {
-		Tcl_Panic("bad stack adjustment when compiling"
-			" %.*s (was %d instead of 1)",
-			parsePtr->tokenPtr->size,
-			parsePtr->tokenPtr->start, diff);
-	    }
-#endif
-	    if (update) {
-		/*
-		 * Fix the bytecode length.
-		 */
-
-		unsigned char *fixPtr = envPtr->codeStart + startCodeOffset + 1;
-		unsigned fixLen = envPtr->codeNext - fixPtr + 1;
-
-		TclStoreInt4AtPtr(fixLen, fixPtr);
-	    }
-	    goto finishCommand;
-	}
-
-	if (envPtr->atCmdStart == 1 && startCodeOffset != 0) {
-	    /*
-	     * Decrease the number of commands being started
-	     * at the current point. Note that this depends on
-	     * the exact layout of the INST_START_CMD's
-	     * operands, so be careful!
-	     */
-
-	    TclIncrUInt4AtPtr(envPtr->codeNext - 4, -1);
-	}
-
-	/*
-	 * Restore numCommands, codeNext, and currStackDepth  to their
-	 * correct values, removing any commands compiled before the
-	 * failure to produce bytecode got reported.
-	 * [Bugs 705406, 735055, 3614102]
-	 */
-
-	envPtr->numCommands = savedNumCmds;
-	envPtr->codeNext = envPtr->codeStart + startCodeOffset;
-	envPtr->currStackDepth = startStackDepth;
-
-	envPtr->line = eclPtr->loc[wlineat].line[0];
-	envPtr->clNext = eclPtr->loc[wlineat].next[0];
-    }
-
-    if (expand < 0) {
-	expand = ExpandRequested(parsePtr->tokenPtr, parsePtr->numWords);
-    }
-
-    if (expand) {
-	StartExpanding(envPtr);
-    }
-
-    /*
-     * No complile attempted, or it failed.
-     * Need to emit instructions to invoke, with expansion if needed.
-     */
-
-    wordIdx = 0;
-    tokenPtr = parsePtr->tokenPtr;
-    if (cmdKnown) {
-	int cmdLitIdx, numBytes;
-	const char *bytes = Tcl_GetStringFromObj(cmdObj, &numBytes);
-
-	cmdLitIdx = TclRegisterNewCmdLiteral(envPtr, bytes, numBytes);
-	cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj);
-	if (cmdPtr) {
-	    TclSetCmdNameObj(interp,
-		    TclFetchLiteral(envPtr, cmdLitIdx), cmdPtr);
-	}
-	TclEmitPush(cmdLitIdx, envPtr);
-
-	wordIdx = 1;
-	tokenPtr += tokenPtr->numComponents + 1;
+	code = CompileCmdCompileProc(interp, parsePtr, cmdPtr,
+		startCodeOffset, envPtr);
     }
 
-    for (; wordIdx < numWords;
-	    wordIdx++, tokenPtr += tokenPtr->numComponents + 1) {
-	int objIdx;
-
-	envPtr->line = eclPtr->loc[wlineat].line[wordIdx];
-	envPtr->clNext = eclPtr->loc[wlineat].next[wordIdx];
-
-	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	    CompileTokens(envPtr, tokenPtr, interp);
-	    if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
-		TclEmitInstInt4(INST_EXPAND_STKTOP,
-			envPtr->currStackDepth, envPtr);
-	    }
-	    continue;
-	}
-
-	objIdx = TclRegisterNewLiteral(envPtr,
-		tokenPtr[1].start, tokenPtr[1].size);
-	if (envPtr->clNext) {
-	    TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx),
-		    tokenPtr[1].start - envPtr->source,
-		    eclPtr->loc[wlineat].next[wordIdx]);
+    if (code == TCL_ERROR) {
+	if (expand < 0) {
+	    expand = ExpandRequested(parsePtr->tokenPtr, parsePtr->numWords);
 	}
-	TclEmitPush(objIdx, envPtr);
-    }
-
-    /*
-     * Emit an invoke instruction for the command. We skip this if a
-     * compile procedure was found for the command.
-     */
 
-    if (expand) {
-	/*
-	 * The stack depth during argument expansion can only be
-	 * managed at runtime, as the number of elements in the
-	 * expanded lists is not known at compile time. We adjust here
-	 * the stack depth estimate so that it is correct after the
-	 * command with expanded arguments returns.
-	 *
-	 * The end effect of this command's invocation is that all the
-	 * words of the command are popped from the stack, and the
-	 * result is pushed: the stack top changes by (1-wordIdx).
-	 *
-	 * Note that the estimates are not correct while the command
-	 * is being prepared and run, INST_EXPAND_STKTOP is not
-	 * stack-neutral in general.
-	 */
-
-	TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr);
-	envPtr->expandCount--;
-	TclAdjustStackDepth(1 - wordIdx, envPtr);
-    } else {
-	/*
-	 * Save PC -> command map for the TclArgumentBC* functions.
-	 */
-
-	int isnew;
-	Tcl_HashEntry *hePtr = Tcl_CreateHashEntry(&eclPtr->litInfo,
-		INT2PTR(envPtr->codeNext - envPtr->codeStart), &isnew);
-
-	Tcl_SetHashValue(hePtr, INT2PTR(wlineat));
-	if (wordIdx <= 255) {
-	    TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr);
+	if (expand) {
+	    CompileExpanded(interp, parsePtr->tokenPtr,
+		    cmdKnown ? cmdObj : NULL, parsePtr->numWords, wlineat,
+		    envPtr);
 	} else {
-	    TclEmitInstInt4(INST_INVOKE_STK4, wordIdx, envPtr);
+	    CompileInvocation(interp, parsePtr->tokenPtr,
+		    cmdKnown ? cmdObj : NULL, parsePtr->numWords, wlineat,
+		    envPtr);
 	}
     }
 
-finishCommand:
-    if (cmdKnown) {
-	Tcl_DecrRefCount(cmdObj);
-    }
+    Tcl_DecrRefCount(cmdObj);
 
     TclEmitOpcode(INST_POP, envPtr);
     EnterCmdExtentData(envPtr, cmdIdx,
-- 
cgit v0.12


From b7fbf3c4330d9ae89e9884f07cb897729e122045 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 8 Jul 2013 18:55:23 +0000
Subject: Unbreak MSVC6 debug build (thanks Andreas Kupries!)

---
 generic/tclUtf.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/generic/tclUtf.c b/generic/tclUtf.c
index a122685..a038f8a 100644
--- a/generic/tclUtf.c
+++ b/generic/tclUtf.c
@@ -1554,7 +1554,7 @@ Tcl_UniCharIsSpace(
      */
 
     if (((Tcl_UniChar) ch) < ((Tcl_UniChar) 0x80)) {
-	return TclIsSpaceProc(ch);
+	return TclIsSpaceProc((char) ch);
     } else if ((Tcl_UniChar) ch == 0x180e) {
 	return 1;
     } else {
-- 
cgit v0.12


From e10479f3d739f650bd4b5a041b973f66796f4e4b Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 8 Jul 2013 19:29:01 +0000
Subject: Factor out compiling the Command literal.

---
 generic/tclCompile.c | 41 +++++++++++++++++++----------------------
 1 file changed, 19 insertions(+), 22 deletions(-)

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 1958d47..a1ad5c8 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1761,6 +1761,23 @@ ExpandRequested(
 }
 
 static void
+CompileCmdLiteral(
+    Tcl_Interp *interp,
+    Tcl_Obj *cmdObj,
+    CompileEnv *envPtr)
+{
+    int numBytes;
+    const char *bytes = Tcl_GetStringFromObj(cmdObj, &numBytes);
+    int cmdLitIdx = TclRegisterNewCmdLiteral(envPtr, bytes, numBytes);
+    Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj);
+
+    if (cmdPtr) {
+	TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLitIdx), cmdPtr);
+    }
+    TclEmitPush(cmdLitIdx, envPtr);
+}
+
+static void
 CompileInvocation(
     Tcl_Interp *interp,
     Tcl_Token *tokenPtr,
@@ -1773,17 +1790,7 @@ CompileInvocation(
     ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
 
     if (cmdObj) {
-	int numBytes;
-	const char *bytes = Tcl_GetStringFromObj(cmdObj, &numBytes);
-	int cmdLitIdx = TclRegisterNewCmdLiteral(envPtr, bytes, numBytes);
-	Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj);
-
-	if (cmdPtr) {
-	    TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLitIdx),
-		    cmdPtr);
-	}
-	TclEmitPush(cmdLitIdx, envPtr);
-
+	CompileCmdLiteral(interp, cmdObj, envPtr);
 	wordIdx = 1;
 	tokenPtr += tokenPtr->numComponents + 1;
     }
@@ -1839,17 +1846,7 @@ CompileExpanded(
 
     StartExpanding(envPtr);
     if (cmdObj) {
-	int numBytes;
-	const char *bytes = Tcl_GetStringFromObj(cmdObj, &numBytes);
-	int cmdLitIdx = TclRegisterNewCmdLiteral(envPtr, bytes, numBytes);
-	Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj);
-
-	if (cmdPtr) {
-	    TclSetCmdNameObj(interp,
-		    TclFetchLiteral(envPtr, cmdLitIdx), cmdPtr);
-	}
-	TclEmitPush(cmdLitIdx, envPtr);
-
+	CompileCmdLiteral(interp, cmdObj, envPtr);
 	wordIdx = 1;
 	tokenPtr += tokenPtr->numComponents + 1;
     }
-- 
cgit v0.12


From ba3bf9b61fa445633a8699982aa8ef38bdd75e80 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 8 Jul 2013 22:36:55 +0000
Subject: Use TIP 280 macros.

---
 generic/tclCompile.c | 6 ++----
 1 file changed, 2 insertions(+), 4 deletions(-)

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index a1ad5c8..656f700 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1906,11 +1906,10 @@ CompileCmdCompileProc(
     int startCodeOffset,
     CompileEnv *envPtr)
 {
-    ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
     int savedNumCmds = envPtr->numCommands;
     int startStackDepth = envPtr->currStackDepth;
-    int wlineat = eclPtr->nuloc - 1;
     int update = 0;
+    DefineLineInformation;
 
     /*
      * Mark the start of the command; the proper bytecode
@@ -2001,8 +2000,7 @@ CompileCmdCompileProc(
     envPtr->codeNext = envPtr->codeStart + startCodeOffset;
     envPtr->currStackDepth = startStackDepth;
 
-    envPtr->line = eclPtr->loc[wlineat].line[0];
-    envPtr->clNext = eclPtr->loc[wlineat].next[0];
+    SetLineInformation(0);
     return TCL_ERROR;
 }
 
-- 
cgit v0.12


From c46c7741267cbbe91a195e2abbbc19a95b0f3b3a Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 8 Jul 2013 23:02:44 +0000
Subject: Use the TokenAfter() macro.

---
 generic/tclCompile.c | 12 +++++-------
 1 file changed, 5 insertions(+), 7 deletions(-)

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 656f700..afe34b0 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1755,7 +1755,7 @@ ExpandRequested(
 	if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
 	    return 1;
 	}
-	tokenPtr += tokenPtr->numComponents + 1;
+	tokenPtr = TokenAfter(tokenPtr);
     }
     return 0;
 }
@@ -1792,11 +1792,10 @@ CompileInvocation(
     if (cmdObj) {
 	CompileCmdLiteral(interp, cmdObj, envPtr);
 	wordIdx = 1;
-	tokenPtr += tokenPtr->numComponents + 1;
+	tokenPtr = TokenAfter(tokenPtr);
     }
 
-    for (; wordIdx < numWords;
-	    wordIdx++, tokenPtr += tokenPtr->numComponents + 1) {
+    for (; wordIdx < numWords; wordIdx++, tokenPtr = TokenAfter(tokenPtr)) {
 	int objIdx;
 
 	envPtr->line = eclPtr->loc[wlineat].line[wordIdx];
@@ -1848,11 +1847,10 @@ CompileExpanded(
     if (cmdObj) {
 	CompileCmdLiteral(interp, cmdObj, envPtr);
 	wordIdx = 1;
-	tokenPtr += tokenPtr->numComponents + 1;
+	tokenPtr = TokenAfter(tokenPtr);
     }
 
-    for (; wordIdx < numWords;
-	    wordIdx++, tokenPtr += tokenPtr->numComponents + 1) {
+    for (; wordIdx < numWords; wordIdx++, tokenPtr = TokenAfter(tokenPtr)) {
 	int objIdx;
 
 	envPtr->line = eclPtr->loc[wlineat].line[wordIdx];
-- 
cgit v0.12


From d72d5f8b7a85e097e1e934c4a757301699d80266 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 9 Jul 2013 20:37:37 +0000
Subject: Tentative Work In Progress unwinding TIP 280 line information.

---
 generic/tclCompile.c | 39 +++++++++++++++++++++++++++++----------
 1 file changed, 29 insertions(+), 10 deletions(-)

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index afe34b0..777c03e 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1787,7 +1787,8 @@ CompileInvocation(
     CompileEnv *envPtr)
 {
     int isnew, wordIdx = 0;
-    ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
+//    ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
+    DefineLineInformation;
 
     if (cmdObj) {
 	CompileCmdLiteral(interp, cmdObj, envPtr);
@@ -1798,8 +1799,9 @@ CompileInvocation(
     for (; wordIdx < numWords; wordIdx++, tokenPtr = TokenAfter(tokenPtr)) {
 	int objIdx;
 
-	envPtr->line = eclPtr->loc[wlineat].line[wordIdx];
-	envPtr->clNext = eclPtr->loc[wlineat].next[wordIdx];
+//	envPtr->line = eclPtr->loc[wlineat].line[wordIdx];
+//	envPtr->clNext = eclPtr->loc[wlineat].next[wordIdx];
+	SetLineInformation(wordIdx);
 
 	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
 	    CompileTokens(envPtr, tokenPtr, interp);
@@ -1811,7 +1813,8 @@ CompileInvocation(
 	if (envPtr->clNext) {
 	    TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx),
 		    tokenPtr[1].start - envPtr->source,
-		    eclPtr->loc[wlineat].next[wordIdx]);
+//		    eclPtr->loc[wlineat].next[wordIdx]);
+		    mapPtr->loc[eclIndex].next[wordIdx]);
 	}
 	TclEmitPush(objIdx, envPtr);
     }
@@ -1820,9 +1823,11 @@ CompileInvocation(
      * Save PC -> command map for the TclArgumentBC* functions.
      */
 
-    Tcl_SetHashValue(Tcl_CreateHashEntry(&eclPtr->litInfo,
+//    Tcl_SetHashValue(Tcl_CreateHashEntry(&eclPtr->litInfo,
+    Tcl_SetHashValue(Tcl_CreateHashEntry(&mapPtr->litInfo,
 	    INT2PTR(envPtr->codeNext - envPtr->codeStart), &isnew),
-	    INT2PTR(wlineat));
+//	    INT2PTR(wlineat));
+	    INT2PTR(eclIndex));
 
     if (wordIdx <= 255) {
 	TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr);
@@ -1841,7 +1846,9 @@ CompileExpanded(
     CompileEnv *envPtr)
 {
     int wordIdx = 0;
-    ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
+    DefineLineInformation;
+//    ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
+
 
     StartExpanding(envPtr);
     if (cmdObj) {
@@ -1853,8 +1860,9 @@ CompileExpanded(
     for (; wordIdx < numWords; wordIdx++, tokenPtr = TokenAfter(tokenPtr)) {
 	int objIdx;
 
-	envPtr->line = eclPtr->loc[wlineat].line[wordIdx];
-	envPtr->clNext = eclPtr->loc[wlineat].next[wordIdx];
+	SetLineInformation(wordIdx);
+//	envPtr->line = eclPtr->loc[wlineat].line[wordIdx];
+//	envPtr->clNext = eclPtr->loc[wlineat].next[wordIdx];
 
 	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
 	    CompileTokens(envPtr, tokenPtr, interp);
@@ -1870,7 +1878,8 @@ CompileExpanded(
 	if (envPtr->clNext) {
 	    TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx),
 		    tokenPtr[1].start - envPtr->source,
-		    eclPtr->loc[wlineat].next[wordIdx]);
+//		    eclPtr->loc[wlineat].next[wordIdx]);
+		    mapPtr->loc[eclIndex].next[wordIdx]);
 	}
 	TclEmitPush(objIdx, envPtr);
     }
@@ -1998,6 +2007,16 @@ CompileCmdCompileProc(
     envPtr->codeNext = envPtr->codeStart + startCodeOffset;
     envPtr->currStackDepth = startStackDepth;
 
+    /*
+     * Throw out any line information generated by the failed
+     * compile attempt.
+     */
+    while (mapPtr->nuloc - 1 > eclIndex) {
+	mapPtr->nuloc--;
+	ckfree(mapPtr->loc[mapPtr->nuloc].line);
+	mapPtr->loc[mapPtr->nuloc].line = NULL;
+    }
+
     SetLineInformation(0);
     return TCL_ERROR;
 }
-- 
cgit v0.12


From afad6ffbb48761689faa9e08e8b9da7e5c63dca0 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 10 Jul 2013 03:17:57 +0000
Subject: Revise the litInfo table so that it gets built later (in
 TclInitByteCodeObj) from a simpler store of data that can unwind.

---
 generic/tclCompile.c | 79 +++++++++++++---------------------------------------
 generic/tclCompile.h |  1 +
 2 files changed, 20 insertions(+), 60 deletions(-)

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 777c03e..c31d256 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1786,8 +1786,7 @@ CompileInvocation(
     int wlineat,
     CompileEnv *envPtr)
 {
-    int isnew, wordIdx = 0;
-//    ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
+    int wordIdx = 0;
     DefineLineInformation;
 
     if (cmdObj) {
@@ -1799,8 +1798,6 @@ CompileInvocation(
     for (; wordIdx < numWords; wordIdx++, tokenPtr = TokenAfter(tokenPtr)) {
 	int objIdx;
 
-//	envPtr->line = eclPtr->loc[wlineat].line[wordIdx];
-//	envPtr->clNext = eclPtr->loc[wlineat].next[wordIdx];
 	SetLineInformation(wordIdx);
 
 	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
@@ -1813,7 +1810,6 @@ CompileInvocation(
 	if (envPtr->clNext) {
 	    TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx),
 		    tokenPtr[1].start - envPtr->source,
-//		    eclPtr->loc[wlineat].next[wordIdx]);
 		    mapPtr->loc[eclIndex].next[wordIdx]);
 	}
 	TclEmitPush(objIdx, envPtr);
@@ -1823,11 +1819,7 @@ CompileInvocation(
      * Save PC -> command map for the TclArgumentBC* functions.
      */
 
-//    Tcl_SetHashValue(Tcl_CreateHashEntry(&eclPtr->litInfo,
-    Tcl_SetHashValue(Tcl_CreateHashEntry(&mapPtr->litInfo,
-	    INT2PTR(envPtr->codeNext - envPtr->codeStart), &isnew),
-//	    INT2PTR(wlineat));
-	    INT2PTR(eclIndex));
+    mapPtr->loc[eclIndex].invokePc = envPtr->codeNext - envPtr->codeStart;
 
     if (wordIdx <= 255) {
 	TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr);
@@ -1847,7 +1839,6 @@ CompileExpanded(
 {
     int wordIdx = 0;
     DefineLineInformation;
-//    ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
 
 
     StartExpanding(envPtr);
@@ -1861,8 +1852,6 @@ CompileExpanded(
 	int objIdx;
 
 	SetLineInformation(wordIdx);
-//	envPtr->line = eclPtr->loc[wlineat].line[wordIdx];
-//	envPtr->clNext = eclPtr->loc[wlineat].next[wordIdx];
 
 	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
 	    CompileTokens(envPtr, tokenPtr, interp);
@@ -1878,7 +1867,6 @@ CompileExpanded(
 	if (envPtr->clNext) {
 	    TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx),
 		    tokenPtr[1].start - envPtr->source,
-//		    eclPtr->loc[wlineat].next[wordIdx]);
 		    mapPtr->loc[eclIndex].next[wordIdx]);
 	}
 	TclEmitPush(objIdx, envPtr);
@@ -2015,6 +2003,7 @@ CompileCmdCompileProc(
 	mapPtr->nuloc--;
 	ckfree(mapPtr->loc[mapPtr->nuloc].line);
 	mapPtr->loc[mapPtr->nuloc].line = NULL;
+	mapPtr->loc[mapPtr->nuloc].invokePc = -1;
     }
 
     SetLineInformation(0);
@@ -3340,6 +3329,17 @@ TclInitByteCodeObj(
      * byte code object (internal rep), for use with the bc compiler.
      */
 
+    for (i = 0;  i < envPtr->extCmdMapPtr->nuloc;  i++) {
+	int isnew, pc = envPtr->extCmdMapPtr->loc[i].invokePc;
+
+	if (pc < 0) {
+	    continue;
+	}
+
+	Tcl_SetHashValue(Tcl_CreateHashEntry(&envPtr->extCmdMapPtr->litInfo,
+	    INT2PTR(pc), &isnew), INT2PTR(i));
+    }
+
     Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->lineBCPtr, codePtr,
 	    &isNew), envPtr->extCmdMapPtr);
     envPtr->extCmdMapPtr = NULL;
@@ -3710,6 +3710,7 @@ EnterCmdWordData(
 
     ePtr = &eclPtr->loc[eclPtr->nuloc];
     ePtr->srcOffset = srcOffset;
+    ePtr->invokePc = -1;
     ePtr->line = ckalloc(numWords * sizeof(int));
     ePtr->next = ckalloc(numWords * sizeof(int *));
     ePtr->nline = numWords;
@@ -4493,54 +4494,12 @@ TclFixupForwardJump(
 
     {
 	ExtCmdLoc* eclPtr = envPtr->extCmdMapPtr;
-
-	/* A helper structure */
-
-	typedef struct {
-	    int pc;
-	    int cmd;
-	} MAP;
-
-	/*
-	 * And the helper array. At most the whole hashtable is placed into
-	 * this.
-	 */
-
-	MAP *map = (MAP*) ckalloc (sizeof(MAP) * eclPtr->litInfo.numEntries);
-
-	Tcl_HashSearch hSearch;
-	Tcl_HashEntry* hPtr;
-	int n, k, isnew;
-
-	/*
-	 * Phase I: Locate the affected entries, and save them in adjusted
-	 * form to the array. This removes them from the hash.
-	 */
-
-	for (n = 0, hPtr = Tcl_FirstHashEntry(&eclPtr->litInfo, &hSearch);
-	     hPtr != NULL;
-	     hPtr = Tcl_NextHashEntry(&hSearch)) {
-
-	    map [n].cmd = PTR2INT(Tcl_GetHashValue(hPtr));
-	    map [n].pc  = PTR2INT(Tcl_GetHashKey (&eclPtr->litInfo,hPtr));
-
-	    if (map[n].pc >= (jumpFixupPtr->codeOffset + 2)) {
-		Tcl_DeleteHashEntry(hPtr);
-		map [n].pc += 3;
-		n++;
+	for (k = eclPtr->nuloc - 1; k >= 0; k--) {
+	    if (eclPtr->loc[k].invokePc < (jumpFixupPtr->codeOffset + 2)) {
+		continue;
 	    }
+	    eclPtr->loc[k].invokePc += 3;
 	}
-
-	/*
-	 * Phase II: Re-insert the modified entries into the hash.
-	 */
-
-	for (k=0;k<n;k++) {
-	    hPtr = Tcl_CreateHashEntry(&eclPtr->litInfo, INT2PTR(map[k].pc), &isnew);
-	    Tcl_SetHashValue(hPtr, INT2PTR(map[k].cmd));
-	}
-
-	ckfree (map);
     }
 
     return 1;			/* the jump was grown */
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 9af4911..cbe104c 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -175,6 +175,7 @@ typedef struct CmdLocation {
 
 typedef struct ECL {
     int srcOffset;		/* Command location to find the entry. */
+    int invokePc;
     int nline;			/* Number of words in the command */
     int *line;			/* Line information for all words in the
 				 * command. */
-- 
cgit v0.12


From 1e62f5ac76864a8e1e5d388fa6ecdef2dff63ca6 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 10 Jul 2013 03:28:37 +0000
Subject: Remove the (now unused) wlineat arguments.

---
 generic/tclCompile.c | 8 ++------
 1 file changed, 2 insertions(+), 6 deletions(-)

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index c31d256..5f4acff 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1783,7 +1783,6 @@ CompileInvocation(
     Tcl_Token *tokenPtr,
     Tcl_Obj *cmdObj,
     int numWords,
-    int wlineat,
     CompileEnv *envPtr)
 {
     int wordIdx = 0;
@@ -1834,7 +1833,6 @@ CompileExpanded(
     Tcl_Token *tokenPtr,
     Tcl_Obj *cmdObj,
     int numWords,
-    int wlineat,
     CompileEnv *envPtr)
 {
     int wordIdx = 0;
@@ -2095,12 +2093,10 @@ CompileCommandTokens(
 
 	if (expand) {
 	    CompileExpanded(interp, parsePtr->tokenPtr,
-		    cmdKnown ? cmdObj : NULL, parsePtr->numWords, wlineat,
-		    envPtr);
+		    cmdKnown ? cmdObj : NULL, parsePtr->numWords, envPtr);
 	} else {
 	    CompileInvocation(interp, parsePtr->tokenPtr,
-		    cmdKnown ? cmdObj : NULL, parsePtr->numWords, wlineat,
-		    envPtr);
+		    cmdKnown ? cmdObj : NULL, parsePtr->numWords, envPtr);
 	}
     }
 
-- 
cgit v0.12


From ee74db1cbf0cb0122fbab5591ad2361c0a1f3313 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 10 Jul 2013 16:17:12 +0000
Subject: Disabling the SetLineInformation() macro entirely causes only 3 tests
 in the test suite to fail.  Restoring just 2 SetLineInformation() calls fixes
 those failures.  The need for all the other SLI() calls is not demonstrated
 by any test.  Without more complete test coverage, it is difficult to
 confidently tweak the TIP 280 implementation without fear that changes are
 introducing breakage.

---
 generic/tclCompCmdsGR.c | 2 ++
 generic/tclCompCmdsSZ.c | 2 ++
 generic/tclCompile.h    | 9 ++++++---
 3 files changed, 10 insertions(+), 3 deletions(-)

diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index f7c15e6..3cd0da6 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -265,6 +265,8 @@ TclCompileIfCmd(
 
 	if (compileScripts) {
 	    SetLineInformation(wordIdx);
+envPtr->line = mapPtr->loc[eclIndex].line[wordIdx];
+envPtr->clNext = mapPtr->loc[eclIndex].next[wordIdx];
 	    CompileBody(envPtr, tokenPtr, interp);
 	}
 
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 855dd8f..8723a4f 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -726,6 +726,8 @@ TclCompileSubstCmd(
     }
 
     SetLineInformation(numArgs);
+envPtr->line = mapPtr->loc[eclIndex].line[numArgs];
+envPtr->clNext = mapPtr->loc[eclIndex].next[numArgs];
     TclSubstCompile(interp, wordTokenPtr[1].start, wordTokenPtr[1].size,
 	    flags, mapPtr->loc[eclIndex].line[numArgs], envPtr);
 
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 9af4911..6fe14f2 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -1537,9 +1537,12 @@ MODULE_SCOPE Tcl_Obj	*TclNewInstNameObj(unsigned char inst);
     ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr;				\
     int eclIndex = mapPtr->nuloc - 1
 
-#define SetLineInformation(word) \
-    envPtr->line = mapPtr->loc[eclIndex].line[(word)];			\
-    envPtr->clNext = mapPtr->loc[eclIndex].next[(word)]
+//#define SetLineInformation(word) \
+//    envPtr->line = mapPtr->loc[eclIndex].line[(word)];			\
+//    envPtr->clNext = mapPtr->loc[eclIndex].next[(word)]
+
+#define SetLineInformation(word)
+
 
 #define PushVarNameWord(i,v,e,f,l,sc,word) \
     TclPushVarName(i,v,e,f,l,sc,						\
-- 
cgit v0.12


From 7a53c36e3aa0311270181fed854e1c590656c2f3 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 10 Jul 2013 16:27:09 +0000
Subject: First additional test.  Remove dup macros in tclEnsemble.c.

---
 generic/tclCompCmds.c   |  2 +-
 generic/tclCompCmdsGR.c |  4 +---
 generic/tclCompCmdsSZ.c |  4 +---
 generic/tclCompile.h    |  6 +++---
 generic/tclEnsemble.c   | 10 ----------
 tests/info.test         | 15 +++++++++++++++
 6 files changed, 21 insertions(+), 20 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index fddf152..7ed9006 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -610,7 +610,7 @@ TclCompileCatchCmd(
      * begin by undeflowing the stack below the mark set by BEGIN_CATCH4.
      */
 
-    SetLineInformation(1);
+    LineInformation(1);
     if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
 	TclEmitInstInt4(	INST_BEGIN_CATCH4, range,	envPtr);
 	ExceptionRangeStarts(envPtr, range);
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index 3cd0da6..cc3f694 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -264,9 +264,7 @@ TclCompileIfCmd(
 	 */
 
 	if (compileScripts) {
-	    SetLineInformation(wordIdx);
-envPtr->line = mapPtr->loc[eclIndex].line[wordIdx];
-envPtr->clNext = mapPtr->loc[eclIndex].next[wordIdx];
+	    LineInformation(wordIdx);
 	    CompileBody(envPtr, tokenPtr, interp);
 	}
 
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 8723a4f..34c24f9 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -725,9 +725,7 @@ TclCompileSubstCmd(
 	return TCL_ERROR;
     }
 
-    SetLineInformation(numArgs);
-envPtr->line = mapPtr->loc[eclIndex].line[numArgs];
-envPtr->clNext = mapPtr->loc[eclIndex].next[numArgs];
+    LineInformation(numArgs);
     TclSubstCompile(interp, wordTokenPtr[1].start, wordTokenPtr[1].size,
 	    flags, mapPtr->loc[eclIndex].line[numArgs], envPtr);
 
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 6fe14f2..5043f65 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -1537,9 +1537,9 @@ MODULE_SCOPE Tcl_Obj	*TclNewInstNameObj(unsigned char inst);
     ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr;				\
     int eclIndex = mapPtr->nuloc - 1
 
-//#define SetLineInformation(word) \
-//    envPtr->line = mapPtr->loc[eclIndex].line[(word)];			\
-//    envPtr->clNext = mapPtr->loc[eclIndex].next[(word)]
+#define LineInformation(word) \
+    envPtr->line = mapPtr->loc[eclIndex].line[(word)];			\
+    envPtr->clNext = mapPtr->loc[eclIndex].next[(word)]
 
 #define SetLineInformation(word)
 
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 813e056..e0aa0c4 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -88,16 +88,6 @@ const Tcl_ObjType tclEnsembleCmdType = {
     NULL			/* setFromAnyProc */
 };
 
-/*
- * Copied from tclCompCmds.c
- */
-
-#define DefineLineInformation \
-    ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr;				\
-    int eclIndex = mapPtr->nuloc - 1
-#define SetLineInformation(word) \
-    envPtr->line = mapPtr->loc[eclIndex].line[(word)];			\
-    envPtr->clNext = mapPtr->loc[eclIndex].next[(word)]
 
 static inline Tcl_Obj *
 NewNsObj(
diff --git a/tests/info.test b/tests/info.test
index ebc853a..a1d3b1a 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -1962,6 +1962,21 @@ test info-9.13 {info level option, value in global context} -body {
 } -returnCodes error -result {bad level "2"}
 
 # -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    catch {*}{
+	{info frame 0}
+	res
+    }
+    return $res
+}
+test info-33.4 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 1968 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
 unset -nocomplain res
 
 # cleanup
-- 
cgit v0.12


From d69c39d52e07b61221f06c9403a06c6a79ac31f9 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 10 Jul 2013 16:43:01 +0000
Subject: Next attempt.  Appears to have uncovered a bug.

---
 generic/tclCompCmds.c |  2 +-
 tests/info.test       | 14 ++++++++++++++
 2 files changed, 15 insertions(+), 1 deletion(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 7ed9006..13318a3 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -1467,7 +1467,7 @@ CompileDictEachCmd(
      * Compile the loop body itself. It should be stack-neutral.
      */
 
-    SetLineInformation(3);
+    LineInformation(3);
     CompileBody(envPtr, bodyTokenPtr, interp);
     if (collect == TCL_EACH_COLLECT) {
 	Emit14Inst(	INST_LOAD_SCALAR, keyVarIndex,		envPtr);
diff --git a/tests/info.test b/tests/info.test
index a1d3b1a..ba31159 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -1977,6 +1977,20 @@ test info-33.4 {{*}, literal, simple, bytecompiled} -body {
 } -result {type source line 1968 file info.test cmd {info frame 0} proc ::foo::bar level 0}
 
 # -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    dict for {a b} {c d} {*}{
+	{set res [info frame 0]}
+    }
+    return $res
+}
+test info-33.5 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 1983 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
 unset -nocomplain res
 
 # cleanup
-- 
cgit v0.12


From c079ab076f93957eb10fecbdc60e418c4007ca23 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 10 Jul 2013 17:58:45 +0000
Subject: Fix for [86fb5ea28e].  Test will eventually merge in from
 tip280-test-coverage.

---
 generic/tclEnsemble.c | 16 ++++++++++++++++
 1 file changed, 16 insertions(+)

diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 813e056..a718d0e 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -3059,6 +3059,7 @@ CompileToCompiledCommand(
     int savedNumCmds = envPtr->numCommands;
     int savedStackDepth = envPtr->currStackDepth;
     unsigned savedCodeNext = envPtr->codeNext - envPtr->codeStart;
+    DefineLineInformation;
 
     if (cmdPtr->compileProc == NULL) {
 	return TCL_ERROR;
@@ -3107,12 +3108,27 @@ CompileToCompiledCommand(
     }
 
     /*
+     * Shift the line information arrays to account for different word
+     * index values.
+     */
+
+    mapPtr->loc[eclIndex].line += (depth - 1);
+    mapPtr->loc[eclIndex].next += (depth - 1);
+
+    /*
      * Hand off compilation to the subcommand compiler. At last!
      */
 
     result = cmdPtr->compileProc(interp, &synthetic, cmdPtr, envPtr);
 
     /*
+     * Undo the shift. 
+     */
+
+    mapPtr->loc[eclIndex].line -= (depth - 1);
+    mapPtr->loc[eclIndex].next -= (depth - 1);
+
+    /*
      * If our target fails to compile, revert the number of commands and the
      * pointer to the place to issue the next instruction. [Bug 3600328]
      */
-- 
cgit v0.12


From 1dc19d83708afaa3accab0ba7a92882e1444158f Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 10 Jul 2013 19:34:55 +0000
Subject: Add tests for, and fix bugs in, the SetLineInformation() calls in
 tclCompCmds.c.

---
 generic/tclCompCmds.c |  20 ++++-----
 tests/info.test       | 118 ++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 127 insertions(+), 11 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 13318a3..28a3e64 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -1651,7 +1651,7 @@ TclCompileDictUpdateCmd(
     TclEmitInstInt4(	INST_BEGIN_CATCH4, range,		envPtr);
 
     ExceptionRangeStarts(envPtr, range);
-    SetLineInformation(parsePtr->numWords - 1);
+    LineInformation(parsePtr->numWords - 1);
     CompileBody(envPtr, bodyTokenPtr, interp);
     ExceptionRangeEnds(envPtr, range);
 
@@ -1992,7 +1992,7 @@ TclCompileDictWithCmd(
     TclEmitInstInt4(		INST_BEGIN_CATCH4, range,	envPtr);
 
     ExceptionRangeStarts(envPtr, range);
-    SetLineInformation(parsePtr->numWords-1);
+    LineInformation(parsePtr->numWords-1);
     CompileBody(envPtr, tokenPtr, interp);
     ExceptionRangeEnds(envPtr, range);
 
@@ -2268,7 +2268,7 @@ TclCompileForCmd(
      * Inline compile the initial command.
      */
 
-    SetLineInformation(1);
+    LineInformation(1);
     CompileBody(envPtr, startTokenPtr, interp);
     TclEmitOpcode(INST_POP, envPtr);
 
@@ -2292,7 +2292,7 @@ TclCompileForCmd(
 
     bodyRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
     bodyCodeOffset = ExceptionRangeStarts(envPtr, bodyRange);
-    SetLineInformation(4);
+    LineInformation(4);
     CompileBody(envPtr, bodyTokenPtr, interp);
     ExceptionRangeEnds(envPtr, bodyRange);
     TclEmitOpcode(INST_POP, envPtr);
@@ -2306,7 +2306,7 @@ TclCompileForCmd(
     nextRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
     envPtr->exceptAuxArrayPtr[nextRange].supportsContinue = 0;
     nextCodeOffset = ExceptionRangeStarts(envPtr, nextRange);
-    SetLineInformation(3);
+    LineInformation(3);
     CompileBody(envPtr, nextTokenPtr, interp);
     ExceptionRangeEnds(envPtr, nextRange);
     TclEmitOpcode(INST_POP, envPtr);
@@ -2325,7 +2325,7 @@ TclCompileForCmd(
 	testCodeOffset += 3;
     }
 
-    SetLineInformation(2);
+    LineInformation(2);
     TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
 
     jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
@@ -2464,7 +2464,7 @@ CompileEachloopCmd(
     Tcl_Token *tokenPtr, *bodyTokenPtr;
     unsigned char *jumpPc;
     JumpFixup jumpFalseFixup;
-    int jumpBackDist, jumpBackOffset, infoIndex, range, bodyIndex;
+    int jumpBackDist, jumpBackOffset, infoIndex, range;
     int numWords, numLists, numVars, loopIndex, tempVar, i, j, code;
     DefineLineInformation;	/* TIP #280 */
 
@@ -2504,8 +2504,6 @@ CompileEachloopCmd(
 	return TCL_ERROR;
     }
 
-    bodyIndex = i-1;
-
     /*
      * Allocate storage for the varcList and varvList arrays if necessary.
      */
@@ -2646,7 +2644,7 @@ CompileEachloopCmd(
 	    i < numWords-1;
 	    i++, tokenPtr = TokenAfter(tokenPtr)) {
 	if ((i%2 == 0) && (i > 0)) {
-	    SetLineInformation(i);
+	    LineInformation(i);
 	    CompileTokens(envPtr, tokenPtr, interp);
 	    tempVar = (firstValueTemp + loopIndex);
 	    Emit14Inst(		INST_STORE_SCALAR, tempVar,	envPtr);
@@ -2684,7 +2682,7 @@ CompileEachloopCmd(
      * Inline compile the loop body.
      */
 
-    SetLineInformation(bodyIndex);
+    LineInformation(numWords - 1);
     ExceptionRangeStarts(envPtr, range);
     CompileBody(envPtr, bodyTokenPtr, interp);
     ExceptionRangeEnds(envPtr, range);
diff --git a/tests/info.test b/tests/info.test
index ba31159..98bb724 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -1991,6 +1991,124 @@ test info-33.5 {{*}, literal, simple, bytecompiled} -body {
 } -result {type source line 1983 file info.test cmd {info frame 0} proc ::foo::bar level 0}
 
 # -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    set d {a b}
+    dict update d x y {*}{
+	{set res [info frame 0]}
+    }
+    return $res
+}
+test info-33.6 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 1998 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    set d {}
+    dict with d {*}{
+	{set res [info frame 0]}
+    }
+    return $res
+}
+test info-33.7 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2013 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    for {*}{
+	{set res [info frame 0]}
+	{1} {} {break}
+    }
+    return $res
+}
+test info-33.8 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2027 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    for {*}{
+	{} {1} {}
+	{set res [info frame 0]; break}
+    }
+    return $res
+}
+test info-33.9 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2043 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    for {*}{
+	{} {1}
+	{return [info frame 0]}
+	{}
+    }
+}
+test info-33.10 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2058 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    for {*}{
+	{}
+	{[return [info frame 0]]}
+	{} {}
+    }
+}
+test info-33.11 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2073 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    foreach {*}{
+	x
+    } [return [info frame 0]] {}
+}
+test info-33.12 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2088 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    foreach {*}{
+	x y
+	{set res [info frame 0]}
+    } 
+    return $res
+}
+test info-33.13 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2101 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
 unset -nocomplain res
 
 # cleanup
-- 
cgit v0.12


From 9d91a3db0b4c6c9a78f6be985bb2ed3dcd7b9573 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 10 Jul 2013 19:43:56 +0000
Subject: Add tests for SetLineInformation() calls in tclCompCmdsGR.c.

---
 generic/tclCompCmdsGR.c |  8 ++++----
 tests/info.test         | 53 +++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 57 insertions(+), 4 deletions(-)

diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index cc3f694..32514ab 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -222,7 +222,7 @@ TclCompileIfCmd(
 		    compileScripts = 0;
 		}
 	    } else {
-		SetLineInformation(wordIdx);
+		LineInformation(wordIdx);
 		Tcl_ResetResult(interp);
 		TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
 		if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) {
@@ -345,7 +345,7 @@ TclCompileIfCmd(
 	     * Compile the else command body.
 	     */
 
-	    SetLineInformation(wordIdx);
+	    LineInformation(wordIdx);
 	    CompileBody(envPtr, tokenPtr, interp);
 	}
 
@@ -474,7 +474,7 @@ TclCompileIncrCmd(
 		PushLiteral(envPtr, word, numBytes);
 	    }
 	} else {
-	    SetLineInformation(2);
+	    LineInformation(2);
 	    CompileTokens(envPtr, incrTokenPtr, interp);
 	}
     } else {			/* No incr amount given so use 1. */
@@ -701,7 +701,7 @@ TclCompileInfoLevelCmd(
 	 * list of arguments.
 	 */
 
-	SetLineInformation(1);
+	LineInformation(1);
 	CompileTokens(envPtr, TokenAfter(parsePtr->tokenPtr), interp);
 	TclEmitOpcode(		INST_INFO_LEVEL_ARGS,		envPtr);
     }
diff --git a/tests/info.test b/tests/info.test
index 98bb724..98f6ea7 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -2109,6 +2109,59 @@ test info-33.13 {{*}, literal, simple, bytecompiled} -body {
 } -result {type source line 2101 file info.test cmd {info frame 0} proc ::foo::bar level 0}
 
 # -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    if {*}{
+	{[return [info frame 0]]}
+	{}
+    } 
+}
+test info-33.14 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2115 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    if 0 {*}{
+	{} else
+	{return [info frame 0]}
+    } 
+}
+test info-33.15 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2130 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    incr {*}{
+	x
+    } [return [info frame 0]]
+}
+test info-33.16 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2144 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    info level {*}{
+    } [return [info frame 0]]
+}
+test info-33.16 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2156 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
 unset -nocomplain res
 
 # cleanup
-- 
cgit v0.12


From 75bc23d59cf4ad60a7f0e10ad939564c9bfb4ec3 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 10 Jul 2013 20:33:45 +0000
Subject: Add tests for SetLineInformation() calls in tclCompCmdsSZ.c as well
 as some obvious refactoring improvements.

---
 generic/tclCompCmdsSZ.c |  66 ++++++-----------
 tests/info.test         | 186 +++++++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 206 insertions(+), 46 deletions(-)

diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 34c24f9..d5208e6 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -40,17 +40,14 @@ static int		CompileUnaryOpCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, int instruction,
 			    CompileEnv *envPtr);
 static void		IssueSwitchChainedTests(Tcl_Interp *interp,
-			    CompileEnv *envPtr, ExtCmdLoc *mapPtr,
-			    int eclIndex, int mode, int noCase,
-			    int valueIndex, Tcl_Token *valueTokenPtr,
-			    int numWords, Tcl_Token **bodyToken,
-			    int *bodyLines, int **bodyNext);
-static void		IssueSwitchJumpTable(Tcl_Interp *interp,
-			    CompileEnv *envPtr, ExtCmdLoc *mapPtr,
-			    int eclIndex, int valueIndex,
-			    Tcl_Token *valueTokenPtr, int numWords,
+			    CompileEnv *envPtr, int mode, int noCase,
+			    int valueIndex, int numWords,
 			    Tcl_Token **bodyToken, int *bodyLines,
-			    int **bodyContLines);
+			    int **bodyNext);
+static void		IssueSwitchJumpTable(Tcl_Interp *interp,
+			    CompileEnv *envPtr, int valueIndex,
+			    int numWords, Tcl_Token **bodyToken,
+			    int *bodyLines, int **bodyContLines);
 static int		IssueTryClausesInstructions(Tcl_Interp *interp,
 			    CompileEnv *envPtr, Tcl_Token *bodyToken,
 			    int numHandlers, int *matchCodes,
@@ -89,7 +86,7 @@ const AuxDataType tclJumptableInfoType = {
 #define OP44(name,val1,val2) \
     TclEmitInstInt4(INST_##name,(val1),envPtr);TclEmitInt4((val2),envPtr)
 #define BODY(token,index) \
-    SetLineInformation((index));CompileBody(envPtr,(token),interp)
+    LineInformation((index));CompileBody(envPtr,(token),interp)
 #define PUSH(str) \
     PushStringLiteral(envPtr, str)
 #define JUMP4(name,var) \
@@ -436,7 +433,7 @@ TclCompileStringMatchCmd(
 	    }
 	    PushLiteral(envPtr, str, length);
 	} else {
-	    SetLineInformation(i+1+nocase);
+	    LineInformation(i+1+nocase);
 	    CompileTokens(envPtr, tokenPtr, interp);
 	}
 	tokenPtr = TokenAfter(tokenPtr);
@@ -486,7 +483,7 @@ TclCompileStringLenCmd(
 	len = sprintf(buf, "%d", len);
 	PushLiteral(envPtr, buf, len);
     } else {
-	SetLineInformation(1);
+	LineInformation(1);
 	CompileTokens(envPtr, tokenPtr, interp);
 	TclEmitOpcode(INST_STR_LEN, envPtr);
     }
@@ -1286,13 +1283,16 @@ TclCompileSwitchCmd(
      * but it handles the most common case well enough.
      */
 
+    /* Both methods push the value to match against onto the stack. */
+    LineInformation(valueIndex);
+    CompileTokens(envPtr, valueTokenPtr, interp);
+
     if (mode == Switch_Exact) {
-	IssueSwitchJumpTable(interp, envPtr, mapPtr, eclIndex, valueIndex,
-		valueTokenPtr, numWords, bodyToken, bodyLines, bodyContLines);
+	IssueSwitchJumpTable(interp, envPtr, valueIndex, numWords, bodyToken,
+		bodyLines, bodyContLines);
     } else {
-	IssueSwitchChainedTests(interp, envPtr, mapPtr, eclIndex, mode,noCase,
-		valueIndex, valueTokenPtr, numWords, bodyToken, bodyLines,
-		bodyContLines);
+	IssueSwitchChainedTests(interp, envPtr, mode, noCase, valueIndex,
+		numWords, bodyToken, bodyLines, bodyContLines);
     }
     result = TCL_OK;
 
@@ -1330,13 +1330,9 @@ static void
 IssueSwitchChainedTests(
     Tcl_Interp *interp,		/* Context for compiling script bodies. */
     CompileEnv *envPtr,		/* Holds resulting instructions. */
-    ExtCmdLoc *mapPtr,		/* For mapping tokens to their source code
-				 * location. */
-    int eclIndex,
     int mode,			/* Exact, Glob or Regexp */
     int noCase,			/* Case-insensitivity flag. */
     int valueIndex,		/* The value to match against. */
-    Tcl_Token *valueTokenPtr,
     int numBodyTokens,		/* Number of tokens describing things the
 				 * switch can match against and bodies to
 				 * execute when the match succeeds. */
@@ -1361,13 +1357,6 @@ IssueSwitchChainedTests(
     int i;
 
     /*
-     * First, we push the value we're matching against on the stack.
-     */
-
-    SetLineInformation(valueIndex);
-    CompileTokens(envPtr, valueTokenPtr, interp);
-
-    /*
      * Generate a test for each arm.
      */
 
@@ -1592,11 +1581,7 @@ static void
 IssueSwitchJumpTable(
     Tcl_Interp *interp,		/* Context for compiling script bodies. */
     CompileEnv *envPtr,		/* Holds resulting instructions. */
-    ExtCmdLoc *mapPtr,		/* For mapping tokens to their source code
-				 * location. */
-    int eclIndex,
     int valueIndex,		/* The value to match against. */
-    Tcl_Token *valueTokenPtr,
     int numBodyTokens,		/* Number of tokens describing things the
 				 * switch can match against and bodies to
 				 * execute when the match succeeds. */
@@ -1612,13 +1597,6 @@ IssueSwitchJumpTable(
     Tcl_HashEntry *hPtr;
 
     /*
-     * First, we push the value we're matching against on the stack.
-     */
-
-    SetLineInformation(valueIndex);
-    CompileTokens(envPtr, valueTokenPtr, interp);
-
-    /*
      * Compile the switch by using a jump table, which is basically a
      * hashtable that maps from literal values to match against to the offset
      * (relative to the INST_JUMP_TABLE instruction) to jump to. The jump
@@ -2048,8 +2026,7 @@ TclCompileTryCmd(
 	 */
 
 	DefineLineInformation;	/* TIP #280 */
-	SetLineInformation(1);
-	CompileBody(envPtr, bodyToken, interp);
+	BODY(bodyToken, 1);
 	return TCL_OK;
     }
 
@@ -3028,13 +3005,12 @@ TclCompileWhileCmd(
      * Compile the loop body.
      */
 
-    SetLineInformation(2);
     bodyCodeOffset = ExceptionRangeStarts(envPtr, range);
     if (!loopMayEnd) {
 	envPtr->exceptArrayPtr[range].continueOffset = testCodeOffset;
 	envPtr->exceptArrayPtr[range].codeOffset = bodyCodeOffset;
     }
-    CompileBody(envPtr, bodyTokenPtr, interp);
+    BODY(bodyTokenPtr, 2);
     ExceptionRangeEnds(envPtr, range);
     OP(		POP);
 
@@ -3050,7 +3026,7 @@ TclCompileWhileCmd(
 	    bodyCodeOffset += 3;
 	    testCodeOffset += 3;
 	}
-	SetLineInformation(1);
+	LineInformation(1);
 	TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
 
 	jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
diff --git a/tests/info.test b/tests/info.test
index 98f6ea7..a68fb43 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -2155,13 +2155,197 @@ proc foo::bar {} {
     info level {*}{
     } [return [info frame 0]]
 }
-test info-33.16 {{*}, literal, simple, bytecompiled} -body {
+test info-33.17 {{*}, literal, simple, bytecompiled} -body {
     reduce [foo::bar]
 } -cleanup {
     namespace delete foo
 } -result {type source line 2156 file info.test cmd {info frame 0} proc ::foo::bar level 0}
 
 # -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    string match {*}{
+    } [return [info frame 0]] {}
+}
+test info-33.18 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2168 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    string match {*}{
+	{}
+    } [return [info frame 0]]
+}
+test info-33.19 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2181 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    string length {*}{
+    } [return [info frame 0]]
+}
+test info-33.20 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2193 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    while {*}{
+	{[return [info frame 0]]}
+    } {}
+}
+test info-33.21 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2205 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    switch -- {*}{
+    } [return [info frame 0]] {*}{
+    } x y
+}
+test info-33.22 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2218 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    try {*}{
+	{set res [info frame 0]}
+    } 
+    return $res
+}
+test info-33.23 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2231 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    try {*}{
+	{set res [info frame 0]}
+    } finally {}
+    return $res
+}
+test info-33.24 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2245 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    try {*}{
+	{set res [info frame 0]}
+    } on ok {} {}
+    return $res
+}
+test info-33.25 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2259 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    try {*}{
+	{set res [info frame 0]}
+    } on ok {} {} finally {}
+    return $res
+}
+test info-33.26 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2273 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    while 1 {*}{
+	{return [info frame 0]}
+    }
+}
+test info-33.27 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2287 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    try {} finally {*}{
+	{return [info frame 0]}
+    }
+}
+test info-33.28 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2300 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    try {} on ok {} {} finally {*}{
+	{return [info frame 0]}
+    }
+}
+test info-33.29 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2313 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    try {} on ok {} {*}{
+	{return [info frame 0]}
+    }
+}
+test info-33.30 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2326 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    try {} on ok {} {*}{
+	{return [info frame 0]}
+    } finally {}
+}
+test info-33.31 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2339 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
 unset -nocomplain res
 
 # cleanup
-- 
cgit v0.12


From 6f4f29670680e5ace35ab03d96c112fde1e45ff6 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 11 Jul 2013 03:48:40 +0000
Subject: Add tests for the SetLineInformation() calls in tclEnsemble.c, and
 fix the bugs around those calls exposed by the tests.

---
 generic/tclEnsemble.c |  9 +++------
 tests/info.test       | 25 +++++++++++++++++++++++++
 2 files changed, 28 insertions(+), 6 deletions(-)

diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index d654bbf..794a059 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -3168,6 +3168,7 @@ CompileToInvokedCommand(
 	    bytes = Tcl_GetStringFromObj(words[i-1], &length);
 	    PushLiteral(envPtr, bytes, length);
 	} else if (tokPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+	    /* TODO: Check about registering Cmd Literals here */
 	    int literal = TclRegisterNewLiteral(envPtr,
 		    tokPtr[1].start, tokPtr[1].size);
 
@@ -3179,9 +3180,7 @@ CompileToInvokedCommand(
 	    }
 	    TclEmitPush(literal, envPtr);
 	} else {
-	    if (envPtr->clNext) {
-		SetLineInformation(i);
-	    }
+	    LineInformation(i);
 	    CompileTokens(envPtr, tokPtr, interp);
 	}
 	tokPtr = TokenAfter(tokPtr);
@@ -3255,12 +3254,10 @@ CompileBasicNArgCommand(
 
     tokenPtr = TokenAfter(parsePtr->tokenPtr);
     for (i=1 ; i<parsePtr->numWords ; i++) {
-	if (envPtr->clNext) {
-	    SetLineInformation(i);
-	}
 	if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
 	    PushLiteral(envPtr, tokenPtr[1].start, tokenPtr[1].size);
 	} else {
+	    LineInformation(i);
 	    CompileTokens(envPtr, tokenPtr, interp);
 	}
 	tokenPtr = TokenAfter(tokenPtr);
diff --git a/tests/info.test b/tests/info.test
index a68fb43..afdaaee 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -2346,6 +2346,31 @@ test info-33.31 {{*}, literal, simple, bytecompiled} -body {
 } -result {type source line 2339 file info.test cmd {info frame 0} proc ::foo::bar level 0}
 
 # -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    binary format {*}{
+    } [return [info frame 0]]
+}
+test info-33.32 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2352 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    set format format
+    binary $format {*}{
+    } [return [info frame 0]]
+}
+test info-33.33 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2365 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
 unset -nocomplain res
 
 # cleanup
-- 
cgit v0.12


From f0992177e479b4444b46592c2f5fc1ccfa1dac71 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 11 Jul 2013 04:00:57 +0000
Subject: Revert the revised macros used in developing the new tests.

---
 generic/tclCompCmds.c   | 20 ++++++++++----------
 generic/tclCompCmdsGR.c | 10 +++++-----
 generic/tclCompCmdsSZ.c | 12 ++++++------
 generic/tclCompile.h    |  5 +----
 generic/tclEnsemble.c   |  4 ++--
 5 files changed, 24 insertions(+), 27 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 28a3e64..a56727d 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -610,7 +610,7 @@ TclCompileCatchCmd(
      * begin by undeflowing the stack below the mark set by BEGIN_CATCH4.
      */
 
-    LineInformation(1);
+    SetLineInformation(1);
     if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
 	TclEmitInstInt4(	INST_BEGIN_CATCH4, range,	envPtr);
 	ExceptionRangeStarts(envPtr, range);
@@ -1467,7 +1467,7 @@ CompileDictEachCmd(
      * Compile the loop body itself. It should be stack-neutral.
      */
 
-    LineInformation(3);
+    SetLineInformation(3);
     CompileBody(envPtr, bodyTokenPtr, interp);
     if (collect == TCL_EACH_COLLECT) {
 	Emit14Inst(	INST_LOAD_SCALAR, keyVarIndex,		envPtr);
@@ -1651,7 +1651,7 @@ TclCompileDictUpdateCmd(
     TclEmitInstInt4(	INST_BEGIN_CATCH4, range,		envPtr);
 
     ExceptionRangeStarts(envPtr, range);
-    LineInformation(parsePtr->numWords - 1);
+    SetLineInformation(parsePtr->numWords - 1);
     CompileBody(envPtr, bodyTokenPtr, interp);
     ExceptionRangeEnds(envPtr, range);
 
@@ -1992,7 +1992,7 @@ TclCompileDictWithCmd(
     TclEmitInstInt4(		INST_BEGIN_CATCH4, range,	envPtr);
 
     ExceptionRangeStarts(envPtr, range);
-    LineInformation(parsePtr->numWords-1);
+    SetLineInformation(parsePtr->numWords-1);
     CompileBody(envPtr, tokenPtr, interp);
     ExceptionRangeEnds(envPtr, range);
 
@@ -2268,7 +2268,7 @@ TclCompileForCmd(
      * Inline compile the initial command.
      */
 
-    LineInformation(1);
+    SetLineInformation(1);
     CompileBody(envPtr, startTokenPtr, interp);
     TclEmitOpcode(INST_POP, envPtr);
 
@@ -2292,7 +2292,7 @@ TclCompileForCmd(
 
     bodyRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
     bodyCodeOffset = ExceptionRangeStarts(envPtr, bodyRange);
-    LineInformation(4);
+    SetLineInformation(4);
     CompileBody(envPtr, bodyTokenPtr, interp);
     ExceptionRangeEnds(envPtr, bodyRange);
     TclEmitOpcode(INST_POP, envPtr);
@@ -2306,7 +2306,7 @@ TclCompileForCmd(
     nextRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
     envPtr->exceptAuxArrayPtr[nextRange].supportsContinue = 0;
     nextCodeOffset = ExceptionRangeStarts(envPtr, nextRange);
-    LineInformation(3);
+    SetLineInformation(3);
     CompileBody(envPtr, nextTokenPtr, interp);
     ExceptionRangeEnds(envPtr, nextRange);
     TclEmitOpcode(INST_POP, envPtr);
@@ -2325,7 +2325,7 @@ TclCompileForCmd(
 	testCodeOffset += 3;
     }
 
-    LineInformation(2);
+    SetLineInformation(2);
     TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
 
     jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
@@ -2644,7 +2644,7 @@ CompileEachloopCmd(
 	    i < numWords-1;
 	    i++, tokenPtr = TokenAfter(tokenPtr)) {
 	if ((i%2 == 0) && (i > 0)) {
-	    LineInformation(i);
+	    SetLineInformation(i);
 	    CompileTokens(envPtr, tokenPtr, interp);
 	    tempVar = (firstValueTemp + loopIndex);
 	    Emit14Inst(		INST_STORE_SCALAR, tempVar,	envPtr);
@@ -2682,7 +2682,7 @@ CompileEachloopCmd(
      * Inline compile the loop body.
      */
 
-    LineInformation(numWords - 1);
+    SetLineInformation(numWords - 1);
     ExceptionRangeStarts(envPtr, range);
     CompileBody(envPtr, bodyTokenPtr, interp);
     ExceptionRangeEnds(envPtr, range);
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index 32514ab..f7c15e6 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -222,7 +222,7 @@ TclCompileIfCmd(
 		    compileScripts = 0;
 		}
 	    } else {
-		LineInformation(wordIdx);
+		SetLineInformation(wordIdx);
 		Tcl_ResetResult(interp);
 		TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
 		if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) {
@@ -264,7 +264,7 @@ TclCompileIfCmd(
 	 */
 
 	if (compileScripts) {
-	    LineInformation(wordIdx);
+	    SetLineInformation(wordIdx);
 	    CompileBody(envPtr, tokenPtr, interp);
 	}
 
@@ -345,7 +345,7 @@ TclCompileIfCmd(
 	     * Compile the else command body.
 	     */
 
-	    LineInformation(wordIdx);
+	    SetLineInformation(wordIdx);
 	    CompileBody(envPtr, tokenPtr, interp);
 	}
 
@@ -474,7 +474,7 @@ TclCompileIncrCmd(
 		PushLiteral(envPtr, word, numBytes);
 	    }
 	} else {
-	    LineInformation(2);
+	    SetLineInformation(2);
 	    CompileTokens(envPtr, incrTokenPtr, interp);
 	}
     } else {			/* No incr amount given so use 1. */
@@ -701,7 +701,7 @@ TclCompileInfoLevelCmd(
 	 * list of arguments.
 	 */
 
-	LineInformation(1);
+	SetLineInformation(1);
 	CompileTokens(envPtr, TokenAfter(parsePtr->tokenPtr), interp);
 	TclEmitOpcode(		INST_INFO_LEVEL_ARGS,		envPtr);
     }
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index d5208e6..0497e8a 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -86,7 +86,7 @@ const AuxDataType tclJumptableInfoType = {
 #define OP44(name,val1,val2) \
     TclEmitInstInt4(INST_##name,(val1),envPtr);TclEmitInt4((val2),envPtr)
 #define BODY(token,index) \
-    LineInformation((index));CompileBody(envPtr,(token),interp)
+    SetLineInformation((index));CompileBody(envPtr,(token),interp)
 #define PUSH(str) \
     PushStringLiteral(envPtr, str)
 #define JUMP4(name,var) \
@@ -433,7 +433,7 @@ TclCompileStringMatchCmd(
 	    }
 	    PushLiteral(envPtr, str, length);
 	} else {
-	    LineInformation(i+1+nocase);
+	    SetLineInformation(i+1+nocase);
 	    CompileTokens(envPtr, tokenPtr, interp);
 	}
 	tokenPtr = TokenAfter(tokenPtr);
@@ -483,7 +483,7 @@ TclCompileStringLenCmd(
 	len = sprintf(buf, "%d", len);
 	PushLiteral(envPtr, buf, len);
     } else {
-	LineInformation(1);
+	SetLineInformation(1);
 	CompileTokens(envPtr, tokenPtr, interp);
 	TclEmitOpcode(INST_STR_LEN, envPtr);
     }
@@ -722,7 +722,7 @@ TclCompileSubstCmd(
 	return TCL_ERROR;
     }
 
-    LineInformation(numArgs);
+    SetLineInformation(numArgs);
     TclSubstCompile(interp, wordTokenPtr[1].start, wordTokenPtr[1].size,
 	    flags, mapPtr->loc[eclIndex].line[numArgs], envPtr);
 
@@ -1284,7 +1284,7 @@ TclCompileSwitchCmd(
      */
 
     /* Both methods push the value to match against onto the stack. */
-    LineInformation(valueIndex);
+    SetLineInformation(valueIndex);
     CompileTokens(envPtr, valueTokenPtr, interp);
 
     if (mode == Switch_Exact) {
@@ -3026,7 +3026,7 @@ TclCompileWhileCmd(
 	    bodyCodeOffset += 3;
 	    testCodeOffset += 3;
 	}
-	LineInformation(1);
+	SetLineInformation(1);
 	TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
 
 	jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 5043f65..9af4911 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -1537,13 +1537,10 @@ MODULE_SCOPE Tcl_Obj	*TclNewInstNameObj(unsigned char inst);
     ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr;				\
     int eclIndex = mapPtr->nuloc - 1
 
-#define LineInformation(word) \
+#define SetLineInformation(word) \
     envPtr->line = mapPtr->loc[eclIndex].line[(word)];			\
     envPtr->clNext = mapPtr->loc[eclIndex].next[(word)]
 
-#define SetLineInformation(word)
-
-
 #define PushVarNameWord(i,v,e,f,l,sc,word) \
     TclPushVarName(i,v,e,f,l,sc,						\
 	    mapPtr->loc[eclIndex].line[(word)],				\
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 794a059..0bb7cb6 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -3180,7 +3180,7 @@ CompileToInvokedCommand(
 	    }
 	    TclEmitPush(literal, envPtr);
 	} else {
-	    LineInformation(i);
+	    SetLineInformation(i);
 	    CompileTokens(envPtr, tokPtr, interp);
 	}
 	tokPtr = TokenAfter(tokPtr);
@@ -3257,7 +3257,7 @@ CompileBasicNArgCommand(
 	if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
 	    PushLiteral(envPtr, tokenPtr[1].start, tokenPtr[1].size);
 	} else {
-	    LineInformation(i);
+	    SetLineInformation(i);
 	    CompileTokens(envPtr, tokenPtr, interp);
 	}
 	tokenPtr = TokenAfter(tokenPtr);
-- 
cgit v0.12


From d061b314608a3e053255b383590ad08040352ed2 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 11 Jul 2013 17:06:35 +0000
Subject: Have TclMakeEnsemble() set ENSEMBLE_COMPILE at creation, not as a
 separate epoch-bumping step.

---
 generic/tclEnsemble.c | 16 ++++++++--------
 1 file changed, 8 insertions(+), 8 deletions(-)

diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 0bb7cb6..680ab45d 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -1527,6 +1527,14 @@ TclMakeEnsemble(
 	    cmdName = nameParts[nameCount - 1];
 	}
     }
+
+    /*
+     * Switch on compilation always for core ensembles now that we can do
+     * nice bytecode things with them.  Do it now.  Waiting until later will
+     * just cause pointless epoch bumps.
+     */
+
+    ensembleFlags |= ENSEMBLE_COMPILE;
     ensemble = Tcl_CreateEnsemble(interp, cmdName, ns, ensembleFlags);
 
     /*
@@ -1578,14 +1586,6 @@ TclMakeEnsemble(
 	    }
 	}
 	Tcl_SetEnsembleMappingDict(interp, ensemble, mapDict);
-
-	/*
-	 * Switch on compilation always for core ensembles now that we can do
-	 * nice bytecode things with them.
-	 */
-
-	Tcl_SetEnsembleFlags(interp, ensemble,
-		ensembleFlags | ENSEMBLE_COMPILE);
     }
 
     Tcl_DStringFree(&buf);
-- 
cgit v0.12


From f302557ad523241b8da238efc187df31149d5d6a Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 11 Jul 2013 23:19:14 +0000
Subject: Revise the CompileWord() and PushVarNameWord() macros to make
 explicit the SetLineInformation() that's in each of them.

---
 generic/tclCompCmds.c |  9 +--------
 generic/tclCompile.h  | 16 ++++++----------
 2 files changed, 7 insertions(+), 18 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index a56727d..0a1a739 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -3164,10 +3164,7 @@ TclPushVarName(
     CompileEnv *envPtr,		/* Holds resulting instructions. */
     int flags,			/* TCL_NO_LARGE_INDEX | TCL_NO_ELEMENT. */
     int *localIndexPtr,		/* Must not be NULL. */
-    int *isScalarPtr,		/* Must not be NULL. */
-    int line,			/* Line the token starts on. */
-    int *clNext)		/* Reference to offset of next hidden cont.
-				 * line. */
+    int *isScalarPtr)		/* Must not be NULL. */
 {
     register const char *p;
     const char *name, *elName;
@@ -3347,8 +3344,6 @@ TclPushVarName(
 
 	if (elName != NULL && !(flags & TCL_NO_ELEMENT)) {
 	    if (elNameChars) {
-		envPtr->line = line;
-		envPtr->clNext = clNext;
 		TclCompileTokens(interp, elemTokenPtr, elemTokenCount,
 			envPtr);
 	    } else {
@@ -3360,8 +3355,6 @@ TclPushVarName(
 	 * The var name isn't simple: compile and push it.
 	 */
 
-	envPtr->line = line;
-	envPtr->clNext = clNext;
 	CompileTokens(envPtr, varTokenPtr, interp);
     }
 
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 9af4911..a4ebd96 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -1074,7 +1074,7 @@ MODULE_SCOPE void	TclPrintSource(FILE *outFile,
 MODULE_SCOPE void	TclPushVarName(Tcl_Interp *interp,
 			    Tcl_Token *varTokenPtr, CompileEnv *envPtr,
 			    int flags, int *localIndexPtr,
-			    int *isScalarPtr, int line, int *clNext);
+			    int *isScalarPtr);
 MODULE_SCOPE int	TclRegisterLiteral(CompileEnv *envPtr,
 			    char *bytes, int length, int flags);
 MODULE_SCOPE void	TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);
@@ -1515,13 +1515,10 @@ MODULE_SCOPE Tcl_Obj	*TclNewInstNameObj(unsigned char inst);
 
 #define CompileWord(envPtr, tokenPtr, interp, word) \
     if ((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD) {			\
-	TclEmitPush(TclRegisterNewLiteral((envPtr), (tokenPtr)[1].start, \
-		(tokenPtr)[1].size), (envPtr));				\
+	PushLiteral((envPtr), (tokenPtr)[1].start, (tokenPtr)[1].size);	\
     } else {								\
-	envPtr->line = mapPtr->loc[eclIndex].line[word];		\
-	envPtr->clNext = mapPtr->loc[eclIndex].next[word];		\
-	TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \
-		(envPtr));						\
+	SetLineInformation((word));					\
+	CompileTokens((envPtr), (tokenPtr), (interp));			\
     }
 
 /*
@@ -1542,9 +1539,8 @@ MODULE_SCOPE Tcl_Obj	*TclNewInstNameObj(unsigned char inst);
     envPtr->clNext = mapPtr->loc[eclIndex].next[(word)]
 
 #define PushVarNameWord(i,v,e,f,l,sc,word) \
-    TclPushVarName(i,v,e,f,l,sc,						\
-	    mapPtr->loc[eclIndex].line[(word)],				\
-	    mapPtr->loc[eclIndex].next[(word)])
+    SetLineInformation(word);						\
+    TclPushVarName(i,v,e,f,l,sc)					
 
 /*
  * Often want to issue one of two versions of an instruction based on whether
-- 
cgit v0.12


From 451ab6927c1c2a1b56c335ce110de9c655a2069e Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 12 Jul 2013 16:25:51 +0000
Subject: Tests demonstrating the need for the last two SetLineInformation()
 calls.

---
 tests/info.test | 25 +++++++++++++++++++++++++
 1 file changed, 25 insertions(+)

diff --git a/tests/info.test b/tests/info.test
index afdaaee..3057dd2 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -2371,6 +2371,31 @@ test info-33.33 {{*}, literal, simple, bytecompiled} -body {
 } -result {type source line 2365 file info.test cmd {info frame 0} proc ::foo::bar level 0}
 
 # -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    append x {*}{
+    } [return [info frame 0]]
+}
+test info-33.34 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2377 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    append {*}{
+    } x([return [info frame 0]]) {*}{
+    } a
+}
+test info-33.35 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2389 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
 unset -nocomplain res
 
 # cleanup
-- 
cgit v0.12


From 740d1811bca3d4f0ba8ca8b79eaa1edec3292d1b Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 12 Jul 2013 18:44:15 +0000
Subject: Global replace: CompileBody() -> BODY().

---
 generic/tclCompCmds.c   | 25 +++++++++----------------
 generic/tclCompCmdsGR.c |  6 ++----
 generic/tclCompCmdsSZ.c |  4 +---
 generic/tclCompile.h    | 14 +++++++-------
 4 files changed, 19 insertions(+), 30 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 0a1a739..561d816 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -610,12 +610,12 @@ TclCompileCatchCmd(
      * begin by undeflowing the stack below the mark set by BEGIN_CATCH4.
      */
 
-    SetLineInformation(1);
     if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
 	TclEmitInstInt4(	INST_BEGIN_CATCH4, range,	envPtr);
 	ExceptionRangeStarts(envPtr, range);
-	CompileBody(envPtr, cmdTokenPtr, interp);
+	BODY(cmdTokenPtr, 1);
     } else {
+	SetLineInformation(1);
 	CompileTokens(envPtr, cmdTokenPtr, interp);
 	TclEmitInstInt4(	INST_BEGIN_CATCH4, range,	envPtr);
 	ExceptionRangeStarts(envPtr, range);
@@ -1467,8 +1467,7 @@ CompileDictEachCmd(
      * Compile the loop body itself. It should be stack-neutral.
      */
 
-    SetLineInformation(3);
-    CompileBody(envPtr, bodyTokenPtr, interp);
+    BODY(bodyTokenPtr, 3);
     if (collect == TCL_EACH_COLLECT) {
 	Emit14Inst(	INST_LOAD_SCALAR, keyVarIndex,		envPtr);
 	TclEmitInstInt4(INST_OVER, 1,				envPtr);
@@ -1651,8 +1650,7 @@ TclCompileDictUpdateCmd(
     TclEmitInstInt4(	INST_BEGIN_CATCH4, range,		envPtr);
 
     ExceptionRangeStarts(envPtr, range);
-    SetLineInformation(parsePtr->numWords - 1);
-    CompileBody(envPtr, bodyTokenPtr, interp);
+    BODY(bodyTokenPtr, parsePtr->numWords - 1);
     ExceptionRangeEnds(envPtr, range);
 
     /*
@@ -1992,8 +1990,7 @@ TclCompileDictWithCmd(
     TclEmitInstInt4(		INST_BEGIN_CATCH4, range,	envPtr);
 
     ExceptionRangeStarts(envPtr, range);
-    SetLineInformation(parsePtr->numWords-1);
-    CompileBody(envPtr, tokenPtr, interp);
+    BODY(tokenPtr, parsePtr->numWords - 1);
     ExceptionRangeEnds(envPtr, range);
 
     /*
@@ -2268,8 +2265,7 @@ TclCompileForCmd(
      * Inline compile the initial command.
      */
 
-    SetLineInformation(1);
-    CompileBody(envPtr, startTokenPtr, interp);
+    BODY(startTokenPtr, 1);
     TclEmitOpcode(INST_POP, envPtr);
 
     /*
@@ -2292,8 +2288,7 @@ TclCompileForCmd(
 
     bodyRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
     bodyCodeOffset = ExceptionRangeStarts(envPtr, bodyRange);
-    SetLineInformation(4);
-    CompileBody(envPtr, bodyTokenPtr, interp);
+    BODY(bodyTokenPtr, 4);
     ExceptionRangeEnds(envPtr, bodyRange);
     TclEmitOpcode(INST_POP, envPtr);
 
@@ -2306,8 +2301,7 @@ TclCompileForCmd(
     nextRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
     envPtr->exceptAuxArrayPtr[nextRange].supportsContinue = 0;
     nextCodeOffset = ExceptionRangeStarts(envPtr, nextRange);
-    SetLineInformation(3);
-    CompileBody(envPtr, nextTokenPtr, interp);
+    BODY(nextTokenPtr, 3);
     ExceptionRangeEnds(envPtr, nextRange);
     TclEmitOpcode(INST_POP, envPtr);
 
@@ -2682,9 +2676,8 @@ CompileEachloopCmd(
      * Inline compile the loop body.
      */
 
-    SetLineInformation(numWords - 1);
     ExceptionRangeStarts(envPtr, range);
-    CompileBody(envPtr, bodyTokenPtr, interp);
+    BODY(bodyTokenPtr, numWords - 1);
     ExceptionRangeEnds(envPtr, range);
 
     if (collect == TCL_EACH_COLLECT) {
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index f7c15e6..0572cd3 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -264,8 +264,7 @@ TclCompileIfCmd(
 	 */
 
 	if (compileScripts) {
-	    SetLineInformation(wordIdx);
-	    CompileBody(envPtr, tokenPtr, interp);
+	    BODY(tokenPtr, wordIdx);
 	}
 
 	if (realCond) {
@@ -345,8 +344,7 @@ TclCompileIfCmd(
 	     * Compile the else command body.
 	     */
 
-	    SetLineInformation(wordIdx);
-	    CompileBody(envPtr, tokenPtr, interp);
+	    BODY(tokenPtr, wordIdx);
 	}
 
 	/*
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 0497e8a..19e636d 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -85,8 +85,6 @@ const AuxDataType tclJumptableInfoType = {
     TclEmitInstInt1(INST_##name,(val1),envPtr);TclEmitInt4((val2),envPtr)
 #define OP44(name,val1,val2) \
     TclEmitInstInt4(INST_##name,(val1),envPtr);TclEmitInt4((val2),envPtr)
-#define BODY(token,index) \
-    SetLineInformation((index));CompileBody(envPtr,(token),interp)
 #define PUSH(str) \
     PushStringLiteral(envPtr, str)
 #define JUMP4(name,var) \
@@ -1499,7 +1497,7 @@ IssueSwitchChainedTests(
 	}
 
 	/*
-	 * Now do the actual compilation. Note that we do not use CompileBody
+	 * Now do the actual compilation. Note that we do not use BODY() 
 	 * because we may have synthesized the tokens in a non-standard
 	 * pattern.
 	 */
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index a4ebd96..cf8475d 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -1407,16 +1407,16 @@ MODULE_SCOPE Tcl_Obj	*TclNewInstNameObj(unsigned char inst);
 #define TclMax(i, j)	((((int) i) > ((int) j))? (i) : (j))
 
 /*
- * Convenience macro for use when compiling bodies of commands. The ANSI C
- * "prototype" for this macro is:
+ * Convenience macros for use when compiling bodies of commands. The ANSI C
+ * "prototype" for these macros are:
  *
- * static void		CompileBody(CompileEnv *envPtr, Tcl_Token *tokenPtr,
- *			    Tcl_Interp *interp);
+ * static void		BODY(Tcl_Token *tokenPtr, int word);
  */
 
-#define CompileBody(envPtr, tokenPtr, interp) \
-    TclCompileCmdWord((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \
-	    (envPtr))
+#define BODY(tokenPtr, word)						\
+    SetLineInformation((word));						\
+    TclCompileCmdWord(interp, (tokenPtr)+1, (tokenPtr)->numComponents,	\
+	    envPtr)
 
 /*
  * Convenience macro for use when compiling tokens to be pushed. The ANSI C
-- 
cgit v0.12


From 774c4023655381f0f5d722f19ae8bed785ebff58 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 15 Jul 2013 17:07:51 +0000
Subject: Prefer CompileWord() over CompileTokens() when possible.

---
 generic/tclCompCmds.c   | 3 +--
 generic/tclCompCmdsGR.c | 3 +--
 generic/tclCompCmdsSZ.c | 3 +--
 3 files changed, 3 insertions(+), 6 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 561d816..37ce335 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -2638,8 +2638,7 @@ CompileEachloopCmd(
 	    i < numWords-1;
 	    i++, tokenPtr = TokenAfter(tokenPtr)) {
 	if ((i%2 == 0) && (i > 0)) {
-	    SetLineInformation(i);
-	    CompileTokens(envPtr, tokenPtr, interp);
+	    CompileWord(envPtr, tokenPtr, interp, i);
 	    tempVar = (firstValueTemp + loopIndex);
 	    Emit14Inst(		INST_STORE_SCALAR, tempVar,	envPtr);
 	    TclEmitOpcode(	INST_POP,			envPtr);
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index 0572cd3..2c71dc5 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -699,8 +699,7 @@ TclCompileInfoLevelCmd(
 	 * list of arguments.
 	 */
 
-	SetLineInformation(1);
-	CompileTokens(envPtr, TokenAfter(parsePtr->tokenPtr), interp);
+	CompileWord(envPtr, TokenAfter(parsePtr->tokenPtr), interp, 1);
 	TclEmitOpcode(		INST_INFO_LEVEL_ARGS,		envPtr);
     }
     return TCL_OK;
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 19e636d..3a91c83 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -1282,8 +1282,7 @@ TclCompileSwitchCmd(
      */
 
     /* Both methods push the value to match against onto the stack. */
-    SetLineInformation(valueIndex);
-    CompileTokens(envPtr, valueTokenPtr, interp);
+    CompileWord(envPtr, valueTokenPtr, interp, valueIndex);
 
     if (mode == Switch_Exact) {
 	IssueSwitchJumpTable(interp, envPtr, valueIndex, numWords, bodyToken,
-- 
cgit v0.12


From d860a2c3a49e049350838d0ee2e259e7f8b4c3e6 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 15 Jul 2013 20:16:11 +0000
Subject: Build CompileBasicNArgCommand on top of TclCompileInvocation.

---
 generic/tclBasic.c    | 22 ++++++++++++++++++----
 generic/tclCompile.c  |  6 +++---
 generic/tclCompile.h  |  3 +++
 generic/tclEnsemble.c | 10 ++++++++++
 4 files changed, 34 insertions(+), 7 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index b2a505a..963b53a 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -5633,6 +5633,24 @@ TclArgumentBCEnter(
 	CFWordBC *lastPtr = NULL;
 
 	/*
+	 * ePtr->nline is the number of words originally parsed.
+	 *
+	 * objc is the number of elements getting invoked.
+	 *
+	 * If they are not the same, we arrived here by compiling an
+	 * ensemble dispatch.  Ensemble subcommands that lead to script
+	 * evaluation are not supposed to get compiled, because a command
+	 * such as [info level] in the script can expose some of the dispatch
+	 * shenanigans.  This means that we don't have to tend to the 
+	 * housekeeping, and can escape now.
+	 */
+	
+	if (ePtr->nline != objc) {
+	    return;
+	}
+
+	/*
+	 * Having disposed of the ensemble cases, we can state...
 	 * A few truths ...
 	 * (1) ePtr->nline == objc
 	 * (2) (ePtr->line[word] < 0) => !literal, for all words
@@ -5642,10 +5660,6 @@ TclArgumentBCEnter(
 	 * have to save them at compile time.
 	 */
 
-        if (ePtr->nline != objc) {
-            Tcl_Panic ("TIP 280 data structure inconsistency");
-        }
-
 	for (word = 1; word < objc; word++) {
 	    if (ePtr->line[word] >= 0) {
 		int isnew;
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 5f4acff..a2c7131 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1777,8 +1777,8 @@ CompileCmdLiteral(
     TclEmitPush(cmdLitIdx, envPtr);
 }
 
-static void
-CompileInvocation(
+void
+TclCompileInvocation(
     Tcl_Interp *interp,
     Tcl_Token *tokenPtr,
     Tcl_Obj *cmdObj,
@@ -2095,7 +2095,7 @@ CompileCommandTokens(
 	    CompileExpanded(interp, parsePtr->tokenPtr,
 		    cmdKnown ? cmdObj : NULL, parsePtr->numWords, envPtr);
 	} else {
-	    CompileInvocation(interp, parsePtr->tokenPtr,
+	    TclCompileInvocation(interp, parsePtr->tokenPtr,
 		    cmdKnown ? cmdObj : NULL, parsePtr->numWords, envPtr);
 	}
     }
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 0bcd84e..b94bd93 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -1003,6 +1003,9 @@ MODULE_SCOPE void	TclCompileExpr(Tcl_Interp *interp, const char *script,
 MODULE_SCOPE void	TclCompileExprWords(Tcl_Interp *interp,
 			    Tcl_Token *tokenPtr, int numWords,
 			    CompileEnv *envPtr);
+MODULE_SCOPE void	TclCompileInvocation(Tcl_Interp *interp,
+			    Tcl_Token *tokenPtr, Tcl_Obj *cmdObj, int numWords,
+			    CompileEnv *envPtr);
 MODULE_SCOPE void	TclCompileScript(Tcl_Interp *interp,
 			    const char *script, int numBytes,
 			    CompileEnv *envPtr);
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 680ab45d..9b6ca92 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -3229,6 +3229,15 @@ CompileBasicNArgCommand(
 				 * compiled. */
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
+#if 1
+    Tcl_Obj *objPtr = Tcl_NewObj();
+
+    Tcl_IncrRefCount(objPtr);
+    Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
+    TclCompileInvocation(interp, parsePtr->tokenPtr, objPtr,
+	    parsePtr->numWords, envPtr);
+    Tcl_DecrRefCount(objPtr);
+#else
     Tcl_Token *tokenPtr;
     Tcl_Obj *objPtr;
     char *bytes;
@@ -3272,6 +3281,7 @@ CompileBasicNArgCommand(
     } else {
 	TclEmitInstInt4(INST_INVOKE_STK4, i, envPtr);
     }
+#endif
     return TCL_OK;
 }
 
-- 
cgit v0.12


From d848f30c4545739e202b7df265b942a79b284fba Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 16 Jul 2013 14:07:41 +0000
Subject: Eliminate the litInfo table and all the code tending to its care and
 feeding. The pc -> command index mapping function it provided can be achieved
 using other data already in the ByteCode struct.

---
 generic/tclBasic.c   | 134 +++++++++++++++++++++++++--------------------------
 generic/tclCompile.c |  43 -----------------
 generic/tclCompile.h |   8 ---
 generic/tclExecute.c |  44 ++++++++++++-----
 generic/tclInt.h     |   2 +-
 5 files changed, 97 insertions(+), 134 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 963b53a..bd4f157 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -1609,8 +1609,6 @@ DeleteInterpProc(
 	    ckfree(eclPtr->loc);
 	}
 
-	Tcl_DeleteHashTable(&eclPtr->litInfo);
-
 	ckfree(eclPtr);
 	Tcl_DeleteHashEntry(hPtr);
     }
@@ -5614,90 +5612,88 @@ TclArgumentBCEnter(
     int objc,
     void *codePtr,
     CmdFrame *cfPtr,
+    int cmd,
     int pc)
 {
+    ExtCmdLoc *eclPtr;
+    int word;
+    ECL *ePtr;
+    CFWordBC *lastPtr = NULL;
     Interp *iPtr = (Interp *) interp;
     Tcl_HashEntry *hePtr =
 	    Tcl_FindHashEntry(iPtr->lineBCPtr, (char *) codePtr);
-    ExtCmdLoc *eclPtr;
 
     if (!hePtr) {
 	return;
     }
     eclPtr = Tcl_GetHashValue(hePtr);
-    hePtr = Tcl_FindHashEntry(&eclPtr->litInfo, INT2PTR(pc));
-    if (hePtr) {
-	int word;
-	int cmd = PTR2INT(Tcl_GetHashValue(hePtr));
-	ECL *ePtr = &eclPtr->loc[cmd];
-	CFWordBC *lastPtr = NULL;
+    ePtr = &eclPtr->loc[cmd];
 
-	/*
-	 * ePtr->nline is the number of words originally parsed.
-	 *
-	 * objc is the number of elements getting invoked.
-	 *
-	 * If they are not the same, we arrived here by compiling an
-	 * ensemble dispatch.  Ensemble subcommands that lead to script
-	 * evaluation are not supposed to get compiled, because a command
-	 * such as [info level] in the script can expose some of the dispatch
-	 * shenanigans.  This means that we don't have to tend to the 
-	 * housekeeping, and can escape now.
-	 */
+    /*
+     * ePtr->nline is the number of words originally parsed.
+     *
+     * objc is the number of elements getting invoked.
+     *
+     * If they are not the same, we arrived here by compiling an
+     * ensemble dispatch.  Ensemble subcommands that lead to script
+     * evaluation are not supposed to get compiled, because a command
+     * such as [info level] in the script can expose some of the dispatch
+     * shenanigans.  This means that we don't have to tend to the 
+     * housekeeping, and can escape now.
+     */
 	
-	if (ePtr->nline != objc) {
-	    return;
-	}
+    if (ePtr->nline != objc) {
+        return;
+    }
 
-	/*
-	 * Having disposed of the ensemble cases, we can state...
-	 * A few truths ...
-	 * (1) ePtr->nline == objc
-	 * (2) (ePtr->line[word] < 0) => !literal, for all words
-	 * (3) (word == 0) => !literal
-	 *
-	 * Item (2) is why we can use objv to get the literals, and do not
-	 * have to save them at compile time.
-	 */
+    /*
+     * Having disposed of the ensemble cases, we can state...
+     * A few truths ...
+     * (1) ePtr->nline == objc
+     * (2) (ePtr->line[word] < 0) => !literal, for all words
+     * (3) (word == 0) => !literal
+     *
+     * Item (2) is why we can use objv to get the literals, and do not
+     * have to save them at compile time.
+     */
 
-	for (word = 1; word < objc; word++) {
-	    if (ePtr->line[word] >= 0) {
-		int isnew;
-		Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(iPtr->lineLABCPtr,
-			objv[word], &isnew);
-		CFWordBC *cfwPtr = ckalloc(sizeof(CFWordBC));
-
-		cfwPtr->framePtr = cfPtr;
-		cfwPtr->obj = objv[word];
-		cfwPtr->pc = pc;
-		cfwPtr->word = word;
-		cfwPtr->nextPtr = lastPtr;
-		lastPtr = cfwPtr;
-
-		if (isnew) {
-		    /*
-		     * The word is not on the stack yet, remember the current
-		     * location and initialize references.
-		     */
-
-		    cfwPtr->prevPtr = NULL;
-		} else {
-		    /*
-		     * The object is already on the stack, however it may have
-		     * a different location now (literal sharing may map
-		     * multiple location to a single Tcl_Obj*. Save the old
-		     * information in the new structure.
-		     */
-
-		    cfwPtr->prevPtr = Tcl_GetHashValue(hPtr);
-		}
+    for (word = 1; word < objc; word++) {
+	if (ePtr->line[word] >= 0) {
+	    int isnew;
+	    Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(iPtr->lineLABCPtr,
+		objv[word], &isnew);
+	    CFWordBC *cfwPtr = ckalloc(sizeof(CFWordBC));
 
-		Tcl_SetHashValue(hPtr, cfwPtr);
+	    cfwPtr->framePtr = cfPtr;
+	    cfwPtr->obj = objv[word];
+	    cfwPtr->pc = pc;
+	    cfwPtr->word = word;
+	    cfwPtr->nextPtr = lastPtr;
+	    lastPtr = cfwPtr;
+
+	    if (isnew) {
+		/*
+		 * The word is not on the stack yet, remember the current
+		 * location and initialize references.
+		 */
+
+		cfwPtr->prevPtr = NULL;
+	    } else {
+		/*
+		 * The object is already on the stack, however it may have
+		 * a different location now (literal sharing may map
+		 * multiple location to a single Tcl_Obj*. Save the old
+		 * information in the new structure.
+		 */
+
+		cfwPtr->prevPtr = Tcl_GetHashValue(hPtr);
 	    }
-	} /* for */
 
-	cfPtr->litarg = lastPtr;
-    } /* if */
+	    Tcl_SetHashValue(hPtr, cfwPtr);
+	}
+    } /* for */
+
+    cfPtr->litarg = lastPtr;
 }
 
 /*
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index a2c7131..7e0be76 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1296,8 +1296,6 @@ ReleaseCmdWordData(
 	ckfree((char *) eclPtr->loc);
     }
 
-    Tcl_DeleteHashTable (&eclPtr->litInfo);
-
     ckfree((char *) eclPtr);
 }
 
@@ -1382,7 +1380,6 @@ TclInitCompileEnv(
     envPtr->extCmdMapPtr->nloc = 0;
     envPtr->extCmdMapPtr->nuloc = 0;
     envPtr->extCmdMapPtr->path = NULL;
-    Tcl_InitHashTable(&envPtr->extCmdMapPtr->litInfo, TCL_ONE_WORD_KEYS);
 
     if ((invoker == NULL) || (invoker->type == TCL_LOCATION_EVAL_LIST)) {
 	/*
@@ -1814,12 +1811,6 @@ TclCompileInvocation(
 	TclEmitPush(objIdx, envPtr);
     }
 
-    /*
-     * Save PC -> command map for the TclArgumentBC* functions.
-     */
-
-    mapPtr->loc[eclIndex].invokePc = envPtr->codeNext - envPtr->codeStart;
-
     if (wordIdx <= 255) {
 	TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr);
     } else {
@@ -2001,7 +1992,6 @@ CompileCmdCompileProc(
 	mapPtr->nuloc--;
 	ckfree(mapPtr->loc[mapPtr->nuloc].line);
 	mapPtr->loc[mapPtr->nuloc].line = NULL;
-	mapPtr->loc[mapPtr->nuloc].invokePc = -1;
     }
 
     SetLineInformation(0);
@@ -3325,17 +3315,6 @@ TclInitByteCodeObj(
      * byte code object (internal rep), for use with the bc compiler.
      */
 
-    for (i = 0;  i < envPtr->extCmdMapPtr->nuloc;  i++) {
-	int isnew, pc = envPtr->extCmdMapPtr->loc[i].invokePc;
-
-	if (pc < 0) {
-	    continue;
-	}
-
-	Tcl_SetHashValue(Tcl_CreateHashEntry(&envPtr->extCmdMapPtr->litInfo,
-	    INT2PTR(pc), &isnew), INT2PTR(i));
-    }
-
     Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->lineBCPtr, codePtr,
 	    &isNew), envPtr->extCmdMapPtr);
     envPtr->extCmdMapPtr = NULL;
@@ -3706,7 +3685,6 @@ EnterCmdWordData(
 
     ePtr = &eclPtr->loc[eclPtr->nuloc];
     ePtr->srcOffset = srcOffset;
-    ePtr->invokePc = -1;
     ePtr->line = ckalloc(numWords * sizeof(int));
     ePtr->next = ckalloc(numWords * sizeof(int *));
     ePtr->nline = numWords;
@@ -4477,27 +4455,6 @@ TclFixupForwardJump(
 	}
     }
 
-    /*
-     * TIP #280: Adjust the mapping from PC values to the per-command
-     * information about arguments and their line numbers.
-     *
-     * Note: We cannot simply remove an out-of-date entry and then reinsert
-     * with the proper PC, because then we might overwrite another entry which
-     * was at that location. Therefore we pull (copy + delete) all effected
-     * entries (beyond the fixed PC) into an array, update them there, and at
-     * last reinsert them all.
-     */
-
-    {
-	ExtCmdLoc* eclPtr = envPtr->extCmdMapPtr;
-	for (k = eclPtr->nuloc - 1; k >= 0; k--) {
-	    if (eclPtr->loc[k].invokePc < (jumpFixupPtr->codeOffset + 2)) {
-		continue;
-	    }
-	    eclPtr->loc[k].invokePc += 3;
-	}
-    }
-
     return 1;			/* the jump was grown */
 }
 
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index b94bd93..f70f8f7 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -175,7 +175,6 @@ typedef struct CmdLocation {
 
 typedef struct ECL {
     int srcOffset;		/* Command location to find the entry. */
-    int invokePc;
     int nline;			/* Number of words in the command */
     int *line;			/* Line information for all words in the
 				 * command. */
@@ -194,13 +193,6 @@ typedef struct ExtCmdLoc {
     ECL *loc;			/* Command word locations (lines). */
     int nloc;			/* Number of allocated entries in 'loc'. */
     int nuloc;			/* Number of used entries in 'loc'. */
-    Tcl_HashTable litInfo;	/* Indexed by bytecode 'PC', to have the
-				 * information accessible per command and
-				 * argument, not per whole bytecode. Value is
-				 * index of command in 'loc', giving us the
-				 * literals to associate with line information
-				 * as command argument, see
-				 * TclArgumentBCEnter() */
 } ExtCmdLoc;
 
 /*
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 37bf072..f8ed667 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -721,7 +721,7 @@ static ExceptionRange *	GetExceptRangeForPc(const unsigned char *pc,
 			    int catchOnly, ByteCode *codePtr);
 static const char *	GetSrcInfoForPc(const unsigned char *pc,
 			    ByteCode *codePtr, int *lengthPtr,
-			    const unsigned char **pcBeg);
+			    const unsigned char **pcBeg, int *cmdIdxPtr);
 static Tcl_Obj **	GrowEvaluationStack(ExecEnv *eePtr, int growth,
 			    int move);
 static void		IllegalExprOperandType(Tcl_Interp *interp,
@@ -2431,8 +2431,11 @@ TEBCresume(
 	iPtr->cmdFramePtr = bcFramePtr;
 
 	if (iPtr->flags & INTERP_DEBUG_FRAME) {
-	    TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
-		    codePtr, bcFramePtr, pc - codePtr->codeStart);
+	    int cmd;
+	    if (GetSrcInfoForPc(pc, codePtr, NULL, NULL, &cmd)) {
+		TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
+			codePtr, bcFramePtr, cmd, pc - codePtr->codeStart);
+	    }
 	}
 
 	pc++;
@@ -2885,8 +2888,11 @@ TEBCresume(
 	iPtr->cmdFramePtr = bcFramePtr;
 
 	if (iPtr->flags & INTERP_DEBUG_FRAME) {
-	    TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
-		    codePtr, bcFramePtr, pc - codePtr->codeStart);
+	    int cmd;
+	    if (GetSrcInfoForPc(pc, codePtr, NULL, NULL, &cmd)) {
+		TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
+			codePtr, bcFramePtr, cmd, pc - codePtr->codeStart);
+	    }
 	}
 
 	DECACHE_STACK_INFO();
@@ -3031,8 +3037,11 @@ TEBCresume(
 	bcFramePtr->data.tebc.pc = (char *) pc;
 	iPtr->cmdFramePtr = bcFramePtr;
 	if (iPtr->flags & INTERP_DEBUG_FRAME) {
-	    TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
-		    codePtr, bcFramePtr, pc - codePtr->codeStart);
+	    int cmd;
+	    if (GetSrcInfoForPc(pc, codePtr, NULL, NULL, &cmd)) {
+		TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
+			codePtr, bcFramePtr, cmd, pc - codePtr->codeStart);
+	    }
 	}
 	iPtr->ensembleRewrite.sourceObjs = objv;
 	iPtr->ensembleRewrite.numRemovedObjs = opnd;
@@ -6967,7 +6976,7 @@ TEBCresume(
 	if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
 	    const unsigned char *pcBeg;
 
-	    bytes = GetSrcInfoForPc(pc, codePtr, &length, &pcBeg);
+	    bytes = GetSrcInfoForPc(pc, codePtr, &length, &pcBeg, NULL);
 	    DECACHE_STACK_INFO();
 	    TclLogCommandInfo(interp, codePtr->source, bytes,
 		    bytes ? length : 0, pcBeg, tosPtr);
@@ -7149,7 +7158,7 @@ TEBCresume(
 	    }
 
 	    codePtr->flags |= TCL_BYTECODE_RECOMPILE;
-	    bytes = GetSrcInfoForPc(pc, codePtr, &length, NULL);
+	    bytes = GetSrcInfoForPc(pc, codePtr, &length, NULL, NULL);
 	    opnd = TclGetUInt4AtPtr(pc+1);
 	    pc += (opnd-1);
 	    PUSH_OBJECT(Tcl_NewStringObj(bytes, length));
@@ -8642,7 +8651,7 @@ ValidatePcAndStackTop(
     if (checkStack && 
 	    ((stackTop < 0) || (stackTop > stackUpperBound))) {
 	int numChars;
-	const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL);
+	const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL, NULL);
 
 	fprintf(stderr, "\nBad stack top %d at pc %u in TclNRExecuteByteCode (min 0, max %i)",
 		stackTop, relativePc, stackUpperBound);
@@ -8756,7 +8765,7 @@ TclGetSrcInfoForCmd(
     ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr;
 
     return GetSrcInfoForPc((unsigned char *) cfPtr->data.tebc.pc,
-	    codePtr, lenPtr, NULL);
+	    codePtr, lenPtr, NULL, NULL);
 }
 
 void
@@ -8768,7 +8777,7 @@ TclGetSrcInfoForPc(
     if (cfPtr->cmd.str.cmd == NULL) {
 	cfPtr->cmd.str.cmd = GetSrcInfoForPc(
 		(unsigned char *) cfPtr->data.tebc.pc, codePtr,
-		&cfPtr->cmd.str.len, NULL);
+		&cfPtr->cmd.str.len, NULL, NULL);
     }
 
     if (cfPtr->cmd.str.cmd != NULL) {
@@ -8828,9 +8837,12 @@ GetSrcInfoForPc(
     int *lengthPtr,		/* If non-NULL, the location where the length
 				 * of the command's source should be stored.
 				 * If NULL, no length is stored. */
-    const unsigned char **pcBeg)/* If non-NULL, the bytecode location
+    const unsigned char **pcBeg,/* If non-NULL, the bytecode location
 				 * where the current instruction starts.
 				 * If NULL; no pointer is stored. */
+    int *cmdIdxPtr)		/* If non-NULL, the location where the index
+				 * of the command containing the pc should 
+				 * be stored. */
 {
     register int pcOffset = (pc - codePtr->codeStart);
     int numCmds = codePtr->numCommands;
@@ -8840,6 +8852,7 @@ GetSrcInfoForPc(
     int bestDist = INT_MAX;	/* Distance of pc to best cmd's start pc. */
     int bestSrcOffset = -1;	/* Initialized to avoid compiler warning. */
     int bestSrcLength = -1;	/* Initialized to avoid compiler warning. */
+    int bestCmdIdx = -1;
 
     if ((pcOffset < 0) || (pcOffset >= codePtr->numCodeBytes)) {
 	if (pcBeg != NULL) *pcBeg = NULL;
@@ -8907,6 +8920,7 @@ GetSrcInfoForPc(
 		bestDist = dist;
 		bestSrcOffset = srcOffset;
 		bestSrcLength = srcLen;
+		bestCmdIdx = i;
 	    }
 	}
     }
@@ -8936,6 +8950,10 @@ GetSrcInfoForPc(
 	*lengthPtr = bestSrcLength;
     }
 
+    if (cmdIdxPtr != NULL) {
+	*cmdIdxPtr = bestCmdIdx;
+    }
+
     return (codePtr->source + bestSrcOffset);
 }
 
diff --git a/generic/tclInt.h b/generic/tclInt.h
index b940225..da09366 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2828,7 +2828,7 @@ MODULE_SCOPE void	TclArgumentRelease(Tcl_Interp *interp,
 			    Tcl_Obj *objv[], int objc);
 MODULE_SCOPE void	TclArgumentBCEnter(Tcl_Interp *interp,
 			    Tcl_Obj *objv[], int objc,
-			    void *codePtr, CmdFrame *cfPtr, int pc);
+			    void *codePtr, CmdFrame *cfPtr, int cmd, int pc);
 MODULE_SCOPE void	TclArgumentBCRelease(Tcl_Interp *interp,
 			    CmdFrame *cfPtr);
 MODULE_SCOPE void	TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj,
-- 
cgit v0.12


From 3f126895fb9a9135480b18a16d017dfa39d90f3f Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 16 Jul 2013 14:52:33 +0000
Subject: Simplify arguments to TclContinuationsEnterDerived().

---
 generic/tclCompile.c  |  6 ++----
 generic/tclEnsemble.c | 14 ++++++++------
 2 files changed, 10 insertions(+), 10 deletions(-)

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 7e0be76..bc7501a 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1805,8 +1805,7 @@ TclCompileInvocation(
 		tokenPtr[1].start, tokenPtr[1].size);
 	if (envPtr->clNext) {
 	    TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx),
-		    tokenPtr[1].start - envPtr->source,
-		    mapPtr->loc[eclIndex].next[wordIdx]);
+		    tokenPtr[1].start - envPtr->source, envPtr->clNext);
 	}
 	TclEmitPush(objIdx, envPtr);
     }
@@ -1855,8 +1854,7 @@ CompileExpanded(
 		tokenPtr[1].start, tokenPtr[1].size);
 	if (envPtr->clNext) {
 	    TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx),
-		    tokenPtr[1].start - envPtr->source,
-		    mapPtr->loc[eclIndex].next[wordIdx]);
+		    tokenPtr[1].start - envPtr->source, envPtr->clNext);
 	}
 	TclEmitPush(objIdx, envPtr);
     }
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 9b6ca92..864283b 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -3163,12 +3163,16 @@ CompileToInvokedCommand(
      */
 
     Tcl_ListObjGetElements(NULL, replacements, &numWords, &words);
-    for (i=0,tokPtr=parsePtr->tokenPtr ; i<parsePtr->numWords ; i++) {
+    for (i = 0, tokPtr = parsePtr->tokenPtr; i < parsePtr->numWords;
+	    i++, tokPtr = TokenAfter(tokPtr)) {
 	if (i > 0 && i < numWords+1) {
 	    bytes = Tcl_GetStringFromObj(words[i-1], &length);
 	    PushLiteral(envPtr, bytes, length);
-	} else if (tokPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-	    /* TODO: Check about registering Cmd Literals here */
+	    continue;
+	}
+
+	SetLineInformation(i);
+	if (tokPtr->type == TCL_TOKEN_SIMPLE_WORD) {
 	    int literal = TclRegisterNewLiteral(envPtr,
 		    tokPtr[1].start, tokPtr[1].size);
 
@@ -3176,14 +3180,12 @@ CompileToInvokedCommand(
 		TclContinuationsEnterDerived(
 			TclFetchLiteral(envPtr, literal),
 			tokPtr[1].start - envPtr->source,
-			mapPtr->loc[eclIndex].next[i]);
+			envPtr->clNext);
 	    }
 	    TclEmitPush(literal, envPtr);
 	} else {
-	    SetLineInformation(i);
 	    CompileTokens(envPtr, tokPtr, interp);
 	}
-	tokPtr = TokenAfter(tokPtr);
     }
 
     /*
-- 
cgit v0.12


From c33f97005c30adcc8fbfafc81dc9d67913a4be43 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 16 Jul 2013 17:21:12 +0000
Subject: Simplify the ensemble subcommand compile.  There's no need to be
 crafting synthetic Tcl_Parse and copying tokens.  Some pointer shifts will
 do.

---
 generic/tclCompile.c  |  1 -
 generic/tclEnsemble.c | 70 +++++++++++----------------------------------------
 2 files changed, 15 insertions(+), 56 deletions(-)

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index bc7501a..d82d728 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1992,7 +1992,6 @@ CompileCmdCompileProc(
 	mapPtr->loc[mapPtr->nuloc].line = NULL;
     }
 
-    SetLineInformation(0);
     return TCL_ERROR;
 }
 
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 864283b..e4f96c0 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -3029,12 +3029,6 @@ TclCompileEnsemble(
     return ourResult;
 }
 
-/*
- * How to compile a subcommand using its own command compiler. To do that, we
- * have to perform some trickery to rewrite the arguments, as compilers *must*
- * have parse tokens that refer to addresses in the original script.
- */
-
 static int
 CompileToCompiledCommand(
     Tcl_Interp *interp,
@@ -3043,10 +3037,8 @@ CompileToCompiledCommand(
     Command *cmdPtr,
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
-    Tcl_Parse synthetic;
-    Tcl_Token *tokenPtr;
     int result, i;
-    int savedNumCmds = envPtr->numCommands;
+    Tcl_Token *saveTokenPtr = parsePtr->tokenPtr;
     int savedStackDepth = envPtr->currStackDepth;
     unsigned savedCodeNext = envPtr->codeNext - envPtr->codeStart;
     DefineLineInformation;
@@ -3055,47 +3047,17 @@ CompileToCompiledCommand(
 	return TCL_ERROR;
     }
 
-    TclParseInit(interp, NULL, 0, &synthetic);
-    synthetic.numWords = parsePtr->numWords - depth + 1;
-    TclGrowParseTokenArray(&synthetic, 2);
-    synthetic.numTokens = 2;
-
-    /*
-     * Now we have the space to work in, install something rewritten. The
-     * first word will "officially" be the bytes of the structured ensemble
-     * name. That's technically wrong, but nobody will care; we just need
-     * *something* here...
-     */
-
-    synthetic.tokenPtr[0].type = TCL_TOKEN_SIMPLE_WORD;
-    synthetic.tokenPtr[0].start = parsePtr->tokenPtr[0].start;
-    synthetic.tokenPtr[0].numComponents = 1;
-    synthetic.tokenPtr[1].type = TCL_TOKEN_TEXT;
-    synthetic.tokenPtr[1].start = parsePtr->tokenPtr[0].start;
-    synthetic.tokenPtr[1].numComponents = 0;
-    for (i=0,tokenPtr=parsePtr->tokenPtr ; i<depth ; i++) {
-	int sclen = (tokenPtr->start - synthetic.tokenPtr[0].start)
-		+ tokenPtr->size;
-
-	synthetic.tokenPtr[0].size = sclen;
-	synthetic.tokenPtr[1].size = sclen;
-	tokenPtr = TokenAfter(tokenPtr);
-    }
-
     /*
-     * Copy over the real argument tokens.
+     * Advance parsePtr->tokenPtr so that it points at the last subcommand.
+     * This will be wrong, but it will not matter, and it will put the
+     * tokens for the arguments in the right place without the needed to
+     * allocate a synthetic Tcl_Parse struct, or copy tokens around.
      */
 
-    for (i=1; i<synthetic.numWords; i++) {
-	int toCopy;
-
-	toCopy = tokenPtr->numComponents + 1;
-	TclGrowParseTokenArray(&synthetic, toCopy);
-	memcpy(synthetic.tokenPtr + synthetic.numTokens, tokenPtr,
-		sizeof(Tcl_Token) * toCopy);
-	synthetic.numTokens += toCopy;
-	tokenPtr = TokenAfter(tokenPtr);
+    for (i = 0; i < depth - 1; i++) {
+	parsePtr->tokenPtr = TokenAfter(parsePtr->tokenPtr);
     }
+    parsePtr->numWords -= (depth - 1);
 
     /*
      * Shift the line information arrays to account for different word
@@ -3109,7 +3071,7 @@ CompileToCompiledCommand(
      * Hand off compilation to the subcommand compiler. At last!
      */
 
-    result = cmdPtr->compileProc(interp, &synthetic, cmdPtr, envPtr);
+    result = cmdPtr->compileProc(interp, parsePtr, cmdPtr, envPtr);
 
     /*
      * Undo the shift. 
@@ -3118,22 +3080,20 @@ CompileToCompiledCommand(
     mapPtr->loc[eclIndex].line -= (depth - 1);
     mapPtr->loc[eclIndex].next -= (depth - 1);
 
+    parsePtr->numWords += (depth - 1);
+    parsePtr->tokenPtr = saveTokenPtr;
+
     /*
-     * If our target fails to compile, revert the number of commands and the
-     * pointer to the place to issue the next instruction. [Bug 3600328]
+     * If our target failed to compile, revert any data from failed partial
+     * compiles.  Note that envPtr->numCommands need not be checked because
+     * we avoid compiling subcommands that recursively call TclCompileScript().
      */
 
     if (result != TCL_OK) {
-	envPtr->numCommands = savedNumCmds;
 	envPtr->currStackDepth = savedStackDepth;
 	envPtr->codeNext = envPtr->codeStart + savedCodeNext;
     }
 
-    /*
-     * Clean up if necessary.
-     */
-
-    Tcl_FreeParse(&synthetic);
     return result;
 }
 
-- 
cgit v0.12


From d383707870a66078dd83c9532e7dbcb1002e62ba Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 16 Jul 2013 20:48:37 +0000
Subject: Streamline the housekeeping on the operands of INST_START_CMD. For
 example, do only incr on success, not incr on attempt + decr on error.

---
 generic/tclCompile.c | 81 +++++++++++++++++++++-------------------------------
 1 file changed, 32 insertions(+), 49 deletions(-)

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index d82d728..6ac5fb9 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1885,47 +1885,41 @@ CompileCmdCompileProc(
     Tcl_Interp *interp,
     Tcl_Parse *parsePtr,
     Command *cmdPtr,
-    int startCodeOffset,
     CompileEnv *envPtr)
 {
     int savedNumCmds = envPtr->numCommands;
     int startStackDepth = envPtr->currStackDepth;
-    int update = 0;
+    int startCodeOffset = envPtr->codeNext - envPtr->codeStart;
+    int incrOffset = -1;
     DefineLineInformation;
 
     /*
-     * Mark the start of the command; the proper bytecode
-     * length will be updated later. There is no need to
-     * do this for the first bytecode in the compile env,
-     * as the check is done before calling
-     * TclNRExecuteByteCode(). Do emit an INST_START_CMD
-     * in special cases where the first bytecode is in a
-     * loop, to insure that the corresponding command is
-     * counted properly. Compilers for commands able to
-     * produce such a beast (currently 'while 1' only) set
-     * envPtr->atCmdStart to 0 in order to signal this
-     * case. [Bug 1752146]
+     * Emit of the INST_START_CMD instruction is controlled by
+     * the value of envPtr->atCmdStart:
      *
-     * Note that the environment is initialised with
-     * atCmdStart=1 to avoid emitting ISC for the first
-     * command.
+     * atCmdStart == 2	: We are not using the INST_START_CMD instruction.
+     * atCmdStart == 1	: INST_START_CMD was the last instruction emitted.
+     *			: We do not need to emit another.  Instead we
+     *			: increment the number of cmds started at it (except
+     *			: for the special case at the start of a script.)
+     * atCmdStart == 0	: The last instruction was something else.  We need
+     *			: to emit INST_START_CMD here.
      */
 
-    if (envPtr->atCmdStart == 1) {
-	if (startCodeOffset) {
-	    /*
-	     * Increase the number of commands being
-	     * started at the current point. Note that
-	     * this depends on the exact layout of the
-	     * INST_START_CMD's operands, so be careful!
-	     */
-
-	    TclIncrUInt4AtPtr(envPtr->codeNext - 4, 1)
-	}
-    } else if (envPtr->atCmdStart == 0) {
+    switch (envPtr->atCmdStart) {
+    case 0:
 	TclEmitInstInt4(INST_START_CMD, 0, envPtr);
-	TclEmitInt4(1, envPtr);
-	update = 1;
+	incrOffset = envPtr->codeNext - envPtr->codeStart;
+	TclEmitInt4(0, envPtr);
+	break;
+    case 1:
+	if (envPtr->codeNext > envPtr->codeStart) {
+	    incrOffset = envPtr->codeNext - 4 - envPtr->codeStart;
+	}
+	break;
+    case 2:
+	/* Nothing to do */
+	;
     }
 
     if (TCL_OK == cmdPtr->compileProc(interp, parsePtr, cmdPtr, envPtr)) {
@@ -1947,30 +1941,20 @@ CompileCmdCompileProc(
 		    parsePtr->tokenPtr->start, diff);
 	}
 #endif
-	if (update) {
+	if (incrOffset >= 0) {
 	    /*
-	     * Fix the bytecode length.
+	     * We successfully compiled a command.  Increment the number
+	     * of commands that start at the currently active INST_START_CMD.
 	     */
+	    unsigned char *incrPtr = envPtr->codeStart + incrOffset;
+	    unsigned char *startPtr = incrPtr - 5;
 
-	    unsigned char *fixPtr = envPtr->codeStart + startCodeOffset + 1;
-	    unsigned fixLen = envPtr->codeNext - fixPtr + 1;
-
-	    TclStoreInt4AtPtr(fixLen, fixPtr);
+	    TclIncrUInt4AtPtr(incrPtr, 1);
+	    TclStoreInt4AtPtr(envPtr->codeNext - startPtr, startPtr + 1);
 	}
 	return TCL_OK;
     }
 
-    if (envPtr->atCmdStart == 1 && startCodeOffset != 0) {
-	/*
-	 * Decrease the number of commands being started
-	 * at the current point. Note that this depends on
-	 * the exact layout of the INST_START_CMD's
-	 * operands, so be careful!
-	 */
-
-	TclIncrUInt4AtPtr(envPtr->codeNext - 4, -1);
-    }
-
     /*
      * Restore numCommands, codeNext, and currStackDepth  to their
      * correct values, removing any commands compiled before the
@@ -2069,8 +2053,7 @@ CompileCommandTokens(
 
     /* If cmdPtr != NULL, we will try to call cmdPtr->compileProc */
     if (cmdPtr) {
-	code = CompileCmdCompileProc(interp, parsePtr, cmdPtr,
-		startCodeOffset, envPtr);
+	code = CompileCmdCompileProc(interp, parsePtr, cmdPtr, envPtr);
     }
 
     if (code == TCL_ERROR) {
-- 
cgit v0.12


From c2d6c48dd921e7120d626f1a85977ae130dd109e Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 17 Jul 2013 13:57:23 +0000
Subject: Factor out the call to a compileProc into one place used by both
 ensemble subcommand compiles and toplevel command compiles in
 TclCompileScript.

---
 generic/tclCompile.c  | 48 ++++++++++++++----------------------------------
 generic/tclCompile.h  |  3 +++
 generic/tclEnsemble.c | 28 +++++++++++++++++++++-------
 3 files changed, 38 insertions(+), 41 deletions(-)

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 6ac5fb9..763e8f1 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1887,10 +1887,7 @@ CompileCmdCompileProc(
     Command *cmdPtr,
     CompileEnv *envPtr)
 {
-    int savedNumCmds = envPtr->numCommands;
-    int startStackDepth = envPtr->currStackDepth;
-    int startCodeOffset = envPtr->codeNext - envPtr->codeStart;
-    int incrOffset = -1;
+    int unwind = 0, incrOffset = -1;
     DefineLineInformation;
 
     /*
@@ -1908,6 +1905,7 @@ CompileCmdCompileProc(
 
     switch (envPtr->atCmdStart) {
     case 0:
+	unwind = tclInstructionTable[INST_START_CMD].numBytes;
 	TclEmitInstInt4(INST_START_CMD, 0, envPtr);
 	incrOffset = envPtr->codeNext - envPtr->codeStart;
 	TclEmitInt4(0, envPtr);
@@ -1922,25 +1920,7 @@ CompileCmdCompileProc(
 	;
     }
 
-    if (TCL_OK == cmdPtr->compileProc(interp, parsePtr, cmdPtr, envPtr)) {
-
-#ifdef TCL_COMPILE_DEBUG
-	/*
-	 * Confirm that the command compiler generated a
-	 * single value on the stack as its result. This
-	 * is only done in debugging mode, as it *should*
-	 * be correct and normal users have no reasonable
-	 * way to fix it anyway.
-	 */
-
-	int diff = envPtr->currStackDepth - startStackDepth;
-
-	if (diff != 1) {
-	    Tcl_Panic("bad stack adjustment when compiling"
-		    " %.*s (was %d instead of 1)", parsePtr->tokenPtr->size,
-		    parsePtr->tokenPtr->start, diff);
-	}
-#endif
+    if (TCL_OK == TclAttemptCompileProc(interp, parsePtr, 1, cmdPtr, envPtr)) {
 	if (incrOffset >= 0) {
 	    /*
 	     * We successfully compiled a command.  Increment the number
@@ -1950,21 +1930,15 @@ CompileCmdCompileProc(
 	    unsigned char *startPtr = incrPtr - 5;
 
 	    TclIncrUInt4AtPtr(incrPtr, 1);
-	    TclStoreInt4AtPtr(envPtr->codeNext - startPtr, startPtr + 1);
+	    if (unwind) {
+		/* We started the INST_START_CMD.  Record the code length. */
+		TclStoreInt4AtPtr(envPtr->codeNext - startPtr, startPtr + 1);
+	    }
 	}
 	return TCL_OK;
     }
 
-    /*
-     * Restore numCommands, codeNext, and currStackDepth  to their
-     * correct values, removing any commands compiled before the
-     * failure to produce bytecode got reported.
-     * [Bugs 705406, 735055, 3614102]
-     */
-
-    envPtr->numCommands = savedNumCmds;
-    envPtr->codeNext = envPtr->codeStart + startCodeOffset;
-    envPtr->currStackDepth = startStackDepth;
+    envPtr->codeNext -= unwind; /* Unwind INST_START_CMD */
 
     /*
      * Throw out any line information generated by the failed
@@ -1976,6 +1950,12 @@ CompileCmdCompileProc(
 	mapPtr->loc[mapPtr->nuloc].line = NULL;
     }
 
+    /*
+     * Reset the index of next command.
+     * Toss out any from failed nested partial compiles.
+     */
+    envPtr->numCommands = mapPtr->nuloc;
+
     return TCL_ERROR;
 }
 
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index f70f8f7..56315db 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -984,6 +984,9 @@ MODULE_SCOPE ByteCode *	TclCompileObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
  *----------------------------------------------------------------
  */
 
+MODULE_SCOPE int	TclAttemptCompileProc(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, int depth, Command *cmdPtr,
+			    CompileEnv *envPtr);
 MODULE_SCOPE void	TclCleanupByteCode(ByteCode *codePtr);
 MODULE_SCOPE void	TclCleanupStackForBreakContinue(CompileEnv *envPtr,
 			    ExceptionAux *auxPtr);
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index e4f96c0..bab63c9 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -35,9 +35,6 @@ static void		MakeCachedEnsembleCommand(Tcl_Obj *objPtr,
 static void		FreeEnsembleCmdRep(Tcl_Obj *objPtr);
 static void		DupEnsembleCmdRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
 static void		StringOfEnsembleCmdRep(Tcl_Obj *objPtr);
-static int		CompileToCompiledCommand(Tcl_Interp *interp,
-			    Tcl_Parse *parsePtr, int depth, Command *cmdPtr,
-			    CompileEnv *envPtr);
 static void		CompileToInvokedCommand(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Tcl_Obj *replacements,
 			    Command *cmdPtr, CompileEnv *envPtr);
@@ -2994,8 +2991,8 @@ TclCompileEnsemble(
      */
 
     invokeAnyway = 1;
-    if (CompileToCompiledCommand(interp, parsePtr, depth, cmdPtr,
-	    envPtr) == TCL_OK) {
+    if (TCL_OK == TclAttemptCompileProc(interp, parsePtr, depth, cmdPtr,
+	    envPtr)) {
 	ourResult = TCL_OK;
 	goto cleanup;
     }
@@ -3029,8 +3026,8 @@ TclCompileEnsemble(
     return ourResult;
 }
 
-static int
-CompileToCompiledCommand(
+int
+TclAttemptCompileProc(
     Tcl_Interp *interp,
     Tcl_Parse *parsePtr,
     int depth,
@@ -3092,6 +3089,23 @@ CompileToCompiledCommand(
     if (result != TCL_OK) {
 	envPtr->currStackDepth = savedStackDepth;
 	envPtr->codeNext = envPtr->codeStart + savedCodeNext;
+#ifdef TCL_COMPILE_DEBUG
+    } else {
+	/*
+	 * Confirm that the command compiler generated a single value on
+	 * the stack as its result. This is only done in debugging mode,
+	 * as it *should* be correct and normal users have no reasonable
+	 * way to fix it anyway.
+	 */
+
+	int diff = envPtr->currStackDepth - savedStackDepth;
+
+	if (diff != 1) {
+	    Tcl_Panic("bad stack adjustment when compiling"
+		    " %.*s (was %d instead of 1)", parsePtr->tokenPtr->size,
+		    parsePtr->tokenPtr->start, diff);
+	}
+#endif
     }
 
     return result;
-- 
cgit v0.12


From 9a19e4cba0287b415ad5ce23d202d350891dbc36 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Wed, 17 Jul 2013 16:02:36 +0000
Subject: Start notifier thread again if we were forked, to solve Rivet bug
 55153 - RFE [a0bc856dcd]

---
 ChangeLog           |  6 ++++++
 unix/tclUnixNotfy.c | 21 +++++++++++++++++++++
 2 files changed, 27 insertions(+)

diff --git a/ChangeLog b/ChangeLog
index d7ada95..bdbbd4a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2013-07-17  Harald Oehlmann  <oehhar@users.sf.net>
+
+	* tclUnixNotify.c Tcl_InitNotifier: RFE [a0bc856dcd]
+	  Start notifier thread again if we were forked, to solve Rivet bug
+	  55153.
+
 2013-07-05  Kevin B. Kenny  <kennykb@acm.org>
 
 	* library/tzdata/Africa/Casablanca:
diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c
index aacc8d2d..2ad1932 100644
--- a/unix/tclUnixNotfy.c
+++ b/unix/tclUnixNotfy.c
@@ -120,6 +120,15 @@ static Tcl_ThreadDataKey dataKey;
 static int notifierCount = 0;
 
 /*
+ * The following static stores the process ID of the initialized notifier
+ * thread. If it changes, we have passed a fork and we should start a new
+ * notifier thread.
+ *
+ * You must hold the notifierMutex lock before accessing this variable.
+ */
+static pid_t processIDInitialized = 0;
+
+/*
  * The following variable points to the head of a doubly-linked list of
  * ThreadSpecificData structures for all threads that are currently waiting on
  * an event.
@@ -275,11 +284,23 @@ Tcl_InitNotifier(void)
 	 */
 
 	Tcl_MutexLock(&notifierMutex);
+	/*
+	 * Check if my process id changed, e.g. I was forked
+	 * In this case, restart the notifier thread and close the
+	 * pipe to the original notifier thread
+	 */
+	if (notifierCount > 0 && processIDInitialized != getpid()) {
+	    notifierCount = 0;
+	    processIDInitialized = 0;
+	    close(triggerPipe);
+	    triggerPipe = -1;
+	}
 	if (notifierCount == 0) {
 	    if (TclpThreadCreate(&notifierThread, NotifierThreadProc, NULL,
 		    TCL_THREAD_STACK_DEFAULT, TCL_THREAD_JOINABLE) != TCL_OK) {
 		Tcl_Panic("Tcl_InitNotifier: unable to start notifier thread");
 	    }
+	    processIDInitialized = getpid();
 	}
 	notifierCount++;
 
-- 
cgit v0.12


From 81a1a91361cc615d3e9bf5b9016bd12cd258aa8d Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 18 Jul 2013 15:05:18 +0000
Subject: [Bug 1c17fbba5d] Fix -errorinfo from syntax errors so that the error
 is not obscured.  Instead highlight it by making it the last character
 quoted.

---
 generic/tclAssembly.c | 15 ++++++++-------
 generic/tclBasic.c    |  5 ++++-
 generic/tclCompile.c  |  5 +----
 tests/assemble.test   |  3 +--
 tests/misc.test       |  7 +------
 5 files changed, 15 insertions(+), 20 deletions(-)

diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 62641e6..416ee10 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -985,8 +985,6 @@ TclAssembleCode(
 
     const char* instPtr = codePtr;
 				/* Where to start looking for a line of code */
-    int instLen;		/* Length in bytes of the current line of
-				 * code */
     const char* nextPtr;	/* Pointer to the end of the line of code */
     int bytesLeft = codeLen;	/* Number of bytes of source code remaining to
 				 * be parsed */
@@ -1000,10 +998,6 @@ TclAssembleCode(
 	 */
 
 	status = Tcl_ParseCommand(interp, instPtr, bytesLeft, 0, parsePtr);
-	instLen = parsePtr->commandSize;
-	if (parsePtr->term == parsePtr->commandStart + instLen - 1) {
-	    --instLen;
-	}
 
 	/*
 	 * Report errors in the parse.
@@ -1012,7 +1006,7 @@ TclAssembleCode(
 	if (status != TCL_OK) {
 	    if (flags & TCL_EVAL_DIRECT) {
 		Tcl_LogCommandInfo(interp, codePtr, parsePtr->commandStart,
-			instLen);
+			parsePtr->term + 1 - parsePtr->commandStart);
 	    }
 	    FreeAssemblyEnv(assemEnvPtr);
 	    return TCL_ERROR;
@@ -1032,6 +1026,13 @@ TclAssembleCode(
 	 */
 
 	if (parsePtr->numWords > 0) {
+	    int instLen = parsePtr->commandSize;
+		    /* Length in bytes of the current command */
+
+	    if (parsePtr->term == parsePtr->commandStart + instLen - 1) {
+		--instLen;
+	    }
+
 	    /*
 	     * If tracing, show each line assembled as it happens.
 	     */
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index b2a505a..1d35034 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -5084,7 +5084,9 @@ TclEvalEx(
     do {
 	if (Tcl_ParseCommand(interp, p, bytesLeft, 0, parsePtr) != TCL_OK) {
 	    code = TCL_ERROR;
-	    goto error;
+	    Tcl_LogCommandInfo(interp, script, parsePtr->commandStart,
+		    parsePtr->term + 1 - parsePtr->commandStart);
+	    goto posterror;
 	}
 
 	/*
@@ -5340,6 +5342,7 @@ TclEvalEx(
 	Tcl_LogCommandInfo(interp, script, parsePtr->commandStart,
 		commandLength);
     }
+ posterror:
     iPtr->flags &= ~ERR_ALREADY_LOGGED;
 
     /*
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 633966e..6a2a318 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1790,10 +1790,7 @@ TclCompileScript(
 	     */
 
 	    Tcl_LogCommandInfo(interp, script, parsePtr->commandStart,
-		    /* Drop the command terminator (";","]") if appropriate */
-		    (parsePtr->term ==
-		    parsePtr->commandStart + parsePtr->commandSize - 1)?
-		    parsePtr->commandSize - 1 : parsePtr->commandSize);
+		    parsePtr->term + 1 - parsePtr->commandStart);
 	    TclCompileSyntaxError(interp, envPtr);
 	    break;
 	}
diff --git a/tests/assemble.test b/tests/assemble.test
index 7d4e5d1..b0487e6 100644
--- a/tests/assemble.test
+++ b/tests/assemble.test
@@ -175,8 +175,7 @@ test assemble-4.1 {syntax error} {
     -match glob
     -result {1 {extra characters after close-brace} {extra characters after close-brace
     while executing
-"{}extra
-	    "
+"{}e"
     ("assemble" body, line 2)*}}
 }
 test assemble-4.2 {null command} {
diff --git a/tests/misc.test b/tests/misc.test
index 6ddc718..d4ece74 100644
--- a/tests/misc.test
+++ b/tests/misc.test
@@ -59,12 +59,7 @@ test misc-1.2 {error in variable ref. in command in array reference} {
 missing close-brace for variable name
 missing close-brace for variable name
     while executing
-"set tst $a([winfo name $\{zz)
-	# this is a bogus comment
-	# this is a bogus comment
-	# this is a bogus comment
-	# this is a bogus comment
-	# this is a ..."
+"set tst $a([winfo name $\{"
     (procedure "tstProc" line 4)
     invoked from within
 "tstProc"}]
-- 
cgit v0.12


From 5e9e003379a72c3459d97b1931c3e8b8627541f8 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 18 Jul 2013 18:25:24 +0000
Subject: [assemble] compile syntax error into bytecode reporting syntax error
 message.

---
 generic/tclAssembly.c | 10 +++-------
 1 file changed, 3 insertions(+), 7 deletions(-)

diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 0722eb9..9b9b6f8 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -930,7 +930,7 @@ TclCompileAssembleCmd(
 {
     Tcl_Token *tokenPtr;	/* Token in the input script */
 
-#if 0
+#if 1
     int numCommands = envPtr->numCommands;
     int offset = envPtr->codeNext - envPtr->codeStart;
     int depth = envPtr->currStackDepth;
@@ -956,11 +956,7 @@ TclCompileAssembleCmd(
     if (TCL_ERROR == TclAssembleCode(envPtr, tokenPtr[1].start,
 	    tokenPtr[1].size, TCL_EVAL_DIRECT)) {
 
-    /*
-     * TODO: Finish working out how to capture syntax errors captured
-     * during compile and make them bytecode reporting the error.
-     */
-#if 0
+#if 1
 	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
 		"\n    (\"%.*s\" body, line %d)",
 		parsePtr->tokenPtr->size, parsePtr->tokenPtr->start,
@@ -1136,7 +1132,7 @@ NewAssemblyEnv(
 
     assemEnvPtr->envPtr = envPtr;
     assemEnvPtr->parsePtr = parsePtr;
-    assemEnvPtr->cmdLine = envPtr->line;
+    assemEnvPtr->cmdLine = 1;
     assemEnvPtr->clNext = envPtr->clNext;
 
     /*
-- 
cgit v0.12


From 915c6abe668e021ca4c98a13b69054e163fa7208 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Mon, 22 Jul 2013 08:45:37 +0000
Subject: Test file tests/unixForkEvent.test added

---
 tests/unixForkEvent.test | 50 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 50 insertions(+)
 create mode 100644 tests/unixForkEvent.test

diff --git a/tests/unixForkEvent.test b/tests/unixForkEvent.test
new file mode 100644
index 0000000..fee45fd
--- /dev/null
+++ b/tests/unixForkEvent.test
@@ -0,0 +1,50 @@
+# This file contains a collection of tests for the procedures in the file
+# tclEvent.c, which includes the "update", and "vwait" Tcl
+# commands.  Sourcing this file into Tcl runs the tests and generates
+# output for errors.  No output means no errors were found.
+#
+# Copyright (c) 1995-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+package require tcltest 2
+namespace import -force ::tcltest::*
+
+testConstraint testfork [llength [info commands testfork]]
+testConstraint threaded [expr {
+    ([info exist tcl_platform(threaded)] && $tcl_platform(threaded))
+    && $tcl_platform(os) ne "Darwin"
+}]
+
+# Test if the notifier thread is well initialized in a forked interpreter
+# by Tcl_InitNotifier
+test unixforkevent-1.1 {fork and test writeable event} \
+    -constraints {threaded testfork} \
+    -body {
+	set folder [makeDirectory unixtestfork]
+	set pid [testfork]
+	if {$pid == 0} {
+	    # we are the forked process
+	    set result initialized
+	    set h [open [file join $folder test.txt] w]
+	    fileevent $h writable\
+		    "set result writable;\
+		    after cancel [after 1000 {set result timeout}]"
+	    vwait result
+	    close $h
+	    makeFile $result result.txt $folder
+	    exit
+	}
+	# we are the original process
+	while {![file readable [file join $folder result.txt]]} {}
+	viewFile result.txt $folder
+    } \
+    -result {writable} \
+    -cleanup { 
+	catch { removeFolder $folder }
+    }
+
+::tcltest::cleanupTests
+return
-- 
cgit v0.12


From 0c2e553e8f1cba16c82ea38a07526726af210249 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 22 Jul 2013 10:10:00 +0000
Subject: Fix bug which hangs iocmd.tf-32.1

---
 unix/tclUnixNotfy.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c
index 88e290e..6e8b5fa 100644
--- a/unix/tclUnixNotfy.c
+++ b/unix/tclUnixNotfy.c
@@ -291,8 +291,8 @@ Tcl_InitNotifier(void)
 	if (TclpThreadCreate(&notifierThread, NotifierThreadProc, NULL,
 		TCL_THREAD_STACK_DEFAULT, TCL_THREAD_JOINABLE) != TCL_OK) {
 	    Tcl_Panic("Tcl_InitNotifier: unable to start notifier thread");
-	    processIDInitialized = getpid();
 	}
+    processIDInitialized = getpid();
     }
     notifierCount++;
 
-- 
cgit v0.12


From f287d8cb0f7323111a09a626f8d82985ee7ed54d Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 22 Jul 2013 10:11:05 +0000
Subject: Test-case should pass on Darwin or with non-threaded build as well.

---
 tests/unixForkEvent.test | 11 +++--------
 1 file changed, 3 insertions(+), 8 deletions(-)

diff --git a/tests/unixForkEvent.test b/tests/unixForkEvent.test
index fee45fd..a0c3f19 100644
--- a/tests/unixForkEvent.test
+++ b/tests/unixForkEvent.test
@@ -1,7 +1,6 @@
 # This file contains a collection of tests for the procedures in the file
-# tclEvent.c, which includes the "update", and "vwait" Tcl
-# commands.  Sourcing this file into Tcl runs the tests and generates
-# output for errors.  No output means no errors were found.
+# tclUnixNotify.c.  Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
 #
 # Copyright (c) 1995-1997 Sun Microsystems, Inc.
 # Copyright (c) 1998-1999 by Scriptics Corporation.
@@ -13,15 +12,11 @@ package require tcltest 2
 namespace import -force ::tcltest::*
 
 testConstraint testfork [llength [info commands testfork]]
-testConstraint threaded [expr {
-    ([info exist tcl_platform(threaded)] && $tcl_platform(threaded))
-    && $tcl_platform(os) ne "Darwin"
-}]
 
 # Test if the notifier thread is well initialized in a forked interpreter
 # by Tcl_InitNotifier
 test unixforkevent-1.1 {fork and test writeable event} \
-    -constraints {threaded testfork} \
+    -constraints testfork \
     -body {
 	set folder [makeDirectory unixtestfork]
 	set pid [testfork]
-- 
cgit v0.12


From 4fb5d04b2faf65ac7ce4d88f0dd6be98a68e4d10 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 22 Jul 2013 10:57:44 +0000
Subject: Use pthread_atfork() when available.

---
 unix/configure      | 209 +++++++++++++++++++++++++++-------------------------
 unix/configure.in   |   7 +-
 unix/tclUnixNotfy.c |  90 +++++++++++++++++++++-
 3 files changed, 202 insertions(+), 104 deletions(-)

diff --git a/unix/configure b/unix/configure
index 6faa7d8..ee194b7 100755
--- a/unix/configure
+++ b/unix/configure
@@ -16759,6 +16759,113 @@ done
 
 
 #--------------------------------------------------------------------
+# Check for support of pthread_atfork function
+#--------------------------------------------------------------------
+
+
+for ac_func in pthread_atfork
+do
+as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
+echo "$as_me:$LINENO: checking for $ac_func" >&5
+echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
+if eval "test \"\${$as_ac_var+set}\" = set"; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func.
+   For example, HP-UX 11i <limits.h> declares gettimeofday.  */
+#define $ac_func innocuous_$ac_func
+
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char $ac_func (); below.
+    Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+    <limits.h> exists even on freestanding compilers.  */
+
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+
+#undef $ac_func
+
+/* Override any gcc2 internal prototype to avoid an error.  */
+#ifdef __cplusplus
+extern "C"
+{
+#endif
+/* We use char because int might match the return type of a gcc2
+   builtin and then its argument prototype would still apply.  */
+char $ac_func ();
+/* The GNU C library defines this for functions which it implements
+    to always fail with ENOSYS.  Some functions are actually named
+    something starting with __ and the normal name is an alias.  */
+#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
+choke me
+#else
+char (*f) () = $ac_func;
+#endif
+#ifdef __cplusplus
+}
+#endif
+
+int
+main ()
+{
+return f != $ac_func;
+  ;
+  return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+  (eval $ac_link) 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } &&
+	 { ac_try='test -z "$ac_c_werror_flag"
+			 || test ! -s conftest.err'
+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+  (eval $ac_try) 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); }; } &&
+	 { ac_try='test -s conftest$ac_exeext'
+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+  (eval $ac_try) 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); }; }; then
+  eval "$as_ac_var=yes"
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+eval "$as_ac_var=no"
+fi
+rm -f conftest.err conftest.$ac_objext \
+      conftest$ac_exeext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5
+echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6
+if test `eval echo '${'$as_ac_var'}'` = yes; then
+  cat >>confdefs.h <<_ACEOF
+#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+done
+
+
+#--------------------------------------------------------------------
 # Check for support of isnan() function or macro
 #--------------------------------------------------------------------
 
@@ -17439,108 +17546,6 @@ _ACEOF
 fi
 done
 
-
-for ac_func in pthread_atfork
-do
-as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
-echo "$as_me:$LINENO: checking for $ac_func" >&5
-echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
-if eval "test \"\${$as_ac_var+set}\" = set"; then
-  echo $ECHO_N "(cached) $ECHO_C" >&6
-else
-  cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h.  */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h.  */
-/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func.
-   For example, HP-UX 11i <limits.h> declares gettimeofday.  */
-#define $ac_func innocuous_$ac_func
-
-/* System header to define __stub macros and hopefully few prototypes,
-    which can conflict with char $ac_func (); below.
-    Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
-    <limits.h> exists even on freestanding compilers.  */
-
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
-
-#undef $ac_func
-
-/* Override any gcc2 internal prototype to avoid an error.  */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
-   builtin and then its argument prototype would still apply.  */
-char $ac_func ();
-/* The GNU C library defines this for functions which it implements
-    to always fail with ENOSYS.  Some functions are actually named
-    something starting with __ and the normal name is an alias.  */
-#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
-choke me
-#else
-char (*f) () = $ac_func;
-#endif
-#ifdef __cplusplus
-}
-#endif
-
-int
-main ()
-{
-return f != $ac_func;
-  ;
-  return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
-  (eval $ac_link) 2>conftest.er1
-  ac_status=$?
-  grep -v '^ *+' conftest.er1 >conftest.err
-  rm -f conftest.er1
-  cat conftest.err >&5
-  echo "$as_me:$LINENO: \$? = $ac_status" >&5
-  (exit $ac_status); } &&
-	 { ac_try='test -z "$ac_c_werror_flag"
-			 || test ! -s conftest.err'
-  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
-  (eval $ac_try) 2>&5
-  ac_status=$?
-  echo "$as_me:$LINENO: \$? = $ac_status" >&5
-  (exit $ac_status); }; } &&
-	 { ac_try='test -s conftest$ac_exeext'
-  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
-  (eval $ac_try) 2>&5
-  ac_status=$?
-  echo "$as_me:$LINENO: \$? = $ac_status" >&5
-  (exit $ac_status); }; }; then
-  eval "$as_ac_var=yes"
-else
-  echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-eval "$as_ac_var=no"
-fi
-rm -f conftest.err conftest.$ac_objext \
-      conftest$ac_exeext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6
-if test `eval echo '${'$as_ac_var'}'` = yes; then
-  cat >>confdefs.h <<_ACEOF
-#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
-_ACEOF
-
-fi
-done
-
     fi
 
 cat >>confdefs.h <<\_ACEOF
diff --git a/unix/configure.in b/unix/configure.in
index e22a7d3..f47b882 100644
--- a/unix/configure.in
+++ b/unix/configure.in
@@ -491,6 +491,12 @@ SC_ENABLE_LANGINFO
 AC_CHECK_FUNCS(chflags)
 
 #--------------------------------------------------------------------
+# Check for support of pthread_atfork function
+#--------------------------------------------------------------------
+
+AC_CHECK_FUNCS(pthread_atfork)
+
+#--------------------------------------------------------------------
 # Check for support of isnan() function or macro
 #--------------------------------------------------------------------
 
@@ -513,7 +519,6 @@ if test "`uname -s`" = "Darwin" ; then
     if test $tcl_corefoundation = yes; then
 	AC_CHECK_HEADERS(libkern/OSAtomic.h)
 	AC_CHECK_FUNCS(OSSpinLockLock)
-	AC_CHECK_FUNCS(pthread_atfork)
     fi
     AC_DEFINE(USE_VFORK, 1, [Should we use vfork() instead of fork()?])
     AC_DEFINE(TCL_DEFAULT_ENCODING, "utf-8",
diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c
index 6e8b5fa..f414c3f 100644
--- a/unix/tclUnixNotfy.c
+++ b/unix/tclUnixNotfy.c
@@ -202,7 +202,13 @@ static Tcl_ThreadId notifierThread;
 
 #ifdef TCL_THREADS
 static void	NotifierThreadProc(ClientData clientData);
-#endif
+#ifdef HAVE_PTHREAD_ATFORK
+static int	atForkInit = 0;
+static void	AtForkPrepare(void);
+static void	AtForkParent(void);
+static void	AtForkChild(void);
+#endif /* HAVE_PTHREAD_ATFORK */
+#endif /* TCL_THREADS */
 static int	FileHandlerEventProc(Tcl_Event *evPtr, int flags);
 
 /*
@@ -276,6 +282,21 @@ Tcl_InitNotifier(void)
      */
 
     Tcl_MutexLock(&notifierMutex);
+#ifdef HAVE_PTHREAD_ATFORK
+    /*
+     * Install pthread_atfork handlers to reinitialize the notifier in the
+     * child of a fork.
+     */
+
+    if (!atForkInit) {
+	int result = pthread_atfork(AtForkPrepare, AtForkParent, AtForkChild);
+
+	if (result) {
+	    Tcl_Panic("Tcl_InitNotifier: pthread_atfork failed");
+	}
+	atForkInit = 1;
+    }
+#endif
     /*
      * Check if my process id changed, e.g. I was forked
      * In this case, restart the notifier thread and close the
@@ -1251,6 +1272,73 @@ NotifierThreadProc(
 
     TclpThreadExit (0);
 }
+
+#ifdef HAVE_PTHREAD_ATFORK
+/*
+ *----------------------------------------------------------------------
+ *
+ * AtForkPrepare --
+ *
+ *	Lock the notifier in preparation for a fork.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AtForkPrepare(void)
+{
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AtForkParent --
+ *
+ *	Unlock the notifier in the parent after a fork.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AtForkParent(void)
+{
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AtForkChild --
+ *
+ *	Unlock and reinstall the notifier in the child after a fork.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AtForkChild(void)
+{
+    Tcl_InitNotifier();
+}
+#endif /* HAVE_PTHREAD_ATFORK */
+
 #endif /* TCL_THREADS */
 
 #endif /* HAVE_COREFOUNDATION */
-- 
cgit v0.12


From 9350513d164aa683ea09806945eef90a924a936b Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 22 Jul 2013 11:11:10 +0000
Subject: Tcl_InitNotifier() call in TestforkObjCmd() is only necessary when
 pthread_atfork() is not available.

---
 unix/tclUnixTest.c | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c
index 39cddef..2fc1647 100644
--- a/unix/tclUnixTest.c
+++ b/unix/tclUnixTest.c
@@ -574,9 +574,12 @@ TestforkObjCmd(
                 "Cannot fork", NULL);
         return TCL_ERROR;
     }
+#ifndef HAVE_PTHREAD_ATFORK
+    /* Only needed when pthread_atfork is not present. */
     if (pid==0) {
 	Tcl_InitNotifier();
     }
+#endif
     Tcl_SetObjResult(interp, Tcl_NewIntObj(pid));
     return TCL_OK;
 }
-- 
cgit v0.12


From bc28cd1ac82705c2452e11f441e3fd0796c6d692 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Tue, 23 Jul 2013 09:07:21 +0000
Subject: Add "testfork" test command. Not used in any test-case yet

---
 unix/configure     | 204 ++++++++++++++++++++++++++---------------------------
 unix/configure.in  |   2 +-
 unix/tclUnixTest.c |  50 +++++++++++++
 3 files changed, 153 insertions(+), 103 deletions(-)

diff --git a/unix/configure b/unix/configure
index 6faa7d8..9fa5673 100755
--- a/unix/configure
+++ b/unix/configure
@@ -5303,6 +5303,108 @@ echo "${ECHO_T}no (default)" >&6
 
 
 
+for ac_func in pthread_atfork
+do
+as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
+echo "$as_me:$LINENO: checking for $ac_func" >&5
+echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
+if eval "test \"\${$as_ac_var+set}\" = set"; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func.
+   For example, HP-UX 11i <limits.h> declares gettimeofday.  */
+#define $ac_func innocuous_$ac_func
+
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char $ac_func (); below.
+    Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+    <limits.h> exists even on freestanding compilers.  */
+
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+
+#undef $ac_func
+
+/* Override any gcc2 internal prototype to avoid an error.  */
+#ifdef __cplusplus
+extern "C"
+{
+#endif
+/* We use char because int might match the return type of a gcc2
+   builtin and then its argument prototype would still apply.  */
+char $ac_func ();
+/* The GNU C library defines this for functions which it implements
+    to always fail with ENOSYS.  Some functions are actually named
+    something starting with __ and the normal name is an alias.  */
+#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
+choke me
+#else
+char (*f) () = $ac_func;
+#endif
+#ifdef __cplusplus
+}
+#endif
+
+int
+main ()
+{
+return f != $ac_func;
+  ;
+  return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+  (eval $ac_link) 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } &&
+	 { ac_try='test -z "$ac_c_werror_flag"
+			 || test ! -s conftest.err'
+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+  (eval $ac_try) 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); }; } &&
+	 { ac_try='test -s conftest$ac_exeext'
+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+  (eval $ac_try) 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); }; }; then
+  eval "$as_ac_var=yes"
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+eval "$as_ac_var=no"
+fi
+rm -f conftest.err conftest.$ac_objext \
+      conftest$ac_exeext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5
+echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6
+if test `eval echo '${'$as_ac_var'}'` = yes; then
+  cat >>confdefs.h <<_ACEOF
+#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+done
+
+
 #------------------------------------------------------------------------
 # Embedded configuration information, encoding to use for the values, TIP #59
 #------------------------------------------------------------------------
@@ -17439,108 +17541,6 @@ _ACEOF
 fi
 done
 
-
-for ac_func in pthread_atfork
-do
-as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
-echo "$as_me:$LINENO: checking for $ac_func" >&5
-echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
-if eval "test \"\${$as_ac_var+set}\" = set"; then
-  echo $ECHO_N "(cached) $ECHO_C" >&6
-else
-  cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h.  */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h.  */
-/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func.
-   For example, HP-UX 11i <limits.h> declares gettimeofday.  */
-#define $ac_func innocuous_$ac_func
-
-/* System header to define __stub macros and hopefully few prototypes,
-    which can conflict with char $ac_func (); below.
-    Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
-    <limits.h> exists even on freestanding compilers.  */
-
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
-
-#undef $ac_func
-
-/* Override any gcc2 internal prototype to avoid an error.  */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
-   builtin and then its argument prototype would still apply.  */
-char $ac_func ();
-/* The GNU C library defines this for functions which it implements
-    to always fail with ENOSYS.  Some functions are actually named
-    something starting with __ and the normal name is an alias.  */
-#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
-choke me
-#else
-char (*f) () = $ac_func;
-#endif
-#ifdef __cplusplus
-}
-#endif
-
-int
-main ()
-{
-return f != $ac_func;
-  ;
-  return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
-  (eval $ac_link) 2>conftest.er1
-  ac_status=$?
-  grep -v '^ *+' conftest.er1 >conftest.err
-  rm -f conftest.er1
-  cat conftest.err >&5
-  echo "$as_me:$LINENO: \$? = $ac_status" >&5
-  (exit $ac_status); } &&
-	 { ac_try='test -z "$ac_c_werror_flag"
-			 || test ! -s conftest.err'
-  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
-  (eval $ac_try) 2>&5
-  ac_status=$?
-  echo "$as_me:$LINENO: \$? = $ac_status" >&5
-  (exit $ac_status); }; } &&
-	 { ac_try='test -s conftest$ac_exeext'
-  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
-  (eval $ac_try) 2>&5
-  ac_status=$?
-  echo "$as_me:$LINENO: \$? = $ac_status" >&5
-  (exit $ac_status); }; }; then
-  eval "$as_ac_var=yes"
-else
-  echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-eval "$as_ac_var=no"
-fi
-rm -f conftest.err conftest.$ac_objext \
-      conftest$ac_exeext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6
-if test `eval echo '${'$as_ac_var'}'` = yes; then
-  cat >>confdefs.h <<_ACEOF
-#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
-_ACEOF
-
-fi
-done
-
     fi
 
 cat >>confdefs.h <<\_ACEOF
diff --git a/unix/configure.in b/unix/configure.in
index e22a7d3..5a7125e 100644
--- a/unix/configure.in
+++ b/unix/configure.in
@@ -93,6 +93,7 @@ fi
 #------------------------------------------------------------------------
 
 SC_ENABLE_THREADS
+AC_CHECK_FUNCS(pthread_atfork)
 
 #------------------------------------------------------------------------
 # Embedded configuration information, encoding to use for the values, TIP #59
@@ -513,7 +514,6 @@ if test "`uname -s`" = "Darwin" ; then
     if test $tcl_corefoundation = yes; then
 	AC_CHECK_HEADERS(libkern/OSAtomic.h)
 	AC_CHECK_FUNCS(OSSpinLockLock)
-	AC_CHECK_FUNCS(pthread_atfork)
     fi
     AC_DEFINE(USE_VFORK, 1, [Should we use vfork() instead of fork()?])
     AC_DEFINE(TCL_DEFAULT_ENCODING, "utf-8",
diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c
index b6529c2..2fc1647 100644
--- a/unix/tclUnixTest.c
+++ b/unix/tclUnixTest.c
@@ -66,6 +66,8 @@ static int		TestfilewaitCmd(ClientData dummy,
 			    Tcl_Interp *interp, int argc, CONST char **argv);
 static int		TestfindexecutableCmd(ClientData dummy,
 			    Tcl_Interp *interp, int argc, CONST char **argv);
+static int		TestforkObjCmd(ClientData dummy,
+			    Tcl_Interp *interp, int objc, Tcl_Obj *CONST *argv);
 static int		TestgetopenfileCmd(ClientData dummy,
 			    Tcl_Interp *interp, int argc, CONST char **argv);
 static int		TestgetdefencdirCmd(ClientData dummy,
@@ -110,6 +112,8 @@ TclplatformtestInit(
             (ClientData) 0, NULL);
     Tcl_CreateCommand(interp, "testfindexecutable", TestfindexecutableCmd,
             (ClientData) 0, NULL);
+    Tcl_CreateObjCommand(interp, "testfork", TestforkObjCmd,
+            (ClientData) 0, NULL);
     Tcl_CreateCommand(interp, "testgetopenfile", TestgetopenfileCmd,
             (ClientData) 0, NULL);
     Tcl_CreateCommand(interp, "testgetdefenc", TestgetdefencdirCmd,
@@ -533,6 +537,52 @@ TestsetdefencdirCmd(
     Tcl_SetDefaultEncodingDir(argv[1]);
     return TCL_OK;
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestforkObjCmd --
+ *
+ *	This function implements the "testfork" command. It is used to
+ *	fork the Tcl process for specific test cases.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestforkObjCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *CONST *objv)		/* Argument strings. */
+{
+    pid_t pid;
+
+    if (objc != 1) {
+        Tcl_WrongNumArgs(interp, 1, objv, "");
+        return TCL_ERROR;
+    }
+    pid = fork();
+    if (pid == -1) {
+        Tcl_AppendResult(interp,
+                "Cannot fork", NULL);
+        return TCL_ERROR;
+    }
+#ifndef HAVE_PTHREAD_ATFORK
+    /* Only needed when pthread_atfork is not present. */
+    if (pid==0) {
+	Tcl_InitNotifier();
+    }
+#endif
+    Tcl_SetObjResult(interp, Tcl_NewIntObj(pid));
+    return TCL_OK;
+}
 
 /*
  *----------------------------------------------------------------------
-- 
cgit v0.12


From f796ad762c4354f621d513a997b320048a0a0f9a Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 23 Jul 2013 18:01:36 +0000
Subject: Stop checking stack depth in [catch] compiler. Stack depth is checked
 in compiles of *all* Tcl commands/scripts/bodies in debug builds already.

---
 generic/tclCompCmds.c | 10 ----------
 1 file changed, 10 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 7fe0728..bde6f96 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -544,7 +544,6 @@ TclCompileCatchCmd(
     JumpFixup jumpFixup;
     Tcl_Token *cmdTokenPtr, *resultNameTokenPtr, *optsNameTokenPtr;
     int resultIndex, optsIndex, range;
-    int initStackDepth = envPtr->currStackDepth;
     DefineLineInformation;	/* TIP #280 */
 
     /*
@@ -742,15 +741,6 @@ TclCompileCatchCmd(
 	TclEmitOpcode(		INST_POP,			envPtr);
     }
 
-    /* 
-     * Result of all this, on either branch, should have been to leave one
-     * operand -- the return code -- on the stack.
-     */
-
-    if (envPtr->currStackDepth != initStackDepth + 1) {
-	Tcl_Panic("in TclCompileCatchCmd, currStackDepth = %d should be %d",
-		  envPtr->currStackDepth, initStackDepth+1);
-    }
     return TCL_OK;
 }
 
-- 
cgit v0.12


From 8163234efdf4df6b2cbfc307170a68219a65f528 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 23 Jul 2013 18:03:39 +0000
Subject: Remove outdated comment.  Stack depths are well checked now.

---
 generic/tclCompCmdsSZ.c | 3 ---
 1 file changed, 3 deletions(-)

diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 320ed57..d8587be 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -991,9 +991,6 @@ TclSubstCompile(
  *	Instructions are added to envPtr to execute the "switch" command at
  *	runtime.
  *
- * FIXME:
- *	Stack depths are probably not calculated correctly.
- *
  *----------------------------------------------------------------------
  */
 
-- 
cgit v0.12


From e0437fdf5828507b1d8411139e0030b2543259ee Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 23 Jul 2013 20:11:00 +0000
Subject: Remove outdated, disabled code.

---
 generic/tclCompile.c | 503 ---------------------------------------------------
 1 file changed, 503 deletions(-)

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index a52ad3e..e4da2ba 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -16,8 +16,6 @@
 #include "tclCompile.h"
 #include <assert.h>
 
-#define REWRITE
-
 /*
  * Table of all AuxData types.
  */
@@ -564,10 +562,6 @@ static void		EnterCmdExtentData(CompileEnv *envPtr,
 			    int cmdNumber, int numSrcBytes, int numCodeBytes);
 static void		EnterCmdStartData(CompileEnv *envPtr,
 			    int cmdNumber, int srcOffset, int codeOffset);
-#ifndef REWRITE
-static Command *	FindCompiledCommandFromToken(Tcl_Interp *interp,
-			    Tcl_Token *tokenPtr);
-#endif
 static void		FreeByteCodeInternalRep(Tcl_Obj *objPtr);
 static void		FreeSubstCodeInternalRep(Tcl_Obj *objPtr);
 static int		GetCmdLocEncodingSize(CompileEnv *envPtr);
@@ -1672,56 +1666,6 @@ TclWordKnownAtCompileTime(
     return 1;
 }
 
-#ifndef REWRITE
-/*
- * ---------------------------------------------------------------------
- *
- * FindCompiledCommandFromToken --
- *
- *	A simple helper that looks up a command's compiler from its token.
- *
- * ---------------------------------------------------------------------
- */
-
-static Command *
-FindCompiledCommandFromToken(
-    Tcl_Interp *interp,
-    Tcl_Token *tokenPtr)
-{
-    Tcl_DString ds;
-    Command *cmdPtr;
-
-    /*
-     * If we have a non-trivial token or are suppressing compilation, we stop
-     * right now.
-     */
-
-    if ((tokenPtr->type != TCL_TOKEN_SIMPLE_WORD)
-	    || (((Interp *) interp)->flags & DONT_COMPILE_CMDS_INLINE)) {
-	return NULL;
-    }
-
-    /*
-     * We copy the string before trying to find the command by name. We used
-     * to modify the string in place, but this is not safe because the name
-     * resolution handlers could have side effects that rely on the unmodified
-     * string.
-     */
-
-    Tcl_DStringInit(&ds);
-    TclDStringAppendToken(&ds, &tokenPtr[1]);
-    cmdPtr = (Command *) Tcl_FindCommand(interp, Tcl_DStringValue(&ds), NULL,
-	    /*flags*/ 0);
-    if (cmdPtr != NULL && (cmdPtr->compileProc == NULL
-	    || (cmdPtr->nsPtr->flags & NS_SUPPRESS_COMPILATION)
-	    || (cmdPtr->flags & CMD_HAS_EXEC_TRACES))) {
-	cmdPtr = NULL;
-    }
-    Tcl_DStringFree(&ds);
-    return cmdPtr;
-}
-#endif
-
 /*
  *----------------------------------------------------------------------
  *
@@ -1740,8 +1684,6 @@ FindCompiledCommandFromToken(
  *----------------------------------------------------------------------
  */
 
-#ifdef REWRITE
-
 static int
 ExpandRequested(
     Tcl_Token *tokenPtr,
@@ -2071,7 +2013,6 @@ CompileCommandTokens(
 
     return cmdIdx;
 }
-#endif
 
 void
 TclCompileScript(
@@ -2084,7 +2025,6 @@ TclCompileScript(
 				 * first null character. */
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
-#ifdef REWRITE
     int lastCmdIdx = -1;	/* Index into envPtr->cmdMapPtr of the last
 				 * command this routine compiles into bytecode.
 				 * Initial value of -1 indicates this routine
@@ -2198,449 +2138,6 @@ TclCompileScript(
 	envPtr->codeNext--;
 	envPtr->currStackDepth++;
     }
-#else
-    int lastTopLevelCmdIndex = -1;
-				/* Index of most recent toplevel command in
-				 * the command location table. Initialized to
-				 * avoid compiler warning. */
-    int startCodeOffset = -1;	/* Offset of first byte of current command's
-				 * code. Init. to avoid compiler warning. */
-    unsigned char *entryCodeNext = envPtr->codeNext;
-    const char *p, *next;
-    Command *cmdPtr;
-    Tcl_Token *tokenPtr;
-    int bytesLeft, isFirstCmd, wordIdx, currCmdIndex, commandLength, objIndex;
-    /* TIP #280 */
-    ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
-    int *wlines, wlineat, cmdLine, *clNext;
-    Tcl_Parse parse, *parsePtr = &parse;
-
-    if (envPtr->iPtr == NULL) {
-	Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv");
-    }
-
-    if (numBytes < 0) {
-	numBytes = strlen(script);
-    }
-    Tcl_ResetResult(interp);
-    isFirstCmd = 1;
-
-    /*
-     * Each iteration through the following loop compiles the next command
-     * from the script.
-     */
-
-    p = script;
-    bytesLeft = numBytes;
-    cmdLine = envPtr->line;
-    clNext = envPtr->clNext;
-    do {
-	if (Tcl_ParseCommand(interp, p, bytesLeft, 0, parsePtr) != TCL_OK) {
-	    /*
-	     * Compile bytecodes to report the parse error at runtime.
-	     */
-
-	    Tcl_LogCommandInfo(interp, script, parsePtr->commandStart,
-		    parsePtr->term + 1 - parsePtr->commandStart);
-	    TclCompileSyntaxError(interp, envPtr);
-	    break;
-	}
-
-	/*
-	 * TIP #280: We have to count newlines before the command even in the
-	 * degenerate case when the command has no words. (See test
-	 * info-30.33).
-	 * So make that counting here, and not in the (numWords > 0) branch
-	 * below.
-	 */
-
-	TclAdvanceLines(&cmdLine, p, parsePtr->commandStart);
-	TclAdvanceContinuations(&cmdLine, &clNext,
-		parsePtr->commandStart - envPtr->source);
-
-	if (parsePtr->numWords > 0) {
-	    int expand = 0;	/* Set if there are dynamic expansions to
-				 * handle */
-
-	    /*
-	     * If not the first command, pop the previous command's result
-	     * and, if we're compiling a top level command, update the last
-	     * command's code size to account for the pop instruction.
-	     */
-
-	    if (!isFirstCmd) {
-		TclEmitOpcode(INST_POP, envPtr);
-		envPtr->cmdMapPtr[lastTopLevelCmdIndex].numCodeBytes =
-			(envPtr->codeNext - envPtr->codeStart)
-			- startCodeOffset;
-	    }
-
-	    /*
-	     * Determine the actual length of the command.
-	     */
-
-	    commandLength = parsePtr->commandSize;
-	    if (parsePtr->term == parsePtr->commandStart + commandLength-1) {
-		/*
-		 * The command terminator character (such as ; or ]) is the
-		 * last character in the parsed command. Reduce the length by
-		 * one so that the trace message doesn't include the
-		 * terminator character.
-		 */
-
-		commandLength -= 1;
-	    }
-
-#ifdef TCL_COMPILE_DEBUG
-	    /*
-	     * If tracing, print a line for each top level command compiled.
-	     */
-
-	    if ((tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) {
-		fprintf(stdout, "  Compiling: ");
-		TclPrintSource(stdout, parsePtr->commandStart,
-			TclMin(commandLength, 55));
-		fprintf(stdout, "\n");
-	    }
-#endif
-
-	    /*
-	     * Check whether expansion has been requested for any of the
-	     * words.
-	     */
-
-	    for (wordIdx = 0, tokenPtr = parsePtr->tokenPtr;
-		    wordIdx < parsePtr->numWords;
-		    wordIdx++, tokenPtr += tokenPtr->numComponents + 1) {
-		if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
-		    expand = 1;
-		    break;
-		}
-	    }
-
-	    /*
-	     * If expansion was requested, check if the command declares that
-	     * it knows how to compile it. Note that if expansion is requested
-	     * for the first word, this check will fail as the token type will
-	     * inhibit it. (Checked inside FindCompiledCommandFromToken.) This
-	     * is as it should be.
-	     */
-
-	    if (expand) {
-		cmdPtr = FindCompiledCommandFromToken(interp,
-			parsePtr->tokenPtr);
-		if (cmdPtr && (cmdPtr->flags & CMD_COMPILES_EXPANDED)) {
-		    expand = 0;
-		}
-	    }
-
-	    envPtr->numCommands++;
-	    currCmdIndex = envPtr->numCommands - 1;
-	    lastTopLevelCmdIndex = currCmdIndex;
-	    startCodeOffset = envPtr->codeNext - envPtr->codeStart;
-	    EnterCmdStartData(envPtr, currCmdIndex,
-		    parsePtr->commandStart - envPtr->source, startCodeOffset);
-
-	    /*
-	     * Should only start issuing instructions after the "command has
-	     * started" so that the command range is correct in the bytecode.
-	     */
-
-	    if (expand) {
-		StartExpanding(envPtr);
-	    }
-
-	    /*
-	     * 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'.
-	     */
-
-	    EnterCmdWordData(eclPtr, parsePtr->commandStart - envPtr->source,
-		    parsePtr->tokenPtr, parsePtr->commandStart,
-		    parsePtr->commandSize, parsePtr->numWords, cmdLine,
-		    clNext, &wlines, envPtr);
-	    wlineat = eclPtr->nuloc - 1;
-
-	    /*
-	     * Each iteration of the following loop compiles one word from the
-	     * command.
-	     */
-
-	    for (wordIdx = 0, tokenPtr = parsePtr->tokenPtr;
-		    wordIdx < parsePtr->numWords; wordIdx++,
-		    tokenPtr += tokenPtr->numComponents + 1) {
-		/*
-		 * Note the parse location information.
-		 */
-
-		envPtr->line = eclPtr->loc[wlineat].line[wordIdx];
-		envPtr->clNext = eclPtr->loc[wlineat].next[wordIdx];
-
-		if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-		    /*
-		     * The word is not a simple string of characters.
-		     */
-
-		    CompileTokens(envPtr, tokenPtr, interp);
-		    if (expand && tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
-			TclEmitInstInt4(INST_EXPAND_STKTOP,
-				envPtr->currStackDepth, envPtr);
-		    }
-		    continue;
-		}
-
-		/*
-		 * This is a simple string of literal characters (i.e. we know
-		 * it absolutely and can use it directly). If this is the
-		 * first word and the command has a compile procedure, let it
-		 * compile the command.
-		 */
-
-		if ((wordIdx == 0) && !expand) {
-		    cmdPtr = FindCompiledCommandFromToken(interp, tokenPtr);
-		    if (cmdPtr) {
-			int savedNumCmds = envPtr->numCommands;
-			unsigned savedCodeNext =
-				envPtr->codeNext - envPtr->codeStart;
-			int update = 0;
-			int startStackDepth = envPtr->currStackDepth;
-
-			/*
-			 * Mark the start of the command; the proper bytecode
-			 * length will be updated later. There is no need to
-			 * do this for the first bytecode in the compile env,
-			 * as the check is done before calling
-			 * TclNRExecuteByteCode(). Do emit an INST_START_CMD
-			 * in special cases where the first bytecode is in a
-			 * loop, to insure that the corresponding command is
-			 * counted properly. Compilers for commands able to
-			 * produce such a beast (currently 'while 1' only) set
-			 * envPtr->atCmdStart to 0 in order to signal this
-			 * case. [Bug 1752146]
-			 *
-			 * Note that the environment is initialised with
-			 * atCmdStart=1 to avoid emitting ISC for the first
-			 * command.
-			 */
-
-			if (envPtr->atCmdStart == 1) {
-			    if (savedCodeNext != 0) {
-				/*
-				 * Increase the number of commands being
-				 * started at the current point. Note that
-				 * this depends on the exact layout of the
-				 * INST_START_CMD's operands, so be careful!
-				 */
-
-				TclIncrUInt4AtPtr(envPtr->codeNext - 4, 1)
-			    }
-			} else if (envPtr->atCmdStart == 0) {
-			    TclEmitInstInt4(INST_START_CMD, 0, envPtr);
-			    TclEmitInt4(1, envPtr);
-			    update = 1;
-			}
-
-			if (cmdPtr->compileProc(interp, parsePtr, cmdPtr,
-				envPtr) == TCL_OK) {
-			    /*
-			     * Confirm that the command compiler generated a
-			     * single value on the stack as its result. This
-			     * is only done in debugging mode, as it *should*
-			     * be correct and normal users have no reasonable
-			     * way to fix it anyway.
-			     */
-
-#ifdef TCL_COMPILE_DEBUG
-			    int diff = envPtr->currStackDepth-startStackDepth;
-
-			    if (diff != 1) {
-				Tcl_Panic("bad stack adjustment when compiling"
-					" %.*s (was %d instead of 1)",
-					parsePtr->tokenPtr->size,
-					parsePtr->tokenPtr->start, diff);
-			    }
-#endif
-			    if (update) {
-				/*
-				 * Fix the bytecode length.
-				 */
-
-				unsigned char *fixPtr = envPtr->codeStart
-					+ savedCodeNext + 1;
-				unsigned fixLen = envPtr->codeNext
-					- envPtr->codeStart - savedCodeNext;
-
-				TclStoreInt4AtPtr(fixLen, fixPtr);
-			    }
-			    goto finishCommand;
-			}
-
-			if (envPtr->atCmdStart == 1 && savedCodeNext != 0) {
-			    /*
-			     * Decrease the number of commands being started
-			     * at the current point. Note that this depends on
-			     * the exact layout of the INST_START_CMD's
-			     * operands, so be careful!
-			     */
-
-			    TclIncrUInt4AtPtr(envPtr->codeNext - 4, -1);
-			}
-
-			/*
-			 * Restore numCommands and codeNext to their correct
-			 * values, removing any commands compiled before the
-			 * failure to produce bytecode got reported. [Bugs
-			 * 705406 and 735055]
-			 */
-
-			envPtr->numCommands = savedNumCmds;
-			envPtr->codeNext = envPtr->codeStart + savedCodeNext;
-
-			/*
-			 * And the stack depth too!!  [Bug 3614102].
-			 */
-
-			envPtr->currStackDepth = startStackDepth;
-		    }
-
-		    /*
-		     * No compile procedure so push the word. If the command
-		     * was found, push a CmdName object to reduce runtime
-		     * lookups. Mark this as a command name literal to reduce
-		     * shimmering. 
-		     */
-
-		    objIndex = TclRegisterNewCmdLiteral(envPtr,
-			    tokenPtr[1].start, tokenPtr[1].size);
-		    if (cmdPtr) {
-			TclSetCmdNameObj(interp,
-				TclFetchLiteral(envPtr, objIndex), cmdPtr);
-		    }
-		} else {
-		    /*
-		     * Simple argument word of a command. We reach this if and
-		     * only if the command word was not compiled for whatever
-		     * reason. Register the literal's location for use by
-		     * uplevel, etc. commands, should they encounter it
-		     * unmodified. We care only if the we are in a context
-		     * which already allows absolute counting.
-		     */
-
-		    objIndex = TclRegisterNewLiteral(envPtr,
-			    tokenPtr[1].start, tokenPtr[1].size);
-
-		    if (envPtr->clNext) {
-			TclContinuationsEnterDerived(
-				TclFetchLiteral(envPtr, objIndex),
-				tokenPtr[1].start - envPtr->source,
-				eclPtr->loc[wlineat].next[wordIdx]);
-		    }
-		}
-		TclEmitPush(objIndex, envPtr);
-	    } /* for loop */
-
-	    /*
-	     * Emit an invoke instruction for the command. We skip this if a
-	     * compile procedure was found for the command.
-	     */
-	    assert(wordIdx > 0);
-
-	    if (expand) {
-		/*
-		 * The stack depth during argument expansion can only be
-		 * managed at runtime, as the number of elements in the
-		 * expanded lists is not known at compile time. We adjust here
-		 * the stack depth estimate so that it is correct after the
-		 * command with expanded arguments returns.
-		 *
-		 * The end effect of this command's invocation is that all the
-		 * words of the command are popped from the stack, and the
-		 * result is pushed: the stack top changes by (1-wordIdx).
-		 *
-		 * Note that the estimates are not correct while the command
-		 * is being prepared and run, INST_EXPAND_STKTOP is not
-		 * stack-neutral in general.
-		 */
-
-		TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr);
-		envPtr->expandCount--;
-		TclAdjustStackDepth(1 - wordIdx, envPtr);
-	    } else {
-		/*
-		 * Save PC -> command map for the TclArgumentBC* functions.
-		 */
-
-		int isnew;
-		Tcl_HashEntry *hePtr = Tcl_CreateHashEntry(&eclPtr->litInfo,
-			INT2PTR(envPtr->codeNext - envPtr->codeStart),
-			&isnew);
-
-		Tcl_SetHashValue(hePtr, INT2PTR(wlineat));
-		if (wordIdx <= 255) {
-		    TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr);
-		} else {
-		    TclEmitInstInt4(INST_INVOKE_STK4, wordIdx, envPtr);
-		}
-	    }
-
-	    /*
-	     * Update the compilation environment structure and record the
-	     * offsets of the source and code for the command.
-	     */
-
-	finishCommand:
-	    EnterCmdExtentData(envPtr, currCmdIndex, commandLength,
-		    (envPtr->codeNext-envPtr->codeStart) - startCodeOffset);
-	    isFirstCmd = 0;
-
-	    /*
-	     * TIP #280: Free full form of per-word line data and insert the
-	     * reduced form now
-	     */
-
-	    ckfree(eclPtr->loc[wlineat].line);
-	    ckfree(eclPtr->loc[wlineat].next);
-	    eclPtr->loc[wlineat].line = wlines;
-	    eclPtr->loc[wlineat].next = NULL;
-	} /* end if parsePtr->numWords > 0 */
-
-	/*
-	 * Advance to the next command in the script.
-	 */
-
-	next = parsePtr->commandStart + parsePtr->commandSize;
-	bytesLeft -= next - p;
-	p = next;
-
-	/*
-	 * TIP #280: Track lines in the just compiled command.
-	 */
-
-	TclAdvanceLines(&cmdLine, parsePtr->commandStart, p);
-	TclAdvanceContinuations(&cmdLine, &clNext, p - envPtr->source);
-	Tcl_FreeParse(parsePtr);
-    } while (bytesLeft > 0);
-
-    /*
-     * TIP #280: Bring the line counts in the CompEnv up to date.
-     *	See tests info-30.33,34,35 .
-     */
-
-    envPtr->line = cmdLine;
-    envPtr->clNext = clNext;
-
-    /*
-     * If the source script yielded no instructions (e.g., if it was empty),
-     * push an empty string as the command's result.
-     */
-
-    if (envPtr->codeNext == entryCodeNext) {
-	PushStringLiteral(envPtr, "");
-    }
-#endif
 }
 
 /*
-- 
cgit v0.12


From d818803502a3520a2aa8c1a7ce11b8733eaafcc1 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 24 Jul 2013 12:13:01 +0000
Subject: more disabled code removal

---
 generic/tclAssembly.c |  7 -------
 generic/tclEnsemble.c | 46 ----------------------------------------------
 2 files changed, 53 deletions(-)

diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 9b9b6f8..6bf2fa8 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -930,11 +930,9 @@ TclCompileAssembleCmd(
 {
     Tcl_Token *tokenPtr;	/* Token in the input script */
 
-#if 1
     int numCommands = envPtr->numCommands;
     int offset = envPtr->codeNext - envPtr->codeStart;
     int depth = envPtr->currStackDepth;
-#endif
 
     /*
      * Make sure that the command has a single arg that is a simple word.
@@ -956,7 +954,6 @@ TclCompileAssembleCmd(
     if (TCL_ERROR == TclAssembleCode(envPtr, tokenPtr[1].start,
 	    tokenPtr[1].size, TCL_EVAL_DIRECT)) {
 
-#if 1
 	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
 		"\n    (\"%.*s\" body, line %d)",
 		parsePtr->tokenPtr->size, parsePtr->tokenPtr->start,
@@ -965,10 +962,6 @@ TclCompileAssembleCmd(
 	envPtr->codeNext = envPtr->codeStart + offset;
 	envPtr->currStackDepth = depth;
 	TclCompileSyntaxError(interp, envPtr);
-#else
-	Tcl_ResetResult(interp);
-	return TCL_ERROR;
-#endif
     }
     return TCL_OK;
 }
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index bab63c9..ad11785 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -3205,7 +3205,6 @@ CompileBasicNArgCommand(
 				 * compiled. */
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
-#if 1
     Tcl_Obj *objPtr = Tcl_NewObj();
 
     Tcl_IncrRefCount(objPtr);
@@ -3213,51 +3212,6 @@ CompileBasicNArgCommand(
     TclCompileInvocation(interp, parsePtr->tokenPtr, objPtr,
 	    parsePtr->numWords, envPtr);
     Tcl_DecrRefCount(objPtr);
-#else
-    Tcl_Token *tokenPtr;
-    Tcl_Obj *objPtr;
-    char *bytes;
-    int length, i, literal;
-    DefineLineInformation;
-
-    /*
-     * Push the name of the command we're actually dispatching to as part of
-     * the implementation.
-     */
-
-    objPtr = Tcl_NewObj();
-    Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
-    bytes = Tcl_GetStringFromObj(objPtr, &length);
-    literal = TclRegisterNewCmdLiteral(envPtr, bytes, length);
-    TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, literal), cmdPtr);
-    TclEmitPush(literal, envPtr);
-    TclDecrRefCount(objPtr);
-
-    /*
-     * Push the words of the command.
-     */
-
-    tokenPtr = TokenAfter(parsePtr->tokenPtr);
-    for (i=1 ; i<parsePtr->numWords ; i++) {
-	if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-	    PushLiteral(envPtr, tokenPtr[1].start, tokenPtr[1].size);
-	} else {
-	    SetLineInformation(i);
-	    CompileTokens(envPtr, tokenPtr, interp);
-	}
-	tokenPtr = TokenAfter(tokenPtr);
-    }
-
-    /*
-     * Do the standard dispatch.
-     */
-
-    if (i <= 255) {
-	TclEmitInstInt1(INST_INVOKE_STK1, i, envPtr);
-    } else {
-	TclEmitInstInt4(INST_INVOKE_STK4, i, envPtr);
-    }
-#endif
     return TCL_OK;
 }
 
-- 
cgit v0.12


From f2bea640bbf79037a46201c95c581f6f8ac5e5ee Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 24 Jul 2013 13:58:35 +0000
Subject: Mark commands with potential to compile expansion arguments (as
 [list] does).

---
 generic/tclCompCmds.c   | 9 +++++++++
 generic/tclCompCmdsGR.c | 4 ++++
 generic/tclCompCmdsSZ.c | 5 +++++
 3 files changed, 18 insertions(+)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index bde6f96..8edb2d9 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -87,6 +87,7 @@ TclCompileAppendCmd(
     int isScalar, localIndex, numWords, i;
     DefineLineInformation;	/* TIP #280 */
 
+    /* TODO: Consider support for compiling expanded args. */
     numWords = parsePtr->numWords;
     if (numWords == 1) {
 	return TCL_ERROR;
@@ -973,6 +974,7 @@ TclCompileDictGetCmd(
      * case is legal, but too special and magic for us to deal with here).
      */
 
+    /* TODO: Consider support for compiling expanded args. */
     if (parsePtr->numWords < 3) {
 	return TCL_ERROR;
     }
@@ -1010,6 +1012,7 @@ TclCompileDictExistsCmd(
      * case is legal, but too special and magic for us to deal with here).
      */
 
+    /* TODO: Consider support for compiling expanded args. */
     if (parsePtr->numWords < 3) {
 	return TCL_ERROR;
     }
@@ -1047,6 +1050,7 @@ TclCompileDictUnsetCmd(
      * compile to bytecode.
      */
 
+    /* TODO: Consider support for compiling expanded args. */
     if (parsePtr->numWords < 3) {
 	return TCL_ERROR;
     }
@@ -1192,6 +1196,7 @@ TclCompileDictMergeCmd(
      * argument, the only thing to do is to verify the dict-ness.
      */
 
+    /* TODO: Consider support for compiling expanded args. (less likely) */
     if (parsePtr->numWords < 2) {
 	PushStringLiteral(envPtr, "");
 	return TCL_OK;
@@ -1712,6 +1717,7 @@ TclCompileDictAppendCmd(
      * speed quite so much. ;-)
      */
 
+    /* TODO: Consider support for compiling expanded args. */
     if (parsePtr->numWords<4 || parsePtr->numWords>100) {
 	return TCL_ERROR;
     }
@@ -1764,6 +1770,8 @@ TclCompileDictLappendCmd(
      * There must be three arguments after the command.
      */
 
+    /* TODO: Consider support for compiling expanded args. */
+    /* Probably not.  Why is INST_DICT_LAPPEND limited to one value? */
     if (parsePtr->numWords != 4) {
 	return TCL_ERROR;
     }
@@ -1810,6 +1818,7 @@ TclCompileDictWithCmd(
      * There must be at least one argument after the command.
      */
 
+    /* TODO: Consider support for compiling expanded args. */
     if (parsePtr->numWords < 3) {
 	return TCL_ERROR;
     }
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index fc68509..150c378 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -60,6 +60,7 @@ TclCompileGlobalCmd(
     int localIndex, numWords, i;
     DefineLineInformation;	/* TIP #280 */
 
+    /* TODO: Consider support for compiling expanded args. */
     numWords = parsePtr->numWords;
     if (numWords < 2) {
 	return TCL_ERROR;
@@ -820,6 +821,7 @@ TclCompileLappendCmd(
 	return TCL_ERROR;
     }
 
+    /* TODO: Consider support for compiling expanded args. */
     numWords = parsePtr->numWords;
     if (numWords == 1) {
 	return TCL_ERROR;
@@ -1061,6 +1063,7 @@ TclCompileLindexCmd(
      * Quit if too few args.
      */
 
+    /* TODO: Consider support for compiling expanded args. */
     if (numWords <= 1) {
 	return TCL_ERROR;
     }
@@ -1583,6 +1586,7 @@ TclCompileLsetCmd(
      * Check argument count.
      */
 
+    /* TODO: Consider support for compiling expanded args. */
     if (parsePtr->numWords < 3) {
 	/*
 	 * Fail at run time, not in compilation.
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index d8587be..d1eb9db 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -2818,6 +2818,7 @@ TclCompileUnsetCmd(
     Tcl_Obj *leadingWord;
     DefineLineInformation;	/* TIP #280 */
 
+    /* TODO: Consider support for compiling expanded args. */
     numWords = parsePtr->numWords-1;
     flags = 1;
     varTokenPtr = TokenAfter(parsePtr->tokenPtr);
@@ -3173,6 +3174,7 @@ CompileAssociativeBinaryOpCmd(
     DefineLineInformation;	/* TIP #280 */
     int words;
 
+    /* TODO: Consider support for compiling expanded args. */
     for (words=1 ; words<parsePtr->numWords ; words++) {
 	tokenPtr = TokenAfter(tokenPtr);
 	CompileWord(envPtr, tokenPtr, interp, words);
@@ -3256,6 +3258,7 @@ CompileComparisonOpCmd(
     Tcl_Token *tokenPtr;
     DefineLineInformation;	/* TIP #280 */
 
+    /* TODO: Consider support for compiling expanded args. */
     if (parsePtr->numWords < 3) {
 	PUSH("1");
     } else if (parsePtr->numWords == 3) {
@@ -3593,6 +3596,7 @@ TclCompileMinusOpCmd(
     DefineLineInformation;	/* TIP #280 */
     int words;
 
+    /* TODO: Consider support for compiling expanded args. */
     if (parsePtr->numWords == 1) {
 	/*
 	 * Fallback to direct eval to report syntax error.
@@ -3638,6 +3642,7 @@ TclCompileDivOpCmd(
     DefineLineInformation;	/* TIP #280 */
     int words;
 
+    /* TODO: Consider support for compiling expanded args. */
     if (parsePtr->numWords == 1) {
 	/*
 	 * Fallback to direct eval to report syntax error.
-- 
cgit v0.12


From 8f2d19b95103df07e718125efcd772ff582c2be1 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 24 Jul 2013 16:51:04 +0000
Subject: Demonstrate and fix memory leak in Tcl_ParseVar().

---
 generic/tclParse.c |  1 +
 tests/parse.test   | 21 +++++++++++++++++++++
 2 files changed, 22 insertions(+)

diff --git a/generic/tclParse.c b/generic/tclParse.c
index 96c2a10..e475fb8 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -1566,6 +1566,7 @@ Tcl_ParseVar(
 
     code = TclSubstTokens(interp, parsePtr->tokenPtr, parsePtr->numTokens,
 	    NULL, 1, NULL, NULL);
+    Tcl_FreeParse(parsePtr);
     TclStackFree(interp, parsePtr);
     if (code != TCL_OK) {
 	return NULL;
diff --git a/tests/parse.test b/tests/parse.test
index 4605914..d7de5ff 100644
--- a/tests/parse.test
+++ b/tests/parse.test
@@ -23,6 +23,7 @@ testConstraint testparsevarname [llength [info commands testparsevarname]]
 testConstraint testparsevar [llength [info commands testparsevar]]
 testConstraint testasync [llength [info commands testasync]]
 testConstraint testcmdtrace [llength [info commands testcmdtrace]]
+testConstraint memory [llength [info commands memory]]
 
 test parse-1.1 {Tcl_ParseCommand procedure, computing string length} testparser {
     testparser [bytestring "foo\0 bar"] -1
@@ -674,6 +675,26 @@ test parse-13.5 {Tcl_ParseVar procedure, error looking up variable} testparsevar
     unset -nocomplain abc
     list [catch {testparsevar {$abc([bogus x y z])}} msg] $msg
 } {1 {invalid command name "bogus"}}
+test parse-13.6 {Tcl_ParseVar memory leak} -constraints memory -setup {
+    proc getbytes {} {
+	return [lindex [split [memory info] \n] 3 3]
+    }
+} -body {
+    set a() foo
+    set end [getbytes]
+    for {set i 0} {$i < 5} {incr i} {
+	set vn {}
+	set res [testparsevar [append vn $ a([string repeat {[]} 19]) bar]]
+	if {$res ne {foo bar}} {error "Unexpected result: $res"}
+
+	set tmp $end
+	set end [getbytes]
+    }
+    expr {$end - $tmp}
+} -cleanup {
+    unset -nocomplain a end i vn res tmp
+    rename getbytes {}
+} -result 0
 
 test parse-14.1 {Tcl_ParseBraces procedure, computing string length} testparser {
     testparser [bytestring "foo\0 bar"] -1
-- 
cgit v0.12


From c019848148730c03e59a86793f155327f407cd7e Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Thu, 25 Jul 2013 06:59:08 +0000
Subject: Put Cygwin's tclWinError.o in PLAT_OBJS, not in DL_OBJS

---
 unix/Makefile.in | 5 ++++-
 unix/configure   | 3 ++-
 unix/tcl.m4      | 3 ++-
 3 files changed, 8 insertions(+), 3 deletions(-)

diff --git a/unix/Makefile.in b/unix/Makefile.in
index b5ca879..163f4b5 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -335,7 +335,10 @@ TOMMATH_OBJS = bncore.o bn_reverse.o bn_fast_s_mp_mul_digs.o \
 	bn_mp_unsigned_bin_size.o bn_mp_xor.o bn_mp_zero.o bn_s_mp_add.o \
         bn_s_mp_mul_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o
 
-STUB_LIB_OBJS = tclStubLib.o tclTomMathStubLib.o tclOOStubLib.o ${COMPAT_OBJS}
+STUB_LIB_OBJS = tclStubLib.o \
+	tclTomMathStubLib.o \
+	tclOOStubLib.o \
+	${COMPAT_OBJS}
 
 UNIX_OBJS = tclUnixChan.o tclUnixEvent.o tclUnixFCmd.o \
 	tclUnixFile.o tclUnixPipe.o tclUnixSock.o \
diff --git a/unix/configure b/unix/configure
index ef47ac5..4d0ecef 100755
--- a/unix/configure
+++ b/unix/configure
@@ -7170,7 +7170,8 @@ fi
 	    SHLIB_CFLAGS=""
 	    SHLIB_LD='${CC} -shared'
 	    SHLIB_SUFFIX=".dll"
-	    DL_OBJS="tclLoadDl.o tclWinError.o"
+	    DL_OBJS="tclLoadDl.o"
+	    PLAT_OBJS="tclWinError.o"
 	    DL_LIBS="-ldl"
 	    CC_SEARCH_FLAGS=""
 	    LD_SEARCH_FLAGS=""
diff --git a/unix/tcl.m4 b/unix/tcl.m4
index b9b6532..a95cf63 100644
--- a/unix/tcl.m4
+++ b/unix/tcl.m4
@@ -1224,7 +1224,8 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
 	    SHLIB_CFLAGS=""
 	    SHLIB_LD='${CC} -shared'
 	    SHLIB_SUFFIX=".dll"
-	    DL_OBJS="tclLoadDl.o tclWinError.o"
+	    DL_OBJS="tclLoadDl.o"
+	    PLAT_OBJS="tclWinError.o"
 	    DL_LIBS="-ldl"
 	    CC_SEARCH_FLAGS=""
 	    LD_SEARCH_FLAGS=""
-- 
cgit v0.12


From 889454ec0641c77928cc1967516e497d81703a7f Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Thu, 25 Jul 2013 08:29:56 +0000
Subject: Make sure that the notifierMutex and notifierCV in a forked child
 cannot block anything, even though the initialization of the Notifier Thread
 in the parent is not finished yet.

---
 unix/tclUnixNotfy.c | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c
index f414c3f..ec721ca 100644
--- a/unix/tclUnixNotfy.c
+++ b/unix/tclUnixNotfy.c
@@ -1335,6 +1335,8 @@ AtForkParent(void)
 static void
 AtForkChild(void)
 {
+    notifierMutex = NULL;
+    notifierCV = NULL;
     Tcl_InitNotifier();
 }
 #endif /* HAVE_PTHREAD_ATFORK */
-- 
cgit v0.12


From 60ef39d24a8c8c1572ef6f2efad50706b49e0f06 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Thu, 25 Jul 2013 14:24:39 +0000
Subject: Move test for pthread_atfork inside SC_ENABLE_THREADS

---
 unix/configure    | 105 ++----------------------------------------------------
 unix/configure.in |   1 -
 unix/tcl.m4       |   2 +-
 3 files changed, 3 insertions(+), 105 deletions(-)

diff --git a/unix/configure b/unix/configure
index 9fa5673..217e5d4 100755
--- a/unix/configure
+++ b/unix/configure
@@ -4796,7 +4796,8 @@ echo "$as_me: WARNING: Don't know how to find pthread lib on your system - you m
 	ac_saved_libs=$LIBS
 	LIBS="$LIBS $THREADS_LIBS"
 
-for ac_func in pthread_attr_setstacksize
+
+for ac_func in pthread_attr_setstacksize pthread_atfork
 do
 as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
 echo "$as_me:$LINENO: checking for $ac_func" >&5
@@ -5303,108 +5304,6 @@ echo "${ECHO_T}no (default)" >&6
 
 
 
-for ac_func in pthread_atfork
-do
-as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
-echo "$as_me:$LINENO: checking for $ac_func" >&5
-echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
-if eval "test \"\${$as_ac_var+set}\" = set"; then
-  echo $ECHO_N "(cached) $ECHO_C" >&6
-else
-  cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h.  */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h.  */
-/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func.
-   For example, HP-UX 11i <limits.h> declares gettimeofday.  */
-#define $ac_func innocuous_$ac_func
-
-/* System header to define __stub macros and hopefully few prototypes,
-    which can conflict with char $ac_func (); below.
-    Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
-    <limits.h> exists even on freestanding compilers.  */
-
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
-
-#undef $ac_func
-
-/* Override any gcc2 internal prototype to avoid an error.  */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
-   builtin and then its argument prototype would still apply.  */
-char $ac_func ();
-/* The GNU C library defines this for functions which it implements
-    to always fail with ENOSYS.  Some functions are actually named
-    something starting with __ and the normal name is an alias.  */
-#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
-choke me
-#else
-char (*f) () = $ac_func;
-#endif
-#ifdef __cplusplus
-}
-#endif
-
-int
-main ()
-{
-return f != $ac_func;
-  ;
-  return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
-  (eval $ac_link) 2>conftest.er1
-  ac_status=$?
-  grep -v '^ *+' conftest.er1 >conftest.err
-  rm -f conftest.er1
-  cat conftest.err >&5
-  echo "$as_me:$LINENO: \$? = $ac_status" >&5
-  (exit $ac_status); } &&
-	 { ac_try='test -z "$ac_c_werror_flag"
-			 || test ! -s conftest.err'
-  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
-  (eval $ac_try) 2>&5
-  ac_status=$?
-  echo "$as_me:$LINENO: \$? = $ac_status" >&5
-  (exit $ac_status); }; } &&
-	 { ac_try='test -s conftest$ac_exeext'
-  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
-  (eval $ac_try) 2>&5
-  ac_status=$?
-  echo "$as_me:$LINENO: \$? = $ac_status" >&5
-  (exit $ac_status); }; }; then
-  eval "$as_ac_var=yes"
-else
-  echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-eval "$as_ac_var=no"
-fi
-rm -f conftest.err conftest.$ac_objext \
-      conftest$ac_exeext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6
-if test `eval echo '${'$as_ac_var'}'` = yes; then
-  cat >>confdefs.h <<_ACEOF
-#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
-_ACEOF
-
-fi
-done
-
-
 #------------------------------------------------------------------------
 # Embedded configuration information, encoding to use for the values, TIP #59
 #------------------------------------------------------------------------
diff --git a/unix/configure.in b/unix/configure.in
index 5a7125e..37de8be 100644
--- a/unix/configure.in
+++ b/unix/configure.in
@@ -93,7 +93,6 @@ fi
 #------------------------------------------------------------------------
 
 SC_ENABLE_THREADS
-AC_CHECK_FUNCS(pthread_atfork)
 
 #------------------------------------------------------------------------
 # Embedded configuration information, encoding to use for the values, TIP #59
diff --git a/unix/tcl.m4 b/unix/tcl.m4
index 879d810..f484989 100644
--- a/unix/tcl.m4
+++ b/unix/tcl.m4
@@ -679,7 +679,7 @@ AC_DEFUN([SC_ENABLE_THREADS], [
 
 	ac_saved_libs=$LIBS
 	LIBS="$LIBS $THREADS_LIBS"
-	AC_CHECK_FUNCS(pthread_attr_setstacksize)
+	AC_CHECK_FUNCS(pthread_attr_setstacksize pthread_atfork)
 	AC_CHECK_FUNC(pthread_attr_get_np,tcl_ok=yes,tcl_ok=no)
 	if test $tcl_ok = yes ; then
 	    AC_DEFINE(HAVE_PTHREAD_ATTR_GET_NP, 1,
-- 
cgit v0.12


From 41afeeec2bc072a4327f6e45826cddf2cedcb066 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Thu, 25 Jul 2013 17:20:02 +0000
Subject: Fixed test case variable clash with 'folder'

---
 tests/unixForkEvent.test | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/tests/unixForkEvent.test b/tests/unixForkEvent.test
index a0c3f19..cbe582e 100644
--- a/tests/unixForkEvent.test
+++ b/tests/unixForkEvent.test
@@ -18,27 +18,27 @@ testConstraint testfork [llength [info commands testfork]]
 test unixforkevent-1.1 {fork and test writeable event} \
     -constraints testfork \
     -body {
-	set folder [makeDirectory unixtestfork]
+	set myFolder [makeDirectory unixtestfork]
 	set pid [testfork]
 	if {$pid == 0} {
 	    # we are the forked process
 	    set result initialized
-	    set h [open [file join $folder test.txt] w]
+	    set h [open [file join $myFolder test.txt] w]
 	    fileevent $h writable\
 		    "set result writable;\
 		    after cancel [after 1000 {set result timeout}]"
 	    vwait result
 	    close $h
-	    makeFile $result result.txt $folder
+	    makeFile $result result.txt $myFolder
 	    exit
 	}
 	# we are the original process
-	while {![file readable [file join $folder result.txt]]} {}
-	viewFile result.txt $folder
+	while {![file readable [file join $myFolder result.txt]]} {}
+	viewFile result.txt $myFolder
     } \
     -result {writable} \
     -cleanup { 
-	catch { removeFolder $folder }
+	catch { removeFolder $myFolder }
     }
 
 ::tcltest::cleanupTests
-- 
cgit v0.12


From 6adf3b8c6c375d8b2ec61544abe1acf0a734e5c1 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 26 Jul 2013 13:21:30 +0000
Subject: [6585b21ca8] [regexp {(\w).*?\1} abb] failed to match. Thanks to Tom
 Lane for passing on the discovery in Postgres.

---
 generic/regexec.c | 7 +------
 tests/regexp.test | 4 ++++
 2 files changed, 5 insertions(+), 6 deletions(-)

diff --git a/generic/regexec.c b/generic/regexec.c
index c902209..205fcc2 100644
--- a/generic/regexec.c
+++ b/generic/regexec.c
@@ -512,12 +512,7 @@ cfindloop(
 		    return er;
 		}
 		if ((shorter) ? end == estop : end == begin) {
-		    /*
-		     * No point in trying again.
-		     */
-
-		    *coldp = cold;
-		    return REG_NOMATCH;
+		    break;
 		}
 
 		/*
diff --git a/tests/regexp.test b/tests/regexp.test
index 8138054..362f425 100644
--- a/tests/regexp.test
+++ b/tests/regexp.test
@@ -728,6 +728,10 @@ test regexp-22.5 {Bug 3610026} -setup {
 } -cleanup {
     unset -nocomplain e cp
 } -returnCodes error  -match glob -result {*too many colors*}
+test regexp-22.6 {Bug 6585b21ca8} {
+    expr {[regexp {(\w).*?\1} Programmer m] ? $m : "<NONE>"}
+} rogr
+
 
 test regexp-23.1 {regexp -all and -line} {
     set string ""
-- 
cgit v0.12


From 15ca940ca7c564de29ebeeca34c8140599a831e8 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Sat, 27 Jul 2013 20:29:42 +0000
Subject: Simplify AuxData access with a macro.

---
 generic/tclAssembly.c | 2 +-
 generic/tclCompile.c  | 1 +
 generic/tclCompile.h  | 9 +++++++++
 tests/subst.test      | 4 ++++
 4 files changed, 15 insertions(+), 1 deletion(-)

diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 6bf2fa8..100e9ef 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -3047,7 +3047,7 @@ ResolveJumpTableTargets(
     auxDataIndex = TclGetInt4AtPtr(envPtr->codeStart + bbPtr->jumpOffset + 1);
     DEBUG_PRINT("bbPtr = %p jumpOffset = %d auxDataIndex = %d\n",
 	    bbPtr, bbPtr->jumpOffset, auxDataIndex);
-    realJumpTablePtr = envPtr->auxDataArrayPtr[auxDataIndex].clientData;
+    realJumpTablePtr = TclFetchAuxData(envPtr, auxDataIndex);
     realJumpHashPtr = &realJumpTablePtr->hashTable;
 
     /*
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index e4da2ba..772ce22 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -2055,6 +2055,7 @@ TclCompileScript(
 #ifdef TCL_COMPILE_DEBUG
 	/*
 	 * If tracing, print a line for each top level command compiled.
+	 * TODO: Suppress when numWords == 0 ?
 	 */
 
 	if ((tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) {
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 56315db..beb28fd 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -1113,6 +1113,15 @@ MODULE_SCOPE Tcl_Obj	*TclNewInstNameObj(unsigned char inst);
  *----------------------------------------------------------------
  */
 
+/*
+ * Simplified form to access AuxData.
+ *
+ * ClientData TclFetchAuxData(CompileEng *envPtr, int index);
+ */
+
+#define TclFetchAuxData(envPtr, index) \
+    (envPtr)->auxDataArrayPtr[(index)].clientData
+
 #define LITERAL_ON_HEAP		0x01
 #define LITERAL_CMD_NAME	0x02
 
diff --git a/tests/subst.test b/tests/subst.test
index 4be4798..7466895 100644
--- a/tests/subst.test
+++ b/tests/subst.test
@@ -293,6 +293,10 @@ test subst-13.1 {Bug 3081065} -setup {
 } -cleanup {
     removeFile subst13.tcl
 }
+test subst-13.2 {Test for segfault} -body {
+    subst {[}
+} -returnCodes error -result * -match glob
+
 
 # cleanup
 ::tcltest::cleanupTests
-- 
cgit v0.12


From 84e92af6dc25e59e12d8f7ad4b12016464e030d2 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 29 Jul 2013 09:29:16 +0000
Subject: Make sure that "string is space \u202f" will continue to return "1",
 even if in future Unicode this character (NARROW_NO_BREAK_SPACE) will cease
 to be a space. See: [http://www.unicode.org/review/pri249/]

---
 generic/tclUtf.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/generic/tclUtf.c b/generic/tclUtf.c
index a038f8a..e5497a4 100644
--- a/generic/tclUtf.c
+++ b/generic/tclUtf.c
@@ -1555,7 +1555,7 @@ Tcl_UniCharIsSpace(
 
     if (((Tcl_UniChar) ch) < ((Tcl_UniChar) 0x80)) {
 	return TclIsSpaceProc((char) ch);
-    } else if ((Tcl_UniChar) ch == 0x180e) {
+    } else if ((Tcl_UniChar) ch == 0x180e || (Tcl_UniChar) ch == 0x202f) {
 	return 1;
     } else {
 	return ((SPACE_BITS >> GetCategory(ch)) & 1);
-- 
cgit v0.12


From 965128fe34967f018de2b5fc31e0b5ee88f34ed6 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 1 Aug 2013 19:18:02 +0000
Subject: [1905562] [8d2c0da36d] Raise the recursion limits on regexps to allow
 existing regexps "in the wild" to continue working with Tcl 8.6. Latest
 example comes from DejaGnu.

---
 generic/regc_nfa.c | 2 +-
 tests/reg.test     | 3 +++
 2 files changed, 4 insertions(+), 1 deletion(-)

diff --git a/generic/regc_nfa.c b/generic/regc_nfa.c
index fc0c823..42489dd 100644
--- a/generic/regc_nfa.c
+++ b/generic/regc_nfa.c
@@ -824,7 +824,7 @@ duptraverse(
      * make all normal tests (not reg-33.14) pass.
      */
 #ifndef DUPTRAVERSE_MAX_DEPTH
-#define DUPTRAVERSE_MAX_DEPTH 700
+#define DUPTRAVERSE_MAX_DEPTH 15000
 #endif
 
     if (depth++ > DUPTRAVERSE_MAX_DEPTH) {
diff --git a/tests/reg.test b/tests/reg.test
index 559f549..e6ce42c 100644
--- a/tests/reg.test
+++ b/tests/reg.test
@@ -1155,6 +1155,9 @@ test reg-33.15 {Bug 3603557 - an "in the wild" RE} {
 	(.*)					# ConditionalFields
     }] 0
 } 68
+test reg-33.16 {Bug [8d2c0da36d]- another "in the wild" RE} {
+    lindex [regexp -about "^MRK:client1: =1339 14HKelly Talisman 10011000 (\[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]*) \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 8 0 8 0 0 0 77 77 1 1 2 0 11 { 1 3 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 13HC6 My Creator 2 3 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 31HC7 Slightly offensive name, huh 3 8 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 23HE-mail:kelly@hotbox.com 4 9 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 17Hcompface must die 5 10 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 0 3HAir 6 12 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 14HPGP public key 7 13 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 16Hkelly@hotbox.com 8 30 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 0 12H2 text/plain 9 30 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 0 13H2 x-kom/basic 10 33 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 1H0 11 14 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 1H3 }\r?"] 0
+} 1
 
 # cleanup
 ::tcltest::cleanupTests
-- 
cgit v0.12


From 6d9ae4aa1654e9872e141608b90a7c58ea4235cc Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Fri, 2 Aug 2013 14:58:58 +0000
Subject: [9d61624b3d]: Stop crashes when emptying the superclass slot.

---
 generic/tclOODefineCmds.c | 48 ++++++++++++++++++++++++++++-------------------
 tests/oo.test             | 17 +++++++++++++++++
 2 files changed, 46 insertions(+), 19 deletions(-)

diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index bacab38..1a5058c 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -2206,29 +2206,39 @@ ClassSuperSet(
 
     /*
      * Parse the arguments to get the class to use as superclasses.
+     *
+     * Note that zero classes is special, as it is equivalent to just the
+     * class of objects. [Bug 9d61624b3d]
      */
 
-    for (i=0 ; i<superc ; i++) {
-	superclasses[i] = GetClassInOuterContext(interp, superv[i],
-		"only a class can be a superclass");
-	if (superclasses[i] == NULL) {
-	    goto failedAfterAlloc;
-	}
-	for (j=0 ; j<i ; j++) {
-	    if (superclasses[j] == superclasses[i]) {
-		Tcl_SetObjResult(interp, Tcl_NewStringObj(
-			"class should only be a direct superclass once", -1));
-		Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS", NULL);
+    if (superc == 0) {
+	superclasses = ckrealloc(superclasses, sizeof(Class *));
+	superclasses[0] = oPtr->fPtr->objectCls;
+	superc = 1;
+    } else {
+	for (i=0 ; i<superc ; i++) {
+	    superclasses[i] = GetClassInOuterContext(interp, superv[i],
+		    "only a class can be a superclass");
+	    if (superclasses[i] == NULL) {
 		goto failedAfterAlloc;
 	    }
-	}
-	if (TclOOIsReachable(oPtr->classPtr, superclasses[i])) {
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		    "attempt to form circular dependency graph", -1));
-	    Tcl_SetErrorCode(interp, "TCL", "OO", "CIRCULARITY", NULL);
-	failedAfterAlloc:
-	    ckfree((char *) superclasses);
-	    return TCL_ERROR;
+	    for (j=0 ; j<i ; j++) {
+		if (superclasses[j] == superclasses[i]) {
+		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			    "class should only be a direct superclass once",
+			    -1));
+		    Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS",NULL);
+		    goto failedAfterAlloc;
+		}
+	    }
+	    if (TclOOIsReachable(oPtr->classPtr, superclasses[i])) {
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"attempt to form circular dependency graph", -1));
+		Tcl_SetErrorCode(interp, "TCL", "OO", "CIRCULARITY", NULL);
+	    failedAfterAlloc:
+		ckfree((char *) superclasses);
+		return TCL_ERROR;
+	    }
 	}
     }
 
diff --git a/tests/oo.test b/tests/oo.test
index 49fe150..6f16a8d 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -3374,6 +3374,23 @@ test oo-34.8 {TIP 380: slots - presence} {
 test oo-34.9 {TIP 380: slots - presence} {
     getMethods oo::objdefine::variable
 } {{-append -clear -set} {Get Set}}
+
+test oo-35.1 {Bug 9d61624b3d: Empty superclass must not cause crash} -setup {
+    oo::class create fruit {
+	method eat {} {}
+    }
+    set result {}
+} -body {
+    lappend result [fruit create ::apple] [info class superclasses fruit]
+    oo::define fruit superclass
+    lappend result [info class superclasses fruit] \
+	[info object class apple oo::object] \
+	[info class call fruit destroy] \
+	[catch { apple }]
+} -cleanup {
+    unset -nocomplain result
+    fruit destroy
+} -result {::apple ::oo::object ::oo::object 1 {{method destroy ::oo::object {core method: "destroy"}}} 1}
 
 cleanupTests
 return
-- 
cgit v0.12


From 0958b92b37ecfab151eeda74295706cdb6351e77 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Fri, 2 Aug 2013 20:19:44 +0000
Subject: Deal with the elaborate rip-apart-a-metaclass case as well.

---
 ChangeLog                 | 11 ++++++++---
 generic/tclOODefineCmds.c |  3 +++
 tests/oo.test             | 19 +++++++++++++++++++
 3 files changed, 30 insertions(+), 3 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index b794da5..a82dbfd 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,8 +1,13 @@
+2013-08-02  Donal Fellows  <dkf@users.sf.net>
+
+	* generic/tclOODefineCmds.c (ClassSuperSet): Bug [9d61624b3d]: Stop
+	crashes when emptying the superclass slot, even when doing elaborate
+	things with metaclasses.
+
 2013-08-01  Harald Oehlmann  <oehhar@users.sf.net>
 
-	* tclUnixNotify.c Tcl_InitNotifier: Bug [a0bc856dcd]
-	  Start notifier thread again if we were forked, to solve Rivet bug
-	  55153.
+	* tclUnixNotify.c (Tcl_InitNotifier): Bug [a0bc856dcd]: Start notifier
+	thread again if we were forked, to solve Rivet bug 55153.
 
 2013-07-05  Kevin B. Kenny  <kennykb@acm.org>
 
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index 1a5058c..f0983cc 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -2215,6 +2215,9 @@ ClassSuperSet(
 	superclasses = ckrealloc(superclasses, sizeof(Class *));
 	superclasses[0] = oPtr->fPtr->objectCls;
 	superc = 1;
+	if (TclOOIsReachable(oPtr->fPtr->classCls, oPtr->classPtr)) {
+	    superclasses[0] = oPtr->fPtr->classCls;
+	}
     } else {
 	for (i=0 ; i<superc ; i++) {
 	    superclasses[i] = GetClassInOuterContext(interp, superv[i],
diff --git a/tests/oo.test b/tests/oo.test
index 6f16a8d..6d38f71 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -3391,6 +3391,25 @@ test oo-35.1 {Bug 9d61624b3d: Empty superclass must not cause crash} -setup {
     unset -nocomplain result
     fruit destroy
 } -result {::apple ::oo::object ::oo::object 1 {{method destroy ::oo::object {core method: "destroy"}}} 1}
+test oo-35.2 {Bug 9d61624b3d: Empty superclass must not cause crash} -setup {
+    oo::class create fruitMetaclass {
+	superclass oo::class
+	method eat {} {}
+    }
+    set result {}
+} -body {
+    lappend result [fruitMetaclass create ::appleClass] \
+	[appleClass create orange] \
+	[info class superclasses fruitMetaclass]
+    oo::define fruitMetaclass superclass
+    lappend result [info class superclasses fruitMetaclass] \
+	[info object class appleClass oo::class] \
+	[catch { orange }] [info object class orange] \
+	[appleClass create pear]
+} -cleanup {
+    unset -nocomplain result
+    fruitMetaclass destroy
+} -result {::appleClass ::orange ::oo::class ::oo::class 1 1 ::appleClass ::pear}
 
 cleanupTests
 return
-- 
cgit v0.12


From 861b34625cd9a137d81f848b63c70e1f8318ba35 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sat, 3 Aug 2013 15:27:40 +0000
Subject: [3611643fff]: Support TclOO in autoload mechanism.

---
 ChangeLog        |  5 +++++
 library/auto.tcl | 14 ++++++++++++++
 2 files changed, 19 insertions(+)

diff --git a/ChangeLog b/ChangeLog
index a82dbfd..ddde893 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2013-08-03  Donal Fellows  <dkf@users.sf.net>
+
+	* library/auto.tcl: [Patch 3611643]: Allow TclOO classes to be found
+	by the autoloading mechanism.
+
 2013-08-02  Donal Fellows  <dkf@users.sf.net>
 
 	* generic/tclOODefineCmds.c (ClassSuperSet): Bug [9d61624b3d]: Stop
diff --git a/library/auto.tcl b/library/auto.tcl
index 0848bb1..78c219e 100644
--- a/library/auto.tcl
+++ b/library/auto.tcl
@@ -617,4 +617,18 @@ auto_mkindex_parser::command namespace {op args} {
     }
 }
 
+# AUTO MKINDEX:  oo::class create name ?definition?
+# Adds an entry to the auto index list for the given class name.
+foreach cmd {oo::class class} {
+    auto_mkindex_parser::command $cmd {ecmd name {body ""}} {
+	if {$cmd eq "create"} {
+	    variable index
+	    variable scriptFile
+	    append index [format "set %s \[list source \[%s]]\n" \
+			      [list auto_index([fullname $name])] \
+			      [list file join $dir {*}[file split $scriptFile]]]
+	}
+    }
+}
+
 return
-- 
cgit v0.12


From c74640849ef38c01a98a0a1338f72bbb56668d5e Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 5 Aug 2013 21:58:21 +0000
Subject: Mark unixforkevent-1.1 nonPortable, until proven on more platforms.

---
 tests/unixForkEvent.test | 2 +-
 unix/tclUnixTest.c       | 4 ++--
 2 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/tests/unixForkEvent.test b/tests/unixForkEvent.test
index cbe582e..120f362 100644
--- a/tests/unixForkEvent.test
+++ b/tests/unixForkEvent.test
@@ -16,7 +16,7 @@ testConstraint testfork [llength [info commands testfork]]
 # Test if the notifier thread is well initialized in a forked interpreter
 # by Tcl_InitNotifier
 test unixforkevent-1.1 {fork and test writeable event} \
-    -constraints testfork \
+    -constraints {testfork nonPortable} \
     -body {
 	set myFolder [makeDirectory unixtestfork]
 	set pid [testfork]
diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c
index 2fc1647..d2b729d 100644
--- a/unix/tclUnixTest.c
+++ b/unix/tclUnixTest.c
@@ -574,8 +574,8 @@ TestforkObjCmd(
                 "Cannot fork", NULL);
         return TCL_ERROR;
     }
-#ifndef HAVE_PTHREAD_ATFORK
-    /* Only needed when pthread_atfork is not present. */
+#if !defined(HAVE_PTHREAD_ATFORK) || defined(MAC_OSX_TCL)
+    /* Only needed when pthread_atfork is not present or on OSX. */
     if (pid==0) {
 	Tcl_InitNotifier();
     }
-- 
cgit v0.12


From 0ee8df700b2b0e041c30126e5e5bd4e7c3b75e18 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 6 Aug 2013 04:15:16 +0000
Subject: The value TCL_LOCATION_EVAL_LIST in the type field of a CmdFrame
 appears to exist only for the sake of taking great pains to make sure that
 pure list values remain pure list values.

The value of pure list values is no longer what it once was.  For a long long
time now, any canonical list values have been equally good.  This branch
is Work In Progress eliminating the complication of the additional type value.

Currently some minor botches are breaking execution tracing tests.
---
 generic/tclBasic.c   | 67 ++++++++++++++++++----------------------------------
 generic/tclCmdIL.c   | 25 ++++----------------
 generic/tclCompile.c |  2 +-
 generic/tclInt.h     | 41 +++++++++++++++-----------------
 4 files changed, 48 insertions(+), 87 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 82affb0..280835c 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -128,7 +128,7 @@ static Tcl_ObjCmdProc	ExprSrandFunc;
 static Tcl_ObjCmdProc	ExprUnaryFunc;
 static Tcl_ObjCmdProc	ExprWideFunc;
 static Tcl_Obj *	GetCommandSource(Interp *iPtr, int objc,
-			    Tcl_Obj *const objv[], int lookup);
+			    Tcl_Obj *const objv[]);
 static void		MathFuncWrongNumArgs(Tcl_Interp *interp, int expected,
 			    int actual, Tcl_Obj *const *objv);
 static Tcl_NRPostProc	NRCoroutineCallerCallback;
@@ -3358,15 +3358,6 @@ CancelEvalProc(
  *	This function returns a Tcl_Obj with the full source string for the
  *	command. This insures that traces get a correct NUL-terminated command
  *	string. The Tcl_Obj has refCount==1.
- *
- *	*** MAINTAINER WARNING ***
- *	The returned Tcl_Obj is all wrong for any purpose but getting the
- *	source string for an objc/objv command line in the stringRep (no
- *	stringRep if no source is available) and the corresponding substituted
- *	version in the List intrep.
- *	This means that the intRep and stringRep DO NOT COINCIDE! Using these
- *	Tcl_Objs normally is likely to break things.
- *
  *----------------------------------------------------------------------
  */
 
@@ -3374,37 +3365,27 @@ static Tcl_Obj *
 GetCommandSource(
     Interp *iPtr,
     int objc,
-    Tcl_Obj *const objv[],
-    int lookup)
+    Tcl_Obj *const objv[])
 {
-    Tcl_Obj *objPtr, *obj2Ptr;
+    Tcl_Obj *objPtr = NULL;
     CmdFrame *cfPtr = iPtr->cmdFramePtr;
-    const char *command = NULL;
-    int numChars;
 
-    objPtr = Tcl_NewListObj(objc, objv);
-    if (lookup && cfPtr && (cfPtr->numLevels == iPtr->numLevels-1)) {
+    if (cfPtr && (cfPtr->numLevels == iPtr->numLevels-1)) {
 	switch (cfPtr->type) {
 	case TCL_LOCATION_EVAL:
 	case TCL_LOCATION_SOURCE:
-	    command = cfPtr->cmd.str.cmd;
-	    numChars = cfPtr->cmd.str.len;
+	    objPtr = Tcl_NewStringObj(cfPtr->cmd.str.cmd, cfPtr->cmd.str.len);
 	    break;
 	case TCL_LOCATION_BC:
-	case TCL_LOCATION_PREBC:
-	    command = TclGetSrcInfoForCmd(iPtr, &numChars);
-	    break;
-	case TCL_LOCATION_EVAL_LIST:
-	    /* Got it already */
+	case TCL_LOCATION_PREBC: {
+	    int numChars;
+	    objPtr = Tcl_NewStringObj(TclGetSrcInfoForCmd(iPtr, &numChars),
+		    numChars);
 	    break;
 	}
-	if (command) {
-	    obj2Ptr = Tcl_NewStringObj(command, numChars);
-	    objPtr->bytes = obj2Ptr->bytes;
-	    objPtr->length = numChars;
-	    obj2Ptr->bytes = NULL;
-	    Tcl_DecrRefCount(obj2Ptr);
 	}
+    } else {
+	objPtr = Tcl_NewListObj(objc, objv);
     }
     Tcl_IncrRefCount(objPtr);
     return objPtr;
@@ -4692,7 +4673,7 @@ TEOV_RunEnterTraces(
     int length;
     Tcl_Obj *commandPtr;
 
-    commandPtr = GetCommandSource(iPtr, objc, objv, 1);
+    commandPtr = GetCommandSource(iPtr, objc, objv);
     command = Tcl_GetStringFromObj(commandPtr, &length);
 
     /*
@@ -4731,7 +4712,7 @@ TEOV_RunEnterTraces(
 	 */
 
 	TclNRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(traceCode),
-		commandPtr, cmdPtr, NULL);
+		commandPtr, cmdPtr, Tcl_NewListObj(objc, objv));
 	cmdPtr->refCount++;
     } else {
 	Tcl_DecrRefCount(commandPtr);
@@ -4752,10 +4733,11 @@ TEOV_RunLeaveTraces(
     int traceCode = PTR2INT(data[0]);
     Tcl_Obj *commandPtr = data[1];
     Command *cmdPtr = data[2];
+    Tcl_Obj *wordsPtr = data[3];
 
     command = Tcl_GetStringFromObj(commandPtr, &length);
-    if (TCL_OK != Tcl_ListObjGetElements(interp, commandPtr, &objc, &objv)) {
-	Tcl_Panic("Who messed with commandPtr?");
+    if (TCL_OK != Tcl_ListObjGetElements(interp, wordsPtr, &objc, &objv)) {
+	Tcl_Panic("What happened with wordsPtr?!");
     }
 
     if (!(cmdPtr->flags & CMD_IS_DELETED)) {
@@ -4769,6 +4751,7 @@ TEOV_RunLeaveTraces(
 	}
     }
     Tcl_DecrRefCount(commandPtr);
+    Tcl_DecrRefCount(wordsPtr);
 
     /*
      * As cmdPtr is set, TclNRRunCallbacks is about to reduce the numlevels.
@@ -5974,13 +5957,12 @@ TclNREvalObjEx(
      */
 
     if (TclListObjIsCanonical(objPtr)) {
-	Tcl_Obj *listPtr = objPtr;
 	CmdFrame *eoFramePtr = NULL;
 	int objc;
-	Tcl_Obj **objv;
+	Tcl_Obj *listPtr, **objv;
 
 	/*
-	 * Pure List Optimization (no string representation). In this case, we
+	 * Canonical List Optimization:  In this case, we
 	 * can safely use Tcl_EvalObjv instead and get an appreciable
 	 * improvement in execution speed. This is because it allows us to
 	 * avoid a setFromAny step that would just pack everything into a
@@ -5988,11 +5970,6 @@ TclNREvalObjEx(
 	 *
 	 * This also preserves any associations between list elements and
 	 * location information for such elements.
-	 *
-	 * This restriction has been relaxed a bit by storing in lists whether
-	 * they are "canonical" or not (a canonical list being one that is
-	 * either pure or that has its string rep derived by
-	 * UpdateStringOfList from the internal rep).
 	 */
 
 	/*
@@ -6001,6 +5978,7 @@ TclNREvalObjEx(
 	 * we always make a copy. The callback takes care od the refCounts for
 	 * both listPtr and objPtr.
 	 *
+	 * TODO: Create a test to demo this need, or eliminate it.
 	 * FIXME OPT: preserve just the internal rep?
 	 */
 
@@ -6030,14 +6008,15 @@ TclNREvalObjEx(
 	    eoFramePtr->nline = 0;
 	    eoFramePtr->line = NULL;
 
-	    eoFramePtr->type = TCL_LOCATION_EVAL_LIST;
+	    eoFramePtr->type = TCL_LOCATION_EVAL;
 	    eoFramePtr->level = (iPtr->cmdFramePtr == NULL?
 		    1 : iPtr->cmdFramePtr->level + 1);
 	    eoFramePtr->numLevels = iPtr->numLevels;
 	    eoFramePtr->framePtr = iPtr->framePtr;
 	    eoFramePtr->nextPtr = iPtr->cmdFramePtr;
 
-	    eoFramePtr->cmd.listPtr = listPtr;
+	    eoFramePtr->cmd.str.cmd = Tcl_GetStringFromObj(listPtr,
+		    &(eoFramePtr->cmd.str.len));
 	    eoFramePtr->data.eval.path = NULL;
 
 	    iPtr->cmdFramePtr = eoFramePtr;
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 0e33392..4046903 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -1302,30 +1302,15 @@ TclInfoFrame(
 	 */
 
 	ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
-	ADD_PAIR("line", Tcl_NewIntObj(framePtr->line[0]));
+	if (framePtr->line) {
+	    ADD_PAIR("line", Tcl_NewIntObj(framePtr->line[0]));
+	} else {
+	    ADD_PAIR("line", Tcl_NewIntObj(1));
+	}
 	ADD_PAIR("cmd", 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.
-	 */
-
-	ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
-	ADD_PAIR("line", Tcl_NewIntObj(1));
-
-	/*
-	 * 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.
-	 */
-
-	ADD_PAIR("cmd", Tcl_DuplicateObj(framePtr->cmd.listPtr));
-	break;
-
     case TCL_LOCATION_PREBC:
 	/*
 	 * Precompiled. Result contains the type as signal, nothing else.
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 772ce22..618b6fa 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1375,7 +1375,7 @@ TclInitCompileEnv(
     envPtr->extCmdMapPtr->nuloc = 0;
     envPtr->extCmdMapPtr->path = NULL;
 
-    if ((invoker == NULL) || (invoker->type == TCL_LOCATION_EVAL_LIST)) {
+    if (invoker == NULL) {
 	/*
 	 * Initialize the compiler for relative counting in case of a
 	 * dynamic context.
diff --git a/generic/tclInt.h b/generic/tclInt.h
index da09366..1df09b3 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -1175,29 +1175,27 @@ typedef struct CmdFrame {
      *
      * 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
-     * =======	  ====		  ======	  =========
+     * Field	  TEBC		  EvalEx
+     * =======	  ====		  ======
+     * level	  yes		  yes	
+     * type	  BC/PREBC	  SRC/EVAL
+     * line0	  yes		  yes	
+     * framePtr	  yes		  yes	
+     * =======	  ====		  ======
      *
-     * =======	  ====		  ======	  ========= union data
-     * line1	  -		  yes		  -
-     * line3	  -		  yes		  -
-     * path	  -		  yes		  -
-     * -------	  ----		  ------	  ---------
-     * codePtr	  yes		  -		  -
-     * pc	  yes		  -		  -
-     * =======	  ====		  ======	  =========
+     * =======	  ====		  ========= union data
+     * line1	  -		  yes	
+     * line3	  -		  yes	
+     * path	  -		  yes	
+     * -------	  ----		  ------
+     * codePtr	  yes		  -	
+     * pc	  yes		  -	
+     * =======	  ====		  ======
      *
-     * =======	  ====		  ======	  ========= | union cmd
-     * listPtr	  -		  -		  yes	    |
-     * -------	  ----		  ------	  --------- |
-     * cmd	  yes		  yes		  -	    |
-     * cmdlen	  yes		  yes		  -	    |
-     * -------	  ----		  ------	  --------- |
+     * =======	  ====		  ========= union cmd
+     * str.cmd	  yes		  yes	
+     * str.len	  yes		  yes	
+     * -------	  ----		  ------	
      */
 
     union {
@@ -1215,7 +1213,6 @@ typedef struct CmdFrame {
 	    const char *cmd;	/* The executed command, if possible... */
 	    int len;		/* ... and its length. */
 	} str;
-	Tcl_Obj *listPtr;	/* Tcl_EvalObjEx, cmd list. */
     } cmd;
     int numLevels;		/* Value of interp's numLevels when the frame
 				 * was pushed. */
-- 
cgit v0.12


From 23d61a10c23d99df7ef3289f5cf35159e95426d9 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 6 Aug 2013 13:08:54 +0000
Subject: Revert the changes that went too far and broke things.

---
 generic/tclBasic.c | 39 ++++++++++++++++++++++++++-------------
 1 file changed, 26 insertions(+), 13 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 280835c..ea08f88 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -3358,6 +3358,15 @@ CancelEvalProc(
  *	This function returns a Tcl_Obj with the full source string for the
  *	command. This insures that traces get a correct NUL-terminated command
  *	string. The Tcl_Obj has refCount==1.
+ *
+ *	*** MAINTAINER WARNING ***
+ *	The returned Tcl_Obj is all wrong for any purpose but getting the
+ *	source string for an objc/objv command line in the stringRep (no
+ *	stringRep if no source is available) and the corresponding substituted
+ *	version in the List intrep.
+ *	This means that the intRep and stringRep DO NOT COINCIDE! Using these
+ *	Tcl_Objs normally is likely to break things.
+ *
  *----------------------------------------------------------------------
  */
 
@@ -3367,25 +3376,31 @@ GetCommandSource(
     int objc,
     Tcl_Obj *const objv[])
 {
-    Tcl_Obj *objPtr = NULL;
+    Tcl_Obj *objPtr, *obj2Ptr;
     CmdFrame *cfPtr = iPtr->cmdFramePtr;
+    const char *command = NULL;
+    int numChars;
 
+    objPtr = Tcl_NewListObj(objc, objv);
     if (cfPtr && (cfPtr->numLevels == iPtr->numLevels-1)) {
 	switch (cfPtr->type) {
 	case TCL_LOCATION_EVAL:
 	case TCL_LOCATION_SOURCE:
-	    objPtr = Tcl_NewStringObj(cfPtr->cmd.str.cmd, cfPtr->cmd.str.len);
+	    command = cfPtr->cmd.str.cmd;
+	    numChars = cfPtr->cmd.str.len;
 	    break;
 	case TCL_LOCATION_BC:
-	case TCL_LOCATION_PREBC: {
-	    int numChars;
-	    objPtr = Tcl_NewStringObj(TclGetSrcInfoForCmd(iPtr, &numChars),
-		    numChars);
+	case TCL_LOCATION_PREBC:
+	    command = TclGetSrcInfoForCmd(iPtr, &numChars);
 	    break;
 	}
+	if (command) {
+	    obj2Ptr = Tcl_NewStringObj(command, numChars);
+	    objPtr->bytes = obj2Ptr->bytes;
+	    objPtr->length = numChars;
+	    obj2Ptr->bytes = NULL;
+	    Tcl_DecrRefCount(obj2Ptr);
 	}
-    } else {
-	objPtr = Tcl_NewListObj(objc, objv);
     }
     Tcl_IncrRefCount(objPtr);
     return objPtr;
@@ -4712,7 +4727,7 @@ TEOV_RunEnterTraces(
 	 */
 
 	TclNRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(traceCode),
-		commandPtr, cmdPtr, Tcl_NewListObj(objc, objv));
+		commandPtr, cmdPtr, NULL);
 	cmdPtr->refCount++;
     } else {
 	Tcl_DecrRefCount(commandPtr);
@@ -4733,11 +4748,10 @@ TEOV_RunLeaveTraces(
     int traceCode = PTR2INT(data[0]);
     Tcl_Obj *commandPtr = data[1];
     Command *cmdPtr = data[2];
-    Tcl_Obj *wordsPtr = data[3];
 
     command = Tcl_GetStringFromObj(commandPtr, &length);
-    if (TCL_OK != Tcl_ListObjGetElements(interp, wordsPtr, &objc, &objv)) {
-	Tcl_Panic("What happened with wordsPtr?!");
+    if (TCL_OK != Tcl_ListObjGetElements(interp, commandPtr, &objc, &objv)) {
+	Tcl_Panic("Who messed with commandPtr?");
     }
 
     if (!(cmdPtr->flags & CMD_IS_DELETED)) {
@@ -4751,7 +4765,6 @@ TEOV_RunLeaveTraces(
 	}
     }
     Tcl_DecrRefCount(commandPtr);
-    Tcl_DecrRefCount(wordsPtr);
 
     /*
      * As cmdPtr is set, TclNRRunCallbacks is about to reduce the numlevels.
-- 
cgit v0.12


From 8bd533d76ea3530028e7bc3c32ec981f3c78c683 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 6 Aug 2013 13:20:36 +0000
Subject: Eliminate the union that is no longer needed.

---
 generic/tclBasic.c    | 13 ++++++-------
 generic/tclCmdIL.c    |  9 +++------
 generic/tclExecute.c  | 14 +++++++-------
 generic/tclInt.h      |  8 ++------
 generic/tclOOMethod.c |  8 ++++----
 generic/tclProc.c     |  8 ++++----
 6 files changed, 26 insertions(+), 34 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index ea08f88..baa2f2c 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -3386,8 +3386,8 @@ GetCommandSource(
 	switch (cfPtr->type) {
 	case TCL_LOCATION_EVAL:
 	case TCL_LOCATION_SOURCE:
-	    command = cfPtr->cmd.str.cmd;
-	    numChars = cfPtr->cmd.str.len;
+	    command = cfPtr->cmd;
+	    numChars = cfPtr->len;
 	    break;
 	case TCL_LOCATION_BC:
 	case TCL_LOCATION_PREBC:
@@ -5246,12 +5246,12 @@ TclEvalEx(
 	     * have been executed.
 	     */
 
-	    eeFramePtr->cmd.str.cmd = parsePtr->commandStart;
-	    eeFramePtr->cmd.str.len = parsePtr->commandSize;
+	    eeFramePtr->cmd = parsePtr->commandStart;
+	    eeFramePtr->len = parsePtr->commandSize;
 
 	    if (parsePtr->term ==
 		    parsePtr->commandStart + parsePtr->commandSize - 1) {
-		eeFramePtr->cmd.str.len--;
+		eeFramePtr->len--;
 	    }
 
 	    eeFramePtr->nline = objectsUsed;
@@ -6028,8 +6028,7 @@ TclNREvalObjEx(
 	    eoFramePtr->framePtr = iPtr->framePtr;
 	    eoFramePtr->nextPtr = iPtr->cmdFramePtr;
 
-	    eoFramePtr->cmd.str.cmd = Tcl_GetStringFromObj(listPtr,
-		    &(eoFramePtr->cmd.str.len));
+	    eoFramePtr->cmd = Tcl_GetStringFromObj(listPtr, &(eoFramePtr->len));
 	    eoFramePtr->data.eval.path = NULL;
 
 	    iPtr->cmdFramePtr = eoFramePtr;
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 4046903..180d814 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -1307,8 +1307,7 @@ TclInfoFrame(
 	} else {
 	    ADD_PAIR("line", Tcl_NewIntObj(1));
 	}
-	ADD_PAIR("cmd", Tcl_NewStringObj(framePtr->cmd.str.cmd,
-		framePtr->cmd.str.len));
+	ADD_PAIR("cmd", Tcl_NewStringObj(framePtr->cmd, framePtr->len));
 	break;
 
     case TCL_LOCATION_PREBC:
@@ -1356,8 +1355,7 @@ TclInfoFrame(
 	    Tcl_DecrRefCount(fPtr->data.eval.path);
 	}
 
-	ADD_PAIR("cmd",
-		Tcl_NewStringObj(fPtr->cmd.str.cmd, fPtr->cmd.str.len));
+	ADD_PAIR("cmd", Tcl_NewStringObj(fPtr->cmd, fPtr->len));
 	TclStackFree(interp, fPtr);
 	break;
     }
@@ -1376,8 +1374,7 @@ TclInfoFrame(
 	 * the result list object.
 	 */
 
-	ADD_PAIR("cmd", Tcl_NewStringObj(framePtr->cmd.str.cmd,
-		framePtr->cmd.str.len));
+	ADD_PAIR("cmd", Tcl_NewStringObj(framePtr->cmd, framePtr->len));
 	break;
 
     case TCL_LOCATION_PROC:
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index f8ed667..11e9920 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -2006,8 +2006,8 @@ TclNRExecuteByteCode(
     bcFramePtr->litarg = NULL;
     bcFramePtr->data.tebc.codePtr = codePtr;
     bcFramePtr->data.tebc.pc = NULL;
-    bcFramePtr->cmd.str.cmd = NULL;
-    bcFramePtr->cmd.str.len = 0;
+    bcFramePtr->cmd = NULL;
+    bcFramePtr->len = 0;
 
 #ifdef TCL_COMPILE_STATS
     iPtr->stats.numExecutions++;
@@ -8774,13 +8774,13 @@ TclGetSrcInfoForPc(
 {
     ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr;
 
-    if (cfPtr->cmd.str.cmd == NULL) {
-	cfPtr->cmd.str.cmd = GetSrcInfoForPc(
+    if (cfPtr->cmd == NULL) {
+	cfPtr->cmd = GetSrcInfoForPc(
 		(unsigned char *) cfPtr->data.tebc.pc, codePtr,
-		&cfPtr->cmd.str.len, NULL, NULL);
+		&cfPtr->len, NULL, NULL);
     }
 
-    if (cfPtr->cmd.str.cmd != NULL) {
+    if (cfPtr->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.
@@ -8797,7 +8797,7 @@ TclGetSrcInfoForPc(
 	    return;
 	}
 
-	srcOffset = cfPtr->cmd.str.cmd - codePtr->source;
+	srcOffset = cfPtr->cmd - codePtr->source;
 	eclPtr = Tcl_GetHashValue(hePtr);
 
 	for (i=0; i < eclPtr->nuloc; i++) {
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 1df09b3..d398591 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -1208,12 +1208,8 @@ typedef struct CmdFrame {
 	    const char *pc;	/* ... and instruction pointer. */
 	} tebc;
     } data;
-    union {
-	struct {
-	    const char *cmd;	/* The executed command, if possible... */
-	    int len;		/* ... and its length. */
-	} str;
-    } cmd;
+    const char *cmd;		/* The executed command, if possible... */
+    int len;			/* ... and its length. */
     int numLevels;		/* Value of interp's numLevels when the frame
 				 * was pushed. */
     const struct CFWordBC *litarg;
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index 98b4078..b91fdfd 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -513,8 +513,8 @@ TclOOMakeProcInstanceMethod(
 		cfPtr->data.eval.path = context.data.eval.path;
 		Tcl_IncrRefCount(cfPtr->data.eval.path);
 
-		cfPtr->cmd.str.cmd = NULL;
-		cfPtr->cmd.str.len = 0;
+		cfPtr->cmd = NULL;
+		cfPtr->len = 0;
 
 		hPtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr,
 			(char *) procPtr, &isNew);
@@ -626,8 +626,8 @@ TclOOMakeProcMethod(
 		cfPtr->data.eval.path = context.data.eval.path;
 		Tcl_IncrRefCount(cfPtr->data.eval.path);
 
-		cfPtr->cmd.str.cmd = NULL;
-		cfPtr->cmd.str.len = 0;
+		cfPtr->cmd = NULL;
+		cfPtr->len = 0;
 
 		hPtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr,
 			(char *) procPtr, &isNew);
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 18985a1..1314719 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -271,8 +271,8 @@ Tcl_ProcObjCmd(
 		cfPtr->data.eval.path = contextPtr->data.eval.path;
 		Tcl_IncrRefCount(cfPtr->data.eval.path);
 
-		cfPtr->cmd.str.cmd = NULL;
-		cfPtr->cmd.str.len = 0;
+		cfPtr->cmd = NULL;
+		cfPtr->len = 0;
 
 		hePtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr,
 			procPtr, &isNew);
@@ -2595,8 +2595,8 @@ SetLambdaFromAny(
 		cfPtr->data.eval.path = contextPtr->data.eval.path;
 		Tcl_IncrRefCount(cfPtr->data.eval.path);
 
-		cfPtr->cmd.str.cmd = NULL;
-		cfPtr->cmd.str.len = 0;
+		cfPtr->cmd = NULL;
+		cfPtr->len = 0;
 	    }
 
 	    /*
-- 
cgit v0.12


From 1d99884b0866f09d7b19d0546818d426642d9494 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 6 Aug 2013 13:30:36 +0000
Subject: Drop TCL_LOCATION_EVAL_LIST now that it is unused.

---
 generic/tclInt.h | 4 ----
 1 file changed, 4 deletions(-)

diff --git a/generic/tclInt.h b/generic/tclInt.h
index d398591..cd4ab7d 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -1275,8 +1275,6 @@ typedef struct ContLineLoc {
  * 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
@@ -1288,8 +1286,6 @@ typedef struct ContLineLoc {
  */
 
 #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. */
-- 
cgit v0.12


From a63563bd9a3985cd767a1869e44b18cdeae793fd Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 6 Aug 2013 16:20:59 +0000
Subject: Add assertions that will guide and protect more discovery of dead
 code for elimination.

---
 generic/tclBasic.c   | 2 ++
 generic/tclExecute.c | 8 +++++---
 2 files changed, 7 insertions(+), 3 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index baa2f2c..1889dfd 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -6109,6 +6109,8 @@ TclNREvalObjEx(
 	ContLineLoc *saveCLLocPtr = iPtr->scriptCLLocPtr;
 	ContLineLoc *clLocPtr = TclContinuationsGet(objPtr);
 
+	assert(invoker == NULL);
+
 	if (clLocPtr) {
 	    iPtr->scriptCLLocPtr = clLocPtr;
 	    Tcl_Preserve(iPtr->scriptCLLocPtr);
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 11e9920..f6072a1 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -8774,13 +8774,15 @@ TclGetSrcInfoForPc(
 {
     ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr;
 
-    if (cfPtr->cmd == NULL) {
+    assert(cfPtr->type == TCL_LOCATION_BC);
+    assert(cfPtr->cmd == NULL);
+
 	cfPtr->cmd = GetSrcInfoForPc(
 		(unsigned char *) cfPtr->data.tebc.pc, codePtr,
 		&cfPtr->len, NULL, NULL);
-    }
 
-    if (cfPtr->cmd != NULL) {
+    assert(cfPtr->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.
-- 
cgit v0.12


From 59f7320bdd532d9323ad4f80e78ffbac5514e8da Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 6 Aug 2013 17:24:40 +0000
Subject: All use of the evalFlag value TCL_EVAL_CTX is unused by the code and
 unreachable by extensions.  This checkin removes all the code supporting that
 flag value.

The consequence is that all the calls to TclNREvalObjEx() and its callers
that are currently choosing not to pass the TCL_EVAL_DIRECT flag in when
they pass in a non-NULL invoker will no longer be free to change their
mind.  That might be reason not to adopt this change.
---
 generic/tclBasic.c | 98 ++++++------------------------------------------------
 generic/tclInt.h   |  1 -
 2 files changed, 11 insertions(+), 88 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 1889dfd..00ae24e 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -5011,12 +5011,11 @@ TclEvalEx(
     /*
      * TIP #280 Initialize tracking. Do not push on the frame stack yet.
      *
-     * We may continue 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.
+     * We 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.
      */
 
     eeFramePtr->level = iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level + 1 : 1;
@@ -5027,15 +5026,7 @@ TclEvalEx(
     eeFramePtr->line = NULL;
 
     iPtr->cmdFramePtr = eeFramePtr;
-    if (iPtr->evalFlags & TCL_EVAL_CTX) {
-	/*
-	 * Path information comes out of the context.
-	 */
-
-	eeFramePtr->type = TCL_LOCATION_SOURCE;
-	eeFramePtr->data.eval.path = iPtr->invokeCmdFramePtr->data.eval.path;
-	Tcl_IncrRefCount(eeFramePtr->data.eval.path);
-    } else if (iPtr->evalFlags & TCL_EVAL_FILE) {
+    if (iPtr->evalFlags & TCL_EVAL_FILE) {
 	/*
 	 * Set up for a sourced file.
 	 */
@@ -6076,14 +6067,6 @@ TclNREvalObjEx(
 	 * We're not supposed to use the compiler or byte-code
 	 * interpreter. Let Tcl_EvalEx evaluate the command directly (and
 	 * probably more slowly).
-	 *
-	 * 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.
 	 */
 
 	const char *script;
@@ -6104,6 +6087,8 @@ TclNREvalObjEx(
 	 * Another important action is to save (and later restore) the
 	 * continuation line information of the caller, in case we are
 	 * executing nested commands in the eval/direct path.
+	 *
+	 * TODO: Get test coverage in here.
 	 */
 
 	ContLineLoc *saveCLLocPtr = iPtr->scriptCLLocPtr;
@@ -6119,71 +6104,11 @@ TclNREvalObjEx(
 	}
 
 	Tcl_IncrRefCount(objPtr);
-	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.
-	     */
+	script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
+	result = Tcl_EvalEx(interp, script, numSrcBytes, flags);
 
-	    int pc = 0;
-	    CmdFrame *ctxPtr = TclStackAlloc(interp, sizeof(CmdFrame));
-
-	    *ctxPtr = *invoker;
-	    if (invoker->type == TCL_LOCATION_BC) {
-		/*
-		 * Note: Type BC => ctxPtr->data.eval.path is not used.
-		 * ctxPtr->data.tebc.codePtr is used instead.
-		 */
-
-		TclGetSrcInfoForPc(ctxPtr);
-		pc = 1;
-	    }
-
-	    script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
-
-	    if ((invoker->nline <= word) ||
-		    (invoker->line[word] < 0) ||
-		    (ctxPtr->type != TCL_LOCATION_SOURCE)) {
-		/*
-		 * Dynamic script, or dynamic context, force our own context.
-		 */
-
-		result = Tcl_EvalEx(interp, script, numSrcBytes, flags);
-	    } else {
-		/*
-		 * Absolute context to reuse.
-		 */
-
-		iPtr->invokeCmdFramePtr = ctxPtr;
-		iPtr->evalFlags |= TCL_EVAL_CTX;
-
-		result = TclEvalEx(interp, script, numSrcBytes, flags,
-			ctxPtr->line[word], NULL, script);
-	    }
-	    if (pc && (ctxPtr->type == TCL_LOCATION_SOURCE)) {
-		/*
-		 * Death of SrcInfo reference.
-		 */
-
-		Tcl_DecrRefCount(ctxPtr->data.eval.path);
-	    }
-	    TclStackFree(interp, ctxPtr);
-	}
+	TclDecrRefCount(objPtr);
 
 	/*
 	 * Now release the lock on the continuation line information, if any,
@@ -6194,7 +6119,6 @@ TclNREvalObjEx(
 	    Tcl_Release(iPtr->scriptCLLocPtr);
 	}
 	iPtr->scriptCLLocPtr = saveCLLocPtr;
-	TclDecrRefCount(objPtr);
 	return result;
     }
 }
diff --git a/generic/tclInt.h b/generic/tclInt.h
index cd4ab7d..99f1305 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2201,7 +2201,6 @@ typedef struct Interp {
 
 #define TCL_ALLOW_EXCEPTIONS	4
 #define TCL_EVAL_FILE		2
-#define TCL_EVAL_CTX		8
 
 /*
  * Flag bits for Interp structures:
-- 
cgit v0.12


From 5f2f5b63c39411d4273ab4968713004cb1d0d6c8 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 7 Aug 2013 12:44:42 +0000
Subject: Add comment stating new limitation on Tcl(NR)EvalObjEx() interface.

---
 generic/tclBasic.c | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 00ae24e..8ba3825 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -5893,6 +5893,11 @@ Tcl_GlobalEvalObj(
  *	compiled into bytecodes if necessary, unless TCL_EVAL_DIRECT is
  *	specified.
  *
+ *	If the flag TCL_EVAL_DIRECT is passed in, the value of invoker
+ *	must be NULL.  Support for non-NULL invokers in that mode has
+ *	been removed since it was unused and untested.  Failure to 
+ *	follow this limitation will lead to an assertion panic.
+ *
  * Results:
  *	The return value is one of the return codes defined in tcl.h (such as
  *	TCL_OK), and the interpreter's result contains a value to supplement
-- 
cgit v0.12


From 27c5ada57e78e8de829d5e5d7dd0070b9b5a5279 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 7 Aug 2013 14:41:46 +0000
Subject: Replace potentially memleak creating safety check of a "cannot
 happen" condition with an assertion.

---
 generic/tclParse.c | 14 ++++++--------
 1 file changed, 6 insertions(+), 8 deletions(-)

diff --git a/generic/tclParse.c b/generic/tclParse.c
index 6723d39..c5cb1d1 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -13,6 +13,7 @@
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
  
+#include <assert.h>
 #include "tclInt.h"
 #include "tclParse.h"
 
@@ -1578,16 +1579,13 @@ Tcl_ParseVar(
      * At this point we should have an object containing the value of a
      * variable. Just return the string from that object.
      *
-     * This should have returned the object for the user to manage, but
-     * instead we have some weak reference to the string value in the object,
-     * which is why we make sure the object exists after resetting the result.
-     * This isn't ideal, but it's the best we can do with the current
-     * documented interface. -- hobbs
+     * Since TclSubstTokens above returned TCL_OK, we know that objPtr
+     * is shared.  It is in both the interp result and the value of the
+     * variable.  Returning the string relies on that to be true.
      */
 
-    if (!Tcl_IsShared(objPtr)) {
-	Tcl_IncrRefCount(objPtr);
-    }
+    assert( Tcl_IsShared(objPtr) );
+
     Tcl_ResetResult(interp);
     return TclGetString(objPtr);
 }
-- 
cgit v0.12


From f6f0891fffa23a7577553a42c1f2d16fbcb8170a Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 7 Aug 2013 16:01:53 +0000
Subject: Test for TclContinuationsGet() usage, and simplifications.

---
 generic/tclBasic.c | 18 +-----------------
 tests/parse.test   |  6 ++++++
 2 files changed, 7 insertions(+), 17 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 8ba3825..7110025 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -6092,21 +6092,13 @@ TclNREvalObjEx(
 	 * Another important action is to save (and later restore) the
 	 * continuation line information of the caller, in case we are
 	 * executing nested commands in the eval/direct path.
-	 *
-	 * TODO: Get test coverage in here.
 	 */
 
 	ContLineLoc *saveCLLocPtr = iPtr->scriptCLLocPtr;
-	ContLineLoc *clLocPtr = TclContinuationsGet(objPtr);
 
 	assert(invoker == NULL);
 
-	if (clLocPtr) {
-	    iPtr->scriptCLLocPtr = clLocPtr;
-	    Tcl_Preserve(iPtr->scriptCLLocPtr);
-	} else {
-	    iPtr->scriptCLLocPtr = NULL;
-	}
+	iPtr->scriptCLLocPtr = TclContinuationsGet(objPtr);
 
 	Tcl_IncrRefCount(objPtr);
 
@@ -6115,14 +6107,6 @@ TclNREvalObjEx(
 
 	TclDecrRefCount(objPtr);
 
-	/*
-	 * Now release the lock on the continuation line information, if any,
-	 * and restore the caller's settings.
-	 */
-
-	if (iPtr->scriptCLLocPtr) {
-	    Tcl_Release(iPtr->scriptCLLocPtr);
-	}
 	iPtr->scriptCLLocPtr = saveCLLocPtr;
 	return result;
     }
diff --git a/tests/parse.test b/tests/parse.test
index 9f2d50b..01443c9 100644
--- a/tests/parse.test
+++ b/tests/parse.test
@@ -1118,6 +1118,12 @@ test parse-21.0 {Bug 1884496} testevent {
     testevent queue a head $::script
     vwait done
 } {}
+test parse-21.1 {TCL_EVAL_DIRECT coverage} testevent {
+    testevent queue a head {testevent delete a; \
+	set ::done [dict get [info frame 0] line]}
+    vwait done
+    set ::done
+} 2
 
 cleanupTests
 }
-- 
cgit v0.12


From 5f6b71f3f2fe180def995e4ff2beb35410b94303 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 7 Aug 2013 16:44:03 +0000
Subject: Remove Tcl_Preserve support for ContLineLoc values.  It's not needed.
 This allows the clLoc field of CompileEnv struct to go away too.

---
 generic/tclCompile.c | 19 ++-----------------
 generic/tclCompile.h |  4 ----
 generic/tclObj.c     | 38 +++-----------------------------------
 3 files changed, 5 insertions(+), 56 deletions(-)

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 618b6fa..f5c8d41 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -713,9 +713,7 @@ TclSetByteCodeFromAny(
 
     clLocPtr = TclContinuationsGet(objPtr);
     if (clLocPtr) {
-	compEnv.clLoc = clLocPtr;
-	compEnv.clNext = &compEnv.clLoc->loc[0];
-	Tcl_Preserve(compEnv.clLoc);
+	compEnv.clNext = &clLocPtr->loc[0];
     }
 
     TclCompileScript(interp, stringPtr, length, &compEnv);
@@ -742,9 +740,7 @@ TclSetByteCodeFromAny(
 	TclInitCompileEnv(interp, &compEnv, stringPtr, length,
 		iPtr->invokeCmdFramePtr, iPtr->invokeWord);
 	if (clLocPtr) {
-	    compEnv.clLoc = clLocPtr;
-	    compEnv.clNext = &compEnv.clLoc->loc[0];
-	    Tcl_Preserve(compEnv.clLoc);
+	    compEnv.clNext = &clLocPtr->loc[0];
 	}
 	compEnv.atCmdStart = 2;		/* The disabling magic. */
 	TclCompileScript(interp, stringPtr, length, &compEnv);
@@ -1489,7 +1485,6 @@ TclInitCompileEnv(
      * data is available.
      */
 
-    envPtr->clLoc = NULL;
     envPtr->clNext = NULL;
 
     envPtr->auxDataArrayPtr = envPtr->staticAuxDataArraySpace;
@@ -1574,16 +1569,6 @@ TclFreeCompileEnv(
 	ReleaseCmdWordData(envPtr->extCmdMapPtr);
 	envPtr->extCmdMapPtr = NULL;
     }
-
-    /*
-     * If we used data about invisible continuation lines, then now is the
-     * time to release on our hold on it. The lock was set in function
-     * TclSetByteCodeFromAny(), found in this file.
-     */
-
-    if (envPtr->clLoc) {
-	Tcl_Release(envPtr->clLoc);
-    }
 }
 
 /*
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index beb28fd..5660055 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -365,10 +365,6 @@ typedef struct CompileEnv {
 				 * encountered that have not yet been paired
 				 * with a corresponding
 				 * INST_INVOKE_EXPANDED. */
-    ContLineLoc *clLoc;		/* If not NULL, the table holding the
-				 * locations of the invisible continuation
-				 * lines in the input script, to adjust the
-				 * line counter. */
     int *clNext;		/* If not NULL, it refers to the next slot in
 				 * clLoc to check for an invisible
 				 * continuation line. */
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 542d6d1..930e1fd 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -97,7 +97,6 @@ typedef struct ThreadSpecificData {
 
 static Tcl_ThreadDataKey dataKey;
 
-static void             ContLineLocFree(char *clientData);
 static void             TclThreadFinalizeContLines(ClientData clientData);
 static ThreadSpecificData *TclGetContLineTable(void);
 
@@ -805,14 +804,7 @@ TclThreadFinalizeContLines(
 
     for (hPtr = Tcl_FirstHashEntry(tsdPtr->lineCLPtr, &hSearch);
 	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
-	/*
-	 * We are not using Tcl_EventuallyFree (as in TclFreeObj()) because
-	 * here we can be sure that the compiler will not hold references to
-	 * the data in the hashtable, and using TEF might bork the
-	 * finalization sequence.
-	 */
-
-	ContLineLocFree(Tcl_GetHashValue(hPtr));
+	ckfree(Tcl_GetHashValue(hPtr));
 	Tcl_DeleteHashEntry(hPtr);
     }
     Tcl_DeleteHashTable(tsdPtr->lineCLPtr);
@@ -821,30 +813,6 @@ TclThreadFinalizeContLines(
 }
 
 /*
- *----------------------------------------------------------------------
- *
- * ContLineLocFree --
- *
- *	The freProc for continuation line location tables.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Releases memory.
- *
- * TIP #280
- *----------------------------------------------------------------------
- */
-
-static void
-ContLineLocFree(
-    char *clientData)
-{
-    ckfree(clientData);
-}
-
-/*
  *--------------------------------------------------------------
  *
  * Tcl_RegisterObjType --
@@ -1405,7 +1373,7 @@ TclFreeObj(
 	if (tsdPtr->lineCLPtr) {
             hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
 	    if (hPtr) {
-		Tcl_EventuallyFree(Tcl_GetHashValue(hPtr), ContLineLocFree);
+		ckfree(Tcl_GetHashValue(hPtr));
 		Tcl_DeleteHashEntry(hPtr);
 	    }
 	}
@@ -1496,7 +1464,7 @@ TclFreeObj(
 	if (tsdPtr->lineCLPtr) {
             hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
 	    if (hPtr) {
-		Tcl_EventuallyFree(Tcl_GetHashValue(hPtr), ContLineLocFree);
+		ckfree(Tcl_GetHashValue(hPtr));
 		Tcl_DeleteHashEntry(hPtr);
 	    }
 	}
-- 
cgit v0.12


From 5797625e426c633edd40f6a32d561f378451939b Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 7 Aug 2013 19:45:13 +0000
Subject: Give (objc, objv) their own ride from enter to leave traces.

---
 generic/tclBasic.c | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 7110025..067da63 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -4727,7 +4727,7 @@ TEOV_RunEnterTraces(
 	 */
 
 	TclNRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(traceCode),
-		commandPtr, cmdPtr, NULL);
+		commandPtr, cmdPtr, Tcl_NewListObj(objc, objv));
 	cmdPtr->refCount++;
     } else {
 	Tcl_DecrRefCount(commandPtr);
@@ -4748,11 +4748,10 @@ TEOV_RunLeaveTraces(
     int traceCode = PTR2INT(data[0]);
     Tcl_Obj *commandPtr = data[1];
     Command *cmdPtr = data[2];
+    Tcl_Obj *wordsPtr = data[3];
 
     command = Tcl_GetStringFromObj(commandPtr, &length);
-    if (TCL_OK != Tcl_ListObjGetElements(interp, commandPtr, &objc, &objv)) {
-	Tcl_Panic("Who messed with commandPtr?");
-    }
+    Tcl_ListObjGetElements(NULL, wordsPtr, &objc, &objv);
 
     if (!(cmdPtr->flags & CMD_IS_DELETED)) {
 	if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && traceCode == TCL_OK){
@@ -4765,6 +4764,7 @@ TEOV_RunLeaveTraces(
 	}
     }
     Tcl_DecrRefCount(commandPtr);
+    Tcl_DecrRefCount(wordsPtr);
 
     /*
      * As cmdPtr is set, TclNRRunCallbacks is about to reduce the numlevels.
-- 
cgit v0.12


From 1b7d424507465ff2c00fe684db9bf22046998660 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 7 Aug 2013 20:27:30 +0000
Subject: Revise GetCommandSource() to return a normal Tcl_Obj value.

---
 generic/tclBasic.c | 26 ++++++++------------------
 1 file changed, 8 insertions(+), 18 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 067da63..6542726 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -3358,15 +3358,6 @@ CancelEvalProc(
  *	This function returns a Tcl_Obj with the full source string for the
  *	command. This insures that traces get a correct NUL-terminated command
  *	string. The Tcl_Obj has refCount==1.
- *
- *	*** MAINTAINER WARNING ***
- *	The returned Tcl_Obj is all wrong for any purpose but getting the
- *	source string for an objc/objv command line in the stringRep (no
- *	stringRep if no source is available) and the corresponding substituted
- *	version in the List intrep.
- *	This means that the intRep and stringRep DO NOT COINCIDE! Using these
- *	Tcl_Objs normally is likely to break things.
- *
  *----------------------------------------------------------------------
  */
 
@@ -3376,13 +3367,13 @@ GetCommandSource(
     int objc,
     Tcl_Obj *const objv[])
 {
-    Tcl_Obj *objPtr, *obj2Ptr;
+    Tcl_Obj *objPtr = NULL;
     CmdFrame *cfPtr = iPtr->cmdFramePtr;
-    const char *command = NULL;
-    int numChars;
 
-    objPtr = Tcl_NewListObj(objc, objv);
     if (cfPtr && (cfPtr->numLevels == iPtr->numLevels-1)) {
+	const char *command = NULL;
+	int numChars;
+
 	switch (cfPtr->type) {
 	case TCL_LOCATION_EVAL:
 	case TCL_LOCATION_SOURCE:
@@ -3395,13 +3386,12 @@ GetCommandSource(
 	    break;
 	}
 	if (command) {
-	    obj2Ptr = Tcl_NewStringObj(command, numChars);
-	    objPtr->bytes = obj2Ptr->bytes;
-	    objPtr->length = numChars;
-	    obj2Ptr->bytes = NULL;
-	    Tcl_DecrRefCount(obj2Ptr);
+	    objPtr = Tcl_NewStringObj(command, numChars);
 	}
     }
+    if (objPtr == NULL) {
+	objPtr = Tcl_NewListObj(objc, objv);
+    }
     Tcl_IncrRefCount(objPtr);
     return objPtr;
 }
-- 
cgit v0.12


From 234fb04984f972cecb094dc86965d3829945cb6a Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 9 Aug 2013 16:48:30 +0000
Subject: Revised GetCommandSource() can (and thus should) return a normal zero
 refcount value.

---
 generic/tclBasic.c | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 6542726..9755a21 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -3357,7 +3357,7 @@ CancelEvalProc(
  *
  *	This function returns a Tcl_Obj with the full source string for the
  *	command. This insures that traces get a correct NUL-terminated command
- *	string. The Tcl_Obj has refCount==1.
+ *	string.
  *----------------------------------------------------------------------
  */
 
@@ -3392,7 +3392,6 @@ GetCommandSource(
     if (objPtr == NULL) {
 	objPtr = Tcl_NewListObj(objc, objv);
     }
-    Tcl_IncrRefCount(objPtr);
     return objPtr;
 }
 
-- 
cgit v0.12


From e62b40c8088c3c29874a696636a05ce5d6da70bd Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Sat, 10 Aug 2013 05:16:38 +0000
Subject: Arrange for both execution traces and [info frame] to get their
 pre-subst source strings from a common routine, with care taken to reduce
 copying by that routine.

---
 generic/tclBasic.c   | 41 +++++++++++++++--------------------------
 generic/tclCmdIL.c   | 25 ++++++++++++++++++++++---
 generic/tclExecute.c | 19 +++++++++++++++++--
 generic/tclInt.h     |  5 +++++
 4 files changed, 59 insertions(+), 31 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 9755a21..1cd2eae 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -3367,32 +3367,12 @@ GetCommandSource(
     int objc,
     Tcl_Obj *const objv[])
 {
-    Tcl_Obj *objPtr = NULL;
     CmdFrame *cfPtr = iPtr->cmdFramePtr;
 
-    if (cfPtr && (cfPtr->numLevels == iPtr->numLevels-1)) {
-	const char *command = NULL;
-	int numChars;
-
-	switch (cfPtr->type) {
-	case TCL_LOCATION_EVAL:
-	case TCL_LOCATION_SOURCE:
-	    command = cfPtr->cmd;
-	    numChars = cfPtr->len;
-	    break;
-	case TCL_LOCATION_BC:
-	case TCL_LOCATION_PREBC:
-	    command = TclGetSrcInfoForCmd(iPtr, &numChars);
-	    break;
-	}
-	if (command) {
-	    objPtr = Tcl_NewStringObj(command, numChars);
-	}
+    if (cfPtr && (cfPtr->numLevels != iPtr->numLevels-1)) {
+	cfPtr = NULL;
     }
-    if (objPtr == NULL) {
-	objPtr = Tcl_NewListObj(objc, objv);
-    }
-    return objPtr;
+    return TclGetSourceFromFrame(cfPtr, objc, objv);
 }
 
 /*
@@ -4678,6 +4658,7 @@ TEOV_RunEnterTraces(
     Tcl_Obj *commandPtr;
 
     commandPtr = GetCommandSource(iPtr, objc, objv);
+    Tcl_IncrRefCount(commandPtr);
     command = Tcl_GetStringFromObj(commandPtr, &length);
 
     /*
@@ -5013,6 +4994,7 @@ TclEvalEx(
     eeFramePtr->nextPtr = iPtr->cmdFramePtr;
     eeFramePtr->nline = 0;
     eeFramePtr->line = NULL;
+    eeFramePtr->cmdObj = NULL;
 
     iPtr->cmdFramePtr = eeFramePtr;
     if (iPtr->evalFlags & TCL_EVAL_FILE) {
@@ -5243,6 +5225,10 @@ TclEvalEx(
 
 	    eeFramePtr->line = NULL;
 	    eeFramePtr->nline = 0;
+	    if (eeFramePtr->cmdObj) {
+		Tcl_DecrRefCount(eeFramePtr->cmdObj);
+		eeFramePtr->cmdObj = NULL;
+	    }
 
 	    if (code != TCL_OK) {
 		goto error;
@@ -5983,7 +5969,6 @@ TclNREvalObjEx(
 	Tcl_IncrRefCount(objPtr);
 	listPtr = TclListObjCopy(interp, objPtr);
 	Tcl_IncrRefCount(listPtr);
-	TclDecrRefCount(objPtr);
 
 	if (word != INT_MIN) {
 	    /*
@@ -6013,7 +5998,9 @@ TclNREvalObjEx(
 	    eoFramePtr->framePtr = iPtr->framePtr;
 	    eoFramePtr->nextPtr = iPtr->cmdFramePtr;
 
-	    eoFramePtr->cmd = Tcl_GetStringFromObj(listPtr, &(eoFramePtr->len));
+	    eoFramePtr->cmdObj = objPtr;
+	    eoFramePtr->cmd = NULL;
+	    eoFramePtr->len = 0;
 	    eoFramePtr->data.eval.path = NULL;
 
 	    iPtr->cmdFramePtr = eoFramePtr;
@@ -6021,7 +6008,7 @@ TclNREvalObjEx(
 
 	TclMarkTailcall(interp);
         TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr,
-		NULL, NULL);
+		objPtr, NULL);
 
 	ListObjGetElements(listPtr, objc, objv);
 	return TclNREvalObjv(interp, objc, objv, flags, NULL);
@@ -6156,6 +6143,7 @@ TEOEx_ListCallback(
     Interp *iPtr = (Interp *) interp;
     Tcl_Obj *listPtr = data[0];
     CmdFrame *eoFramePtr = data[1];
+    Tcl_Obj *objPtr = data[2];
 
     /*
      * Remove the cmdFrame
@@ -6165,6 +6153,7 @@ TEOEx_ListCallback(
 	iPtr->cmdFramePtr = eoFramePtr->nextPtr;
 	TclStackFree(interp, eoFramePtr);
     }
+    TclDecrRefCount(objPtr);
     TclDecrRefCount(listPtr);
 
     return result;
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 180d814..da9edd6 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -1266,6 +1266,25 @@ InfoFrameCmd(
  */
 
 Tcl_Obj *
+TclGetSourceFromFrame(
+    CmdFrame *cfPtr,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    if (cfPtr == NULL) {
+	return Tcl_NewListObj(objc, objv);
+    }
+    if (cfPtr->cmdObj == NULL) {
+	if (cfPtr->cmd == NULL) {
+	    cfPtr->cmd = TclGetSrcInfoForCmdFrame(cfPtr, &cfPtr->len);
+	}
+	cfPtr->cmdObj = Tcl_NewStringObj(cfPtr->cmd, cfPtr->len);
+	Tcl_IncrRefCount(cfPtr->cmdObj);
+    }
+    return cfPtr->cmdObj;
+}
+
+Tcl_Obj *
 TclInfoFrame(
     Tcl_Interp *interp,		/* Current interpreter. */
     CmdFrame *framePtr)		/* Frame to get info for. */
@@ -1307,7 +1326,7 @@ TclInfoFrame(
 	} else {
 	    ADD_PAIR("line", Tcl_NewIntObj(1));
 	}
-	ADD_PAIR("cmd", Tcl_NewStringObj(framePtr->cmd, framePtr->len));
+	ADD_PAIR("cmd", TclGetSourceFromFrame(framePtr, 0, NULL));
 	break;
 
     case TCL_LOCATION_PREBC:
@@ -1355,7 +1374,7 @@ TclInfoFrame(
 	    Tcl_DecrRefCount(fPtr->data.eval.path);
 	}
 
-	ADD_PAIR("cmd", Tcl_NewStringObj(fPtr->cmd, fPtr->len));
+	ADD_PAIR("cmd", TclGetSourceFromFrame(fPtr, 0, NULL));
 	TclStackFree(interp, fPtr);
 	break;
     }
@@ -1374,7 +1393,7 @@ TclInfoFrame(
 	 * the result list object.
 	 */
 
-	ADD_PAIR("cmd", Tcl_NewStringObj(framePtr->cmd, framePtr->len));
+	ADD_PAIR("cmd", TclGetSourceFromFrame(framePtr, 0, NULL));
 	break;
 
     case TCL_LOCATION_PROC:
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index f6072a1..d8ccf40 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -2006,6 +2006,7 @@ TclNRExecuteByteCode(
     bcFramePtr->litarg = NULL;
     bcFramePtr->data.tebc.codePtr = codePtr;
     bcFramePtr->data.tebc.pc = NULL;
+    bcFramePtr->cmdObj = NULL;
     bcFramePtr->cmd = NULL;
     bcFramePtr->len = 0;
 
@@ -2130,6 +2131,11 @@ TEBCresume(
 	    result = TCL_ERROR;
 	}
 	NRE_ASSERT(iPtr->cmdFramePtr == bcFramePtr);
+	if (bcFramePtr->cmdObj) {
+	    Tcl_DecrRefCount(bcFramePtr->cmdObj);
+	    bcFramePtr->cmdObj = NULL;
+	    bcFramePtr->cmd = NULL;
+	}
 	iPtr->cmdFramePtr = bcFramePtr->nextPtr;
 	if (iPtr->flags & INTERP_DEBUG_FRAME) {
 	    TclArgumentBCRelease((Tcl_Interp *) iPtr, bcFramePtr);
@@ -8761,7 +8767,14 @@ TclGetSrcInfoForCmd(
     Interp *iPtr,
     int *lenPtr)
 {
-    CmdFrame *cfPtr = iPtr->cmdFramePtr;
+    return TclGetSrcInfoForCmdFrame(iPtr->cmdFramePtr, lenPtr);
+}
+
+const char *
+TclGetSrcInfoForCmdFrame(
+    CmdFrame *cfPtr,
+    int *lenPtr)
+{
     ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr;
 
     return GetSrcInfoForPc((unsigned char *) cfPtr->data.tebc.pc,
@@ -8775,11 +8788,13 @@ TclGetSrcInfoForPc(
     ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr;
 
     assert(cfPtr->type == TCL_LOCATION_BC);
-    assert(cfPtr->cmd == NULL);
+
+    if (cfPtr->cmd == NULL) {
 
 	cfPtr->cmd = GetSrcInfoForPc(
 		(unsigned char *) cfPtr->data.tebc.pc, codePtr,
 		&cfPtr->len, NULL, NULL);
+    }
 
     assert(cfPtr->cmd != NULL);
     {
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 99f1305..161d166 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -1208,6 +1208,7 @@ typedef struct CmdFrame {
 	    const char *pc;	/* ... and instruction pointer. */
 	} tebc;
     } data;
+    Tcl_Obj *cmdObj;
     const char *cmd;		/* The executed command, if possible... */
     int len;			/* ... and its length. */
     int numLevels;		/* Value of interp's numLevels when the frame
@@ -2907,7 +2908,11 @@ MODULE_SCOPE int	TclGetOpenModeEx(Tcl_Interp *interp,
 			    const char *modeString, int *seekFlagPtr,
 			    int *binaryPtr);
 MODULE_SCOPE Tcl_Obj *	TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr);
+MODULE_SCOPE Tcl_Obj *	TclGetSourceFromFrame(CmdFrame *cfPtr, int objc,
+			    Tcl_Obj *const objv[]);
 MODULE_SCOPE const char *TclGetSrcInfoForCmd(Interp *iPtr, int *lenPtr);
+MODULE_SCOPE const char *TclGetSrcInfoForCmdFrame(CmdFrame *cfPtr,
+			    int *lenPtr);
 MODULE_SCOPE int	TclGlob(Tcl_Interp *interp, char *pattern,
 			    Tcl_Obj *unquotedPrefix, int globFlags,
 			    Tcl_GlobTypeData *types);
-- 
cgit v0.12


From 97eb71a62940a86f2a09ab817dc389f1c42de9d1 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Sun, 11 Aug 2013 14:41:10 +0000
Subject: Never guess non-existing timezone name "America/Brasilia" on Windows.
 Reported by Arnulf Wiedemann

---
 library/clock.tcl | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/library/clock.tcl b/library/clock.tcl
index 49aad23..1f83716 100644
--- a/library/clock.tcl
+++ b/library/clock.tcl
@@ -325,7 +325,7 @@ proc ::tcl::clock::Initialize {} {
 	{-10800 0 3600 0 2 0 2 2 0 0 0 0 10 0 3 2 0 0 0} :America/Sao_Paulo
 	{-10800 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Godthab
 	{-10800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}  :America/Buenos_Aires
-        {-10800 0 3600 0 2 0 5 2 0 0 0 0 11 0 1 2 0 0 0} :America/Brasilia
+        {-10800 0 3600 0 2 0 5 2 0 0 0 0 11 0 1 2 0 0 0} :America/Bahia
         {-10800 0 3600 0 3 0 2 2 0 0 0 0 10 0 1 2 0 0 0} :America/Montevideo
 	{-7200 0 3600 0 9 0 5 2 0 0 0 0 3 0 5 2 0 0 0}   :America/Noronha
 	{-3600 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0}  :Atlantic/Azores
-- 
cgit v0.12


From 33647e79c82706ff257c5d6bad26438a27f90354 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 12 Aug 2013 20:00:14 +0000
Subject: Use a new flag value TCL_EVAL_SOURCE_IN_FRAME passed in by callers to
 determine whether the pre-subst source information in a CmdFrame is to be
 used.  This takes the place of numLevels cross checking, so that field is
 removed.  Routines are consolidated as well.

---
 generic/tclBasic.c   | 43 +++++++++----------------------------------
 generic/tclExecute.c | 13 ++-----------
 generic/tclInt.h     |  8 +++-----
 3 files changed, 14 insertions(+), 50 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 1cd2eae..b6c6f38 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -127,8 +127,6 @@ static Tcl_ObjCmdProc	ExprSqrtFunc;
 static Tcl_ObjCmdProc	ExprSrandFunc;
 static Tcl_ObjCmdProc	ExprUnaryFunc;
 static Tcl_ObjCmdProc	ExprWideFunc;
-static Tcl_Obj *	GetCommandSource(Interp *iPtr, int objc,
-			    Tcl_Obj *const objv[]);
 static void		MathFuncWrongNumArgs(Tcl_Interp *interp, int expected,
 			    int actual, Tcl_Obj *const *objv);
 static Tcl_NRPostProc	NRCoroutineCallerCallback;
@@ -149,7 +147,7 @@ static inline Command *	TEOV_LookupCmdFromObj(Tcl_Interp *interp,
 static int		TEOV_NotFound(Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[], Namespace *lookupNsPtr);
 static int		TEOV_RunEnterTraces(Tcl_Interp *interp,
-			    Command **cmdPtrPtr, int objc,
+			    Command **cmdPtrPtr, Tcl_Obj *commandPtr, int objc,
 			    Tcl_Obj *const objv[], Namespace *lookupNsPtr);
 static Tcl_NRPostProc	RewindCoroutineCallback;
 static Tcl_NRPostProc	TailcallCleanup;
@@ -3353,31 +3351,6 @@ CancelEvalProc(
 /*
  *----------------------------------------------------------------------
  *
- * GetCommandSource --
- *
- *	This function returns a Tcl_Obj with the full source string for the
- *	command. This insures that traces get a correct NUL-terminated command
- *	string.
- *----------------------------------------------------------------------
- */
-
-static Tcl_Obj *
-GetCommandSource(
-    Interp *iPtr,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    CmdFrame *cfPtr = iPtr->cmdFramePtr;
-
-    if (cfPtr && (cfPtr->numLevels != iPtr->numLevels-1)) {
-	cfPtr = NULL;
-    }
-    return TclGetSourceFromFrame(cfPtr, objc, objv);
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * TclCleanupCommand --
  *
  *	This function frees up a Command structure unless it is still
@@ -4230,7 +4203,9 @@ TclNREvalObjv(
 	 * necessary.
 	 */
 
-	result = TEOV_RunEnterTraces(interp, &cmdPtr, objc, objv, lookupNsPtr);
+	result = TEOV_RunEnterTraces(interp, &cmdPtr, TclGetSourceFromFrame(
+		flags & TCL_EVAL_SOURCE_IN_FRAME ?  iPtr->cmdFramePtr : NULL,
+		objc, objv), objc, objv, lookupNsPtr);
 	if (!cmdPtr) {
 	    return TEOV_NotFound(interp, objc, objv, lookupNsPtr);
 	}
@@ -4644,6 +4619,7 @@ static int
 TEOV_RunEnterTraces(
     Tcl_Interp *interp,
     Command **cmdPtrPtr,
+    Tcl_Obj *commandPtr,
     int objc,
     Tcl_Obj *const objv[],
     Namespace *lookupNsPtr)
@@ -4655,9 +4631,7 @@ TEOV_RunEnterTraces(
     int newEpoch;
     const char *command;
     int length;
-    Tcl_Obj *commandPtr;
 
-    commandPtr = GetCommandSource(iPtr, objc, objv);
     Tcl_IncrRefCount(commandPtr);
     command = Tcl_GetStringFromObj(commandPtr, &length);
 
@@ -4989,7 +4963,6 @@ TclEvalEx(
      */
 
     eeFramePtr->level = iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level + 1 : 1;
-    eeFramePtr->numLevels = iPtr->numLevels;
     eeFramePtr->framePtr = iPtr->framePtr;
     eeFramePtr->nextPtr = iPtr->cmdFramePtr;
     eeFramePtr->nline = 0;
@@ -5220,7 +5193,8 @@ TclEvalEx(
 	    eeFramePtr->line = lines;
 
 	    TclArgumentEnter(interp, objv, objectsUsed, eeFramePtr);
-	    code = Tcl_EvalObjv(interp, objectsUsed, objv, TCL_EVAL_NOERR);
+	    code = Tcl_EvalObjv(interp, objectsUsed, objv,
+		    TCL_EVAL_NOERR | TCL_EVAL_SOURCE_IN_FRAME);
 	    TclArgumentRelease(interp, objv, objectsUsed);
 
 	    eeFramePtr->line = NULL;
@@ -5994,7 +5968,6 @@ TclNREvalObjEx(
 	    eoFramePtr->type = TCL_LOCATION_EVAL;
 	    eoFramePtr->level = (iPtr->cmdFramePtr == NULL?
 		    1 : iPtr->cmdFramePtr->level + 1);
-	    eoFramePtr->numLevels = iPtr->numLevels;
 	    eoFramePtr->framePtr = iPtr->framePtr;
 	    eoFramePtr->nextPtr = iPtr->cmdFramePtr;
 
@@ -6004,6 +5977,8 @@ TclNREvalObjEx(
 	    eoFramePtr->data.eval.path = NULL;
 
 	    iPtr->cmdFramePtr = eoFramePtr;
+
+	    flags |= TCL_EVAL_SOURCE_IN_FRAME;
 	}
 
 	TclMarkTailcall(interp);
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index d8ccf40..58e4d3d 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -1998,7 +1998,6 @@ TclNRExecuteByteCode(
     bcFramePtr->type = ((codePtr->flags & TCL_BYTECODE_PRECOMPILED)
 	    ? TCL_LOCATION_PREBC : TCL_LOCATION_BC);
     bcFramePtr->level = (iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level+1 : 1);
-    bcFramePtr->numLevels = iPtr->numLevels;
     bcFramePtr->framePtr = iPtr->framePtr;
     bcFramePtr->nextPtr = iPtr->cmdFramePtr;
     bcFramePtr->nline = 0;
@@ -2906,7 +2905,7 @@ TEBCresume(
 	pc += pcAdjustment;
 	TEBC_YIELD();
 	return TclNREvalObjv(interp, objc, objv,
-		TCL_EVAL_NOERR, NULL);
+		TCL_EVAL_NOERR | TCL_EVAL_SOURCE_IN_FRAME, NULL);
 
 #if TCL_SUPPORT_84_BYTECODE
     case INST_CALL_BUILTIN_FUNC1:
@@ -8741,7 +8740,7 @@ IllegalExprOperandType(
 /*
  *----------------------------------------------------------------------
  *
- * TclGetSrcInfoForPc, GetSrcInfoForPc, TclGetSrcInfoForCmd --
+ * TclGetSrcInfoForPc, GetSrcInfoForPc, TclGetSrcInfoForCmdFrame --
  *
  *	Given a program counter value, finds the closest command in the
  *	bytecode code unit's CmdLocation array and returns information about
@@ -8763,14 +8762,6 @@ IllegalExprOperandType(
  */
 
 const char *
-TclGetSrcInfoForCmd(
-    Interp *iPtr,
-    int *lenPtr)
-{
-    return TclGetSrcInfoForCmdFrame(iPtr->cmdFramePtr, lenPtr);
-}
-
-const char *
 TclGetSrcInfoForCmdFrame(
     CmdFrame *cfPtr,
     int *lenPtr)
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 161d166..19cd883 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -1211,8 +1211,6 @@ typedef struct CmdFrame {
     Tcl_Obj *cmdObj;
     const char *cmd;		/* The executed command, if possible... */
     int len;			/* ... and its length. */
-    int numLevels;		/* Value of interp's numLevels when the frame
-				 * was pushed. */
     const struct CFWordBC *litarg;
 				/* Link to set of literal arguments which have
 				 * ben pushed on the lineLABCPtr stack by
@@ -2200,8 +2198,9 @@ typedef struct Interp {
  *			other than these should be turned into errors.
  */
 
-#define TCL_ALLOW_EXCEPTIONS	4
-#define TCL_EVAL_FILE		2
+#define TCL_ALLOW_EXCEPTIONS		0x04
+#define TCL_EVAL_FILE			0x02
+#define TCL_EVAL_SOURCE_IN_FRAME	0x10
 
 /*
  * Flag bits for Interp structures:
@@ -2910,7 +2909,6 @@ MODULE_SCOPE int	TclGetOpenModeEx(Tcl_Interp *interp,
 MODULE_SCOPE Tcl_Obj *	TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr);
 MODULE_SCOPE Tcl_Obj *	TclGetSourceFromFrame(CmdFrame *cfPtr, int objc,
 			    Tcl_Obj *const objv[]);
-MODULE_SCOPE const char *TclGetSrcInfoForCmd(Interp *iPtr, int *lenPtr);
 MODULE_SCOPE const char *TclGetSrcInfoForCmdFrame(CmdFrame *cfPtr,
 			    int *lenPtr);
 MODULE_SCOPE int	TclGlob(Tcl_Interp *interp, char *pattern,
-- 
cgit v0.12


From 9d1f38c3e3690b0f7b473375d4fe633656c630a4 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 14 Aug 2013 04:13:21 +0000
Subject: Only schedule leave traces if enter traces complete successfully.
 This avoids a memleak, and opens a data slot, so we can pass objc, objv
 without the need to copy them into a list value.

---
 generic/tclBasic.c | 22 ++++++++++------------
 1 file changed, 10 insertions(+), 12 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index b6c6f38..f852b44 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -4665,13 +4665,13 @@ TEOV_RunEnterTraces(
 	*cmdPtrPtr = cmdPtr;
     }
 
-    if (cmdPtr) {
+    if (cmdPtr && (traceCode == TCL_OK)) {
 	/*
 	 * Command was found: push a record to schedule the leave traces.
 	 */
 
-	TclNRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(traceCode),
-		commandPtr, cmdPtr, Tcl_NewListObj(objc, objv));
+	TclNRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(objc),
+		commandPtr, cmdPtr, objv);
 	cmdPtr->refCount++;
     } else {
 	Tcl_DecrRefCount(commandPtr);
@@ -4686,19 +4686,18 @@ TEOV_RunLeaveTraces(
     int result)
 {
     Interp *iPtr = (Interp *) interp;
-    const char *command;
-    int length, objc;
-    Tcl_Obj **objv;
-    int traceCode = PTR2INT(data[0]);
+    int traceCode = TCL_OK;
+    int objc = PTR2INT(data[0]);
     Tcl_Obj *commandPtr = data[1];
     Command *cmdPtr = data[2];
-    Tcl_Obj *wordsPtr = data[3];
+    Tcl_Obj **objv = data[3];
 
-    command = Tcl_GetStringFromObj(commandPtr, &length);
-    Tcl_ListObjGetElements(NULL, wordsPtr, &objc, &objv);
 
     if (!(cmdPtr->flags & CMD_IS_DELETED)) {
-	if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && traceCode == TCL_OK){
+	int length;
+	const char *command = Tcl_GetStringFromObj(commandPtr, &length);
+
+	if (cmdPtr->flags & CMD_HAS_EXEC_TRACES){
 	    traceCode = TclCheckExecutionTraces(interp, command, length,
 		    cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv);
 	}
@@ -4708,7 +4707,6 @@ TEOV_RunLeaveTraces(
 	}
     }
     Tcl_DecrRefCount(commandPtr);
-    Tcl_DecrRefCount(wordsPtr);
 
     /*
      * As cmdPtr is set, TclNRRunCallbacks is about to reduce the numlevels.
-- 
cgit v0.12


From 6dee5b3e07d501459386b52bc18efc2c2cbc5fcb Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 14 Aug 2013 12:15:59 +0000
Subject: Consolidate some helper routines.

---
 generic/tclCmdIL.c   | 19 -------------------
 generic/tclExecute.c | 27 +++++++++++++++++++--------
 generic/tclInt.h     |  2 --
 3 files changed, 19 insertions(+), 29 deletions(-)

diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index da9edd6..fa4ead4 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -1266,25 +1266,6 @@ InfoFrameCmd(
  */
 
 Tcl_Obj *
-TclGetSourceFromFrame(
-    CmdFrame *cfPtr,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    if (cfPtr == NULL) {
-	return Tcl_NewListObj(objc, objv);
-    }
-    if (cfPtr->cmdObj == NULL) {
-	if (cfPtr->cmd == NULL) {
-	    cfPtr->cmd = TclGetSrcInfoForCmdFrame(cfPtr, &cfPtr->len);
-	}
-	cfPtr->cmdObj = Tcl_NewStringObj(cfPtr->cmd, cfPtr->len);
-	Tcl_IncrRefCount(cfPtr->cmdObj);
-    }
-    return cfPtr->cmdObj;
-}
-
-Tcl_Obj *
 TclInfoFrame(
     Tcl_Interp *interp,		/* Current interpreter. */
     CmdFrame *framePtr)		/* Frame to get info for. */
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 58e4d3d..d066476 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -8740,7 +8740,7 @@ IllegalExprOperandType(
 /*
  *----------------------------------------------------------------------
  *
- * TclGetSrcInfoForPc, GetSrcInfoForPc, TclGetSrcInfoForCmdFrame --
+ * TclGetSrcInfoForPc, GetSrcInfoForPc, TclGetSourceFromFrame --
  *
  *	Given a program counter value, finds the closest command in the
  *	bytecode code unit's CmdLocation array and returns information about
@@ -8761,15 +8761,26 @@ IllegalExprOperandType(
  *----------------------------------------------------------------------
  */
 
-const char *
-TclGetSrcInfoForCmdFrame(
+Tcl_Obj *
+TclGetSourceFromFrame(
     CmdFrame *cfPtr,
-    int *lenPtr)
+    int objc,
+    Tcl_Obj *const objv[])
 {
-    ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr;
-
-    return GetSrcInfoForPc((unsigned char *) cfPtr->data.tebc.pc,
-	    codePtr, lenPtr, NULL, NULL);
+    if (cfPtr == NULL) {
+        return Tcl_NewListObj(objc, objv);
+    }
+    if (cfPtr->cmdObj == NULL) {
+        if (cfPtr->cmd == NULL) {
+	    ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr;
+
+            cfPtr->cmd = GetSrcInfoForPc((unsigned char *)
+		    cfPtr->data.tebc.pc, codePtr, &cfPtr->len, NULL, NULL);
+        }
+        cfPtr->cmdObj = Tcl_NewStringObj(cfPtr->cmd, cfPtr->len);
+        Tcl_IncrRefCount(cfPtr->cmdObj);
+    }
+    return cfPtr->cmdObj;
 }
 
 void
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 19cd883..6056119 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2909,8 +2909,6 @@ MODULE_SCOPE int	TclGetOpenModeEx(Tcl_Interp *interp,
 MODULE_SCOPE Tcl_Obj *	TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr);
 MODULE_SCOPE Tcl_Obj *	TclGetSourceFromFrame(CmdFrame *cfPtr, int objc,
 			    Tcl_Obj *const objv[]);
-MODULE_SCOPE const char *TclGetSrcInfoForCmdFrame(CmdFrame *cfPtr,
-			    int *lenPtr);
 MODULE_SCOPE int	TclGlob(Tcl_Interp *interp, char *pattern,
 			    Tcl_Obj *unquotedPrefix, int globFlags,
 			    Tcl_GlobTypeData *types);
-- 
cgit v0.12


From a2400fbe30f602e19fbeb74a5c6df7fc0e220699 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 14 Aug 2013 17:02:41 +0000
Subject: [a16752c252] Correct failure to call cmd deletion callbacks.

---
 generic/tclBasic.c | 28 +++++-----------------------
 generic/tclTest.c  |  6 +++---
 tests/rename.test  |  7 +++++++
 3 files changed, 15 insertions(+), 26 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 4f24515..8ab3acb 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -1966,12 +1966,8 @@ Tcl_CreateCommand(
  *	future calls to Tcl_GetCommandName.
  *
  * Side effects:
- *	If no command named "cmdName" already exists for interp, one is
- *	created. Otherwise, if a command does exist, then if the object-based
- *	Tcl_ObjCmdProc is TclInvokeStringCommand, we assume Tcl_CreateCommand
- *	was called previously for the same command and just set its
- *	Tcl_ObjCmdProc to the argument "proc"; otherwise, we delete the old
- *	command.
+ *	If a command named "cmdName" already exists for interp, it is
+ * 	first deleted.  Then the new command is created from the arguments.
  *
  *	In the future, during bytecode evaluation when "cmdName" is seen as
  *	the name of a command by Tcl_EvalObj or Tcl_Eval, the object-based
@@ -2039,21 +2035,7 @@ Tcl_CreateObjCommand(
 	cmdPtr = Tcl_GetHashValue(hPtr);
 
 	/*
-	 * Command already exists. If its object-based Tcl_ObjCmdProc is
-	 * TclInvokeStringCommand, we just set its Tcl_ObjCmdProc to the
-	 * argument "proc". Otherwise, we delete the old command.
-	 */
-
-	if (cmdPtr->objProc == TclInvokeStringCommand) {
-	    cmdPtr->objProc = proc;
-	    cmdPtr->objClientData = clientData;
-	    cmdPtr->deleteProc = deleteProc;
-	    cmdPtr->deleteData = clientData;
-	    return (Tcl_Command) cmdPtr;
-	}
-
-	/*
-	 * Otherwise, we delete the old command. Be careful to preserve any
+	 * Command already exists; delete it. Be careful to preserve any
 	 * existing import links so we can restore them down below. That way,
 	 * you can redefine a command and its import status will remain
 	 * intact.
@@ -2188,8 +2170,8 @@ TclInvokeStringCommand(
  *	A standard Tcl string result value.
  *
  * Side effects:
- *	Besides those side effects of the called Tcl_CmdProc,
- *	TclInvokeStringCommand allocates and frees storage.
+ *	Besides those side effects of the called Tcl_ObjCmdProc,
+ *	TclInvokeObjectCommand allocates and frees storage.
  *
  *----------------------------------------------------------------------
  */
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 9ef7805..5b51baa 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -1545,14 +1545,14 @@ DelCallbackProc(
  *
  * TestdelCmd --
  *
- *	This procedure implements the "testdcall" command.  It is used
- *	to test Tcl_CallWhenDeleted.
+ *	This procedure implements the "testdel" command.  It is used
+ *	to test calling of command deletion callbacks.
  *
  * Results:
  *	A standard Tcl result.
  *
  * Side effects:
- *	Creates and deletes interpreters.
+ *	Creates a command.
  *
  *----------------------------------------------------------------------
  */
diff --git a/tests/rename.test b/tests/rename.test
index bd14578..cd90b55 100644
--- a/tests/rename.test
+++ b/tests/rename.test
@@ -135,6 +135,13 @@ test rename-4.7 {reentrancy issues with command deletion and renaming} testdel {
 if {[info exists env(value)]} {
     unset env(value)
 }
+test rename-4.8 {Bug a16752c252} testdel {
+    set x broken
+    testdel {} foo {set x ok}
+    proc foo args {}
+    rename foo {}
+    return -level 0 $x[unset x]
+} ok
 
 # Save the unknown procedure which is modified by the following test.
 
-- 
cgit v0.12


From 058f0df44de4f6b80f1df5494c14c4d592928768 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 14 Aug 2013 20:20:11 +0000
Subject: Add several tests to check consistency of stack traces.

---
 tests/interp.test | 14 ++++++++++
 tests/safe.test   | 80 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 94 insertions(+)

diff --git a/tests/interp.test b/tests/interp.test
index 0af9887..ad99fac 100644
--- a/tests/interp.test
+++ b/tests/interp.test
@@ -1599,6 +1599,20 @@ test interp-20.50 {Bug 2486550} -setup {
 } -cleanup {
     interp delete slave
 } -returnCodes error -match glob -result *
+test interp-20.50.1 {Bug 2486550} -setup {
+    interp create slave
+} -body {
+    slave hide coroutine
+    catch {slave invokehidden coroutine} m o
+    dict get $o -errorinfo
+} -cleanup {
+    unset -nocomplain m 0
+    interp delete slave
+} -returnCodes ok -result {wrong # args: should be "coroutine name cmd ?arg ...?"
+    while executing
+"coroutine"
+    invoked from within
+"slave invokehidden coroutine"}
 
 test interp-21.1 {interp hidden} {
     interp hidden {}
diff --git a/tests/safe.test b/tests/safe.test
index 4a2792e..859f352 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -425,6 +425,19 @@ test safe-10.1 {testing statics loading} -constraints TcltestPackage -setup {
 } -returnCodes error -cleanup {
     safe::interpDelete $i
 } -result {can't use package in a safe interpreter: no Safepkg1_SafeInit procedure}
+test safe-10.1.1 {testing statics loading} -constraints TcltestPackage -setup {
+    set i [safe::interpCreate]
+} -body {
+    catch {interp eval $i {load {} Safepkg1}} m o
+    dict get $o -errorinfo
+} -returnCodes ok -cleanup {
+    unset -nocomplain m o
+    safe::interpDelete $i
+} -result {can't use package in a safe interpreter: no Safepkg1_SafeInit procedure
+    invoked from within
+"load {} Safepkg1"
+    invoked from within
+"interp eval $i {load {} Safepkg1}"}
 test safe-10.2 {testing statics loading / -nostatics} -constraints TcltestPackage -body {
     set i [safe::interpCreate -nostatics]
     interp eval $i {load {} Safepkg1}
@@ -444,6 +457,18 @@ test safe-10.4 {testing nested statics loading / -nestedloadok} -constraints Tcl
 } -returnCodes error -cleanup {
     safe::interpDelete $i
 } -result {can't use package in a safe interpreter: no Safepkg1_SafeInit procedure}
+test safe-10.4.1 {testing nested statics loading / -nestedloadok} -constraints TcltestPackage -body {
+    set i [safe::interpCreate -nestedloadok]
+    catch {interp eval $i {interp create x; load {} Safepkg1 x}} m o
+    dict get $o -errorinfo
+} -returnCodes ok -cleanup {
+    unset -nocomplain m o
+    safe::interpDelete $i
+} -result {can't use package in a safe interpreter: no Safepkg1_SafeInit procedure
+    invoked from within
+"load {} Safepkg1 x"
+    invoked from within
+"interp eval $i {interp create x; load {} Safepkg1 x}"}
 
 test safe-11.1 {testing safe encoding} -setup {
     set i [safe::interpCreate]
@@ -501,6 +526,23 @@ test safe-11.7 {testing safe encoding} -setup {
 } -returnCodes error -cleanup {
     safe::interpDelete $i
 } -result {wrong # args: should be "encoding convertfrom ?encoding? data"}
+test safe-11.7.1 {testing safe encoding} -setup {
+    set i [safe::interpCreate]
+} -body {
+    catch {interp eval $i encoding convertfrom} m o
+    dict get $o -errorinfo
+} -returnCodes ok -cleanup {
+    unset -nocomplain m o
+    safe::interpDelete $i
+} -result {wrong # args: should be "encoding convertfrom ?encoding? data"
+    while executing
+"encoding convertfrom"
+    invoked from within
+"::interp invokehidden interp1 encoding convertfrom"
+    invoked from within
+"encoding convertfrom"
+    invoked from within
+"interp eval $i encoding convertfrom"}
 test safe-11.8 {testing safe encoding} -setup {
     set i [safe::interpCreate]
 } -body {
@@ -508,6 +550,23 @@ test safe-11.8 {testing safe encoding} -setup {
 } -returnCodes error -cleanup {
     safe::interpDelete $i
 } -result {wrong # args: should be "encoding convertto ?encoding? data"}
+test safe-11.8.1 {testing safe encoding} -setup {
+    set i [safe::interpCreate]
+} -body {
+    catch {interp eval $i encoding convertto} m o
+    dict get $o -errorinfo
+} -returnCodes ok -cleanup {
+    unset -nocomplain m o
+    safe::interpDelete $i
+} -result {wrong # args: should be "encoding convertto ?encoding? data"
+    while executing
+"encoding convertto"
+    invoked from within
+"::interp invokehidden interp1 encoding convertto"
+    invoked from within
+"encoding convertto"
+    invoked from within
+"interp eval $i encoding convertto"}
 
 test safe-12.1 {glob is restricted [Bug 2906841]} -setup {
     set i [safe::interpCreate]
@@ -715,8 +774,29 @@ test safe-15.1 {safe file ensemble does not surprise code} -setup {
     lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg
     lappend result [catch {interp eval $i {file isdirectory .}} msg] $msg
 } -cleanup {
+    unset -nocomplain msg
     interp delete $i
 } -result {1 {a b c} 1 {a b c} 1 {invalid command name "file"} 1 0 {a b c} 1 {not allowed to invoke subcommand isdirectory of file}}
+test safe-15.1.1 {safe file ensemble does not surprise code} -setup {
+    set i [interp create -safe]
+} -body {
+    set result [expr {"file" in [interp hidden $i]}]
+    lappend result [interp eval $i {tcl::file::split a/b/c}]
+    lappend result [catch {interp eval $i {tcl::file::isdirectory .}}]
+    lappend result [interp invokehidden $i file split a/b/c]
+    lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg
+    lappend result [catch {interp invokehidden $i file isdirectory .}]
+    interp expose $i file
+    lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg
+    lappend result [catch {interp eval $i {file isdirectory .}} msg o] [dict get $o -errorinfo]
+} -cleanup {
+    unset -nocomplain msg o
+    interp delete $i
+} -result {1 {a b c} 1 {a b c} 1 {invalid command name "file"} 1 0 {a b c} 1 {not allowed to invoke subcommand isdirectory of file
+    while executing
+"file isdirectory ."
+    invoked from within
+"interp eval $i {file isdirectory .}"}}
 
 ### ~ should have no special meaning in paths in safe interpreters
 test safe-16.1 {Bug 3529949: defang ~ in paths} -setup {
-- 
cgit v0.12


From fe60431f5338aefb240b653c800fdcfe6c720706 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 15 Aug 2013 14:05:02 +0000
Subject: The fix for [3610404] leads to a simplification in the implementation
 of forward methods.

---
 generic/tclOOInt.h    |  6 ------
 generic/tclOOMethod.c | 13 +------------
 2 files changed, 1 insertion(+), 18 deletions(-)

diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h
index ab54964..c0e4022 100644
--- a/generic/tclOOInt.h
+++ b/generic/tclOOInt.h
@@ -122,12 +122,6 @@ typedef struct ForwardMethod {
     Tcl_Obj *prefixObj;		/* The list of values to use to replace the
 				 * object and method name with. Will be a
 				 * non-empty list. */
-    int fullyQualified;		/* If 1, the command name is fully qualified
-				 * and we should let the default Tcl mechanism
-				 * handle the command lookup because it is
-				 * more efficient. If 0, we need to do a
-				 * specialized lookup based on the current
-				 * object's namespace. */
 } ForwardMethod;
 
 /*
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index 0799082..f9f980a 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -1338,7 +1338,6 @@ TclOONewForwardInstanceMethod(
     fmPtr = ckalloc(sizeof(ForwardMethod));
     fmPtr->prefixObj = prefixObj;
     Tcl_ListObjIndex(interp, prefixObj, 0, &cmdObj);
-    fmPtr->fullyQualified = (strncmp(TclGetString(cmdObj), "::", 2) == 0);
     Tcl_IncrRefCount(prefixObj);
     return (Method *) Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr,
 	    nameObj, flags, &fwdMethodType, fmPtr);
@@ -1380,7 +1379,6 @@ TclOONewForwardMethod(
     fmPtr = ckalloc(sizeof(ForwardMethod));
     fmPtr->prefixObj = prefixObj;
     Tcl_ListObjIndex(interp, prefixObj, 0, &cmdObj);
-    fmPtr->fullyQualified = (strncmp(TclGetString(cmdObj), "::", 2) == 0);
     Tcl_IncrRefCount(prefixObj);
     return (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr, nameObj,
 	    flags, &fwdMethodType, fmPtr);
@@ -1409,7 +1407,6 @@ InvokeForwardMethod(
     ForwardMethod *fmPtr = clientData;
     Tcl_Obj **argObjs, **prefixObjs;
     int numPrefixes, len, skip = contextPtr->skip;
-    Command *cmdPtr;
 
     /*
      * Build the real list of arguments to use. Note that we know that the
@@ -1421,17 +1418,10 @@ InvokeForwardMethod(
     Tcl_ListObjGetElements(NULL, fmPtr->prefixObj, &numPrefixes, &prefixObjs);
     argObjs = InitEnsembleRewrite(interp, objc, objv, skip,
 	    numPrefixes, prefixObjs, &len);
-
-    if (fmPtr->fullyQualified) {
-	cmdPtr = NULL;
-    } else {
-	cmdPtr = (Command *) Tcl_FindCommand(interp, TclGetString(argObjs[0]),
-		contextPtr->oPtr->namespacePtr, 0 /* normal lookup */);
-    }
     Tcl_NRAddCallback(interp, FinalizeForwardCall, argObjs, NULL, NULL, NULL);
     ((Interp *)interp)->lookupNsPtr
 	    = (Namespace *) contextPtr->oPtr->namespacePtr;
-    return TclNREvalObjv(interp, len, argObjs, TCL_EVAL_INVOKE, cmdPtr);
+    return TclNREvalObjv(interp, len, argObjs, TCL_EVAL_INVOKE, NULL);
 }
 
 static int
@@ -1476,7 +1466,6 @@ CloneForwardMethod(
     ForwardMethod *fm2Ptr = ckalloc(sizeof(ForwardMethod));
 
     fm2Ptr->prefixObj = fmPtr->prefixObj;
-    fm2Ptr->fullyQualified = fmPtr->fullyQualified;
     Tcl_IncrRefCount(fm2Ptr->prefixObj);
     *newClientData = fm2Ptr;
     return TCL_OK;
-- 
cgit v0.12


From 5cdaf0e05bd402111776b93b830743a9746ad571 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 15 Aug 2013 19:55:26 +0000
Subject: Make sure the errors raised by execution traces become errors raised
 by the traced command, as documented.  Deletion of the traced command was
 supressing that.

---
 generic/tclBasic.c | 2 +-
 tests/trace.test   | 7 +++++++
 2 files changed, 8 insertions(+), 1 deletion(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 8ab3acb..314b5fc 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -3642,7 +3642,7 @@ TclEvalObjvInternal(
 	 * implementation.
 	 */
 
-	if (cmdEpoch != newEpoch) {
+	if (traceCode == TCL_OK && cmdEpoch != newEpoch) {
 	    checkTraces = 0;
 	    if (commandPtr) {
 		Tcl_DecrRefCount(commandPtr);
diff --git a/tests/trace.test b/tests/trace.test
index 24279f5..9c01908 100644
--- a/tests/trace.test
+++ b/tests/trace.test
@@ -2658,6 +2658,13 @@ test trace-39.1 {bug #3485022: tracing Bc'ed commands} -setup {
     rename dotrace {}
     rename foo {}
 } -result {3 | 0 1 1}
+
+test trace-40.1 {execution trace errors become command errors} {
+    proc foo args {}
+    trace add execution foo enter {rename foo {}; error bar;#}
+    catch foo m
+    return -level 0 $m[unset m]
+} bar
     
 # Delete procedures when done, so we don't clash with other tests
 # (e.g. foobar will clash with 'unknown' tests).
-- 
cgit v0.12


From 4d6aaa2e8b970c7babd8047939266ccc21084c7e Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Wed, 21 Aug 2013 10:25:18 +0000
Subject: [3612422]: Refer to correct part of tclvars(n) rather than page
 itself.

---
 doc/AddErrInfo.3  | 12 ++++++------
 doc/CrtInterp.3   |  7 ++++---
 doc/Environment.3 |  2 +-
 doc/bgerror.n     |  5 ++++-
 doc/binary.n      |  2 +-
 doc/catch.n       |  3 ++-
 doc/eval.n        |  3 ++-
 doc/info.n        | 12 ++++++------
 doc/library.n     | 10 +++++++---
 doc/return.n      |  4 ++--
 doc/tclsh.1       |  8 +++++---
 doc/throw.n       |  2 +-
 12 files changed, 41 insertions(+), 29 deletions(-)

diff --git a/doc/AddErrInfo.3 b/doc/AddErrInfo.3
index b9c6a63..36f6a20 100644
--- a/doc/AddErrInfo.3
+++ b/doc/AddErrInfo.3
@@ -176,16 +176,16 @@ these return options.
 The \fB\-errorinfo\fR option holds a stack trace of the
 operations that were in progress when an error occurred,
 and is intended to be human-readable.
-The \fB\-errorcode\fR option holds a list of items that
+The \fB\-errorcode\fR option holds a Tcl list of items that
 are intended to be machine-readable.
 The first item in the \fB\-errorcode\fR value identifies the class of
 error that occurred
-(e.g. POSIX means an error occurred in a POSIX system call)
+(e.g., POSIX means an error occurred in a POSIX system call)
 and additional elements hold additional pieces
 of information that depend on the class.
-See the \fBtclvars\fR manual entry for details on the various
-formats for the \fB\-errorcode\fR option used by
-Tcl's built-in commands.
+See the manual entry on the \fBerrorCode\fR variable for details on the
+various formats for the \fB\-errorcode\fR option used by Tcl's built-in
+commands.
 .PP
 The \fB\-errorinfo\fR option value is gradually built up as an
 error unwinds through the nested operations.
@@ -307,6 +307,6 @@ so they continue to hold a record of information about the
 most recent error seen in an interpreter.
 .SH "SEE ALSO"
 Tcl_DecrRefCount(3), Tcl_IncrRefCount(3), Tcl_Interp(3), Tcl_ResetResult(3),
-Tcl_SetErrno(3), tclvars(n)
+Tcl_SetErrno(3), errorCode(n), errorInfo(n)
 .SH KEYWORDS
 error, value, value result, stack, trace, variable
diff --git a/doc/CrtInterp.3 b/doc/CrtInterp.3
index a248cf4..1156a20 100644
--- a/doc/CrtInterp.3
+++ b/doc/CrtInterp.3
@@ -41,8 +41,9 @@ may only be passed to Tcl routines called from the same thread as
 the original \fBTcl_CreateInterp\fR call.  It is not safe for multiple
 threads to pass the same token to Tcl's routines.
 The new interpreter is initialized with the built-in Tcl commands
-and with the variables documented in the \fBtclvars\fR manual page. To bind in
-additional commands, call \fBTcl_CreateCommand\fR.
+and with standard variables like \fBtcl_platform\fR and \fBenv\fR. To
+bind in additional commands, call \fBTcl_CreateCommand\fR, and to
+create additional variables, call \fBTcl_SetVar\fR.
 .PP
 \fBTcl_DeleteInterp\fR marks an interpreter as deleted; the interpreter
 will eventually be deleted when all calls to \fBTcl_Preserve\fR for it have
@@ -144,6 +145,6 @@ should be used to determine when an interpreter is a candidate for deletion
 due to inactivity.
 .VE 8.6
 .SH "SEE ALSO"
-Tcl_Preserve(3), Tcl_Release(3), tclvars(n)
+Tcl_Preserve(3), Tcl_Release(3)
 .SH KEYWORDS
 command, create, delete, interpreter
diff --git a/doc/Environment.3 b/doc/Environment.3
index 3753f43..46262ab 100644
--- a/doc/Environment.3
+++ b/doc/Environment.3
@@ -33,6 +33,6 @@ Tcl-based applications using \fBputenv\fR should redefine it to
 \fBTcl_PutEnv\fR so that they will interface properly to the Tcl
 runtime.
 .SH "SEE ALSO"
-tclvars(n)
+env(n)
 .SH KEYWORDS
 environment, variable
diff --git a/doc/bgerror.n b/doc/bgerror.n
index ac53eca..16a23a3 100644
--- a/doc/bgerror.n
+++ b/doc/bgerror.n
@@ -85,6 +85,9 @@ proc bgerror {message} {
 }
 .CE
 .SH "SEE ALSO"
-after(n), interp(n), tclvars(n)
+after(n), errorCode(n), errorInfo(n), interp(n)
 .SH KEYWORDS
 background error, reporting
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/binary.n b/doc/binary.n
index 68bf9cc..a40afe6 100644
--- a/doc/binary.n
+++ b/doc/binary.n
@@ -884,7 +884,7 @@ close $f
 puts [\fBbinary encode\fR base64 \-maxlen 64 $data]
 .CE
 .SH "SEE ALSO"
-format(n), scan(n), tclvars(n)
+format(n), scan(n), tcl_platform(n)
 .SH KEYWORDS
 binary, format, scan
 '\" Local Variables:
diff --git a/doc/catch.n b/doc/catch.n
index a05ca71..9597ccf 100644
--- a/doc/catch.n
+++ b/doc/catch.n
@@ -115,7 +115,8 @@ if { [\fBcatch\fR {open $someFile w} fid] } {
 There are more complex examples of \fBcatch\fR usage in the
 documentation for the \fBreturn\fR command.
 .SH "SEE ALSO" 
-break(n), continue(n), dict(n), error(n), info(n), return(n), tclvars(n)
+break(n), continue(n), dict(n), error(n), errorCode(n), errorInfo(n), info(n),
+return(n)
 .SH KEYWORDS
 catch, error, exception
 '\" Local Variables:
diff --git a/doc/eval.n b/doc/eval.n
index da88757..13b54be 100644
--- a/doc/eval.n
+++ b/doc/eval.n
@@ -75,7 +75,8 @@ However, the last line would now normally be written without
 set var [linsert $var 0 {*}$args]
 .CE
 .SH "SEE ALSO"
-catch(n), concat(n), error(n), interp(n), list(n), namespace(n), subst(n), tclvars(n), uplevel(n)
+catch(n), concat(n), error(n), errorCode(n), errorInfo(n), interp(n), list(n),
+namespace(n), subst(n), uplevel(n)
 .SH KEYWORDS
 concatenate, evaluate, script
 '\" Local Variables:
diff --git a/doc/info.n b/doc/info.n
index e65a083..14a9e50 100644
--- a/doc/info.n
+++ b/doc/info.n
@@ -296,7 +296,6 @@ Returns the name of the library directory in which standard Tcl
 scripts are stored.
 This is actually the value of the \fBtcl_library\fR
 variable and may be changed by setting \fBtcl_library\fR.
-See the \fBtclvars\fR manual entry for more information.
 .TP
 \fBinfo loaded \fR?\fIinterp\fR?
 .
@@ -336,8 +335,8 @@ described in \fBOBJECT INTROSPECTION\fR below.
 .TP
 \fBinfo patchlevel\fR
 .
-Returns the value of the global variable \fBtcl_patchLevel\fR; see
-the \fBtclvars\fR manual entry for more information.
+Returns the value of the global variable \fBtcl_patchLevel\fR, which holds
+the exact version of the Tcl library by default.
 .TP
 \fBinfo procs \fR?\fIpattern\fR?
 .
@@ -374,8 +373,8 @@ string is returned.
 .TP
 \fBinfo tclversion\fR
 .
-Returns the value of the global variable \fBtcl_version\fR; see
-the \fBtclvars\fR manual entry for more information.
+Returns the value of the global variable \fBtcl_version\fR, which holds the
+major and minor version of the Tcl library by default.
 .TP
 \fBinfo vars\fR ?\fIpattern\fR?
 .
@@ -763,8 +762,9 @@ proc getDef {obj method} {
 .VE 8.6
 .SH "SEE ALSO"
 .VS 8.6
-global(n), oo::class(n), oo::define(n), oo::object(n), proc(n), self(n)
+global(n), oo::class(n), oo::define(n), oo::object(n), proc(n), self(n),
 .VE 8.6
+tcl_library(n), tcl_patchLevel(n), tcl_version(n)
 .SH KEYWORDS
 command, information, interpreter, introspection, level, namespace,
 .VS 8.6
diff --git a/doc/library.n b/doc/library.n
index 2413692..98dcb35 100644
--- a/doc/library.n
+++ b/doc/library.n
@@ -262,13 +262,17 @@ If set to any value, then \fBunknown\fR will not attempt to auto-load
 any commands.
 .TP
 \fBauto_path\fR
+.
 If set, then it must contain a valid Tcl list giving directories to
-search during auto-load operations.
+search during auto-load operations (including for package index
+files when using the default \fBpackage unknown\fR handler).
 This variable is initialized during startup to contain, in order:
 the directories listed in the \fBTCLLIBPATH\fR environment variable,
-the directory named by the \fBtcl_library\fR variable,
+the directory named by the \fBtcl_library\fR global variable,
 the parent directory of \fBtcl_library\fR,
 the directories listed in the \fBtcl_pkgPath\fR variable.
+Additional locations to look for files and package indices should
+normally be added to this variable using \fBlappend\fR.
 .TP
 \fBenv(TCL_LIBRARY)\fR
 If set, then it specifies the location of the directory containing
@@ -306,7 +310,7 @@ considered to be a word character.  On Windows platforms, words are
 comprised of any character that is not a space, tab, or newline.  Under
 Unix, words are comprised of numbers, letters or underscores.
 .SH "SEE ALSO"
-info(n), re_syntax(n), tclvars(n)
+env(n), info(n), re_syntax(n)
 .SH KEYWORDS
 auto-exec, auto-load, library, unknown, word, whitespace 
 '\"Local Variables:
diff --git a/doc/return.n b/doc/return.n
index b59a93d..a1abccf 100644
--- a/doc/return.n
+++ b/doc/return.n
@@ -317,8 +317,8 @@ proc myReturn {args} {
 }
 .CE
 .SH "SEE ALSO"
-break(n), catch(n), continue(n), dict(n), error(n), proc(n),
-source(n), tclvars(n), throw(n), try(n)
+break(n), catch(n), continue(n), dict(n), error(n), errorCode(n),
+errorInfo(n), proc(n), source(n), throw(n), try(n)
 .SH KEYWORDS
 break, catch, continue, error, exception, procedure, result, return
 .\" Local Variables:
diff --git a/doc/tclsh.1 b/doc/tclsh.1
index 8e7fb9e..dfc2635 100644
--- a/doc/tclsh.1
+++ b/doc/tclsh.1
@@ -102,7 +102,9 @@ but also the disadvantage of making it harder to write scripts that
 start up uniformly across different versions of Tcl.
 .SH "VARIABLES"
 .PP
-\fBTclsh\fR sets the following Tcl variables:
+\fBTclsh\fR sets the following global Tcl variables in addition to those
+created by the Tcl library itself (such as \fBenv\fR, which maps
+environment variables such as \fBPATH\fR into Tcl):
 .TP 15
 \fBargc\fR
 .
@@ -129,7 +131,7 @@ device), 0 otherwise.
 When \fBtclsh\fR is invoked interactively it normally prompts for each
 command with
 .QW "\fB% \fR" .
-You can change the prompt by setting the
+You can change the prompt by setting the global
 variables \fBtcl_prompt1\fR and \fBtcl_prompt2\fR.  If variable
 \fBtcl_prompt1\fR exists then it must consist of a Tcl script
 to output a prompt;  instead of outputting a prompt \fBtclsh\fR
@@ -142,6 +144,6 @@ incomplete commands.
 .PP
 See \fBTcl_StandardChannels\fR for more explanations.
 .SH "SEE ALSO"
-encoding(n), fconfigure(n), tclvars(n)
+auto_path(n), encoding(n), env(n), fconfigure(n)
 .SH KEYWORDS
 application, argument, interpreter, prompt, script file, shell
diff --git a/doc/throw.n b/doc/throw.n
index d49fb24..b28f2e4 100644
--- a/doc/throw.n
+++ b/doc/throw.n
@@ -40,7 +40,7 @@ The following produces an error that is identical to that produced by
 \fBthrow\fR {ARITH DIVZERO {divide by zero}} {divide by zero}
 .CE
 .SH "SEE ALSO"
-catch(n), error(n), return(n), tclvars(n), try(n)
+catch(n), error(n), errorCode(n), errorInfo(n), return(n), try(n)
 .SH "KEYWORDS"
 error, exception
 '\" Local Variables:
-- 
cgit v0.12