Optimizations and general bytecode generation improvements.

6 files changed, 564 insertions, 54 deletions

diff --git a/ChangeLog b/ChangeLog
index 6330666..bcd089d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,16 @@
+2013-05-10  Donal K. Fellows  <dkf@users.sf.net>
+
+	Optimizations and general bytecode generation improvements.
+	* generic/tclCompCmds.c (TclCompileAppendCmd, TclCompileLappendCmd):
+	(TclCompileReturnCmd): Make these generate bytecode in more cases.
+	(TclCompileListCmd): Make this able to push a literal when it can.
+	* generic/tclCompile.c (TclSetByteCodeFromAny, PeepholeOptimize):
+	Added checks to see if we can apply some simple cross-command-boundary
+	optimizations, and defined a small number of such optimizations.
+	(TclCompileScript): Added the special ability to compile the list
+	command with expansion ([list {*}blah]) into bytecode that does not
+	call an external command.
+
 2013-05-06  Jan Nijtmans  <nijtmans@users.sf.net>
 
 	* generic/tclStubInit.c: Add support for Cygwin64, which has a 64-bit
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 5786975..cd2ad13 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -20,7 +20,7 @@
  *-   break and continue - if exception ranges can be sorted out.
  *-   foreach_start4, foreach_step4
  *-   returnImm, returnStk
- *-   expandStart, expandStkTop, invokeExpanded
+ *-   expandStart, expandStkTop, invokeExpanded, listExpanded
  *-   dictFirst, dictNext, dictDone
  *-   dictUpdateStart, dictUpdateEnd
  *-   jumpTable testing
@@ -437,6 +437,7 @@ static const TalInstDesc TalInstructionTable[] = {
     {"lindexMulti",	ASSEM_LINDEX_MULTI,
 					INST_LIST_INDEX_MULTI,	INT_MIN,1},
     {"list",		ASSEM_LIST,	INST_LIST,		INT_MIN,1},
+    {"listConcat",	ASSEM_1BYTE,	INST_LIST_CONCAT,	2,	1},
     {"listIn",		ASSEM_1BYTE,	INST_LIST_IN,		2,	1},
     {"listIndex",	ASSEM_1BYTE,	INST_LIST_INDEX,	2,	1},
     {"listIndexImm",	ASSEM_INDEX,	INST_LIST_INDEX_IMM,	1,	1},
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index f6ca0e0..c2495bd 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -155,7 +155,7 @@ TclCompileAppendCmd(
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
     Tcl_Token *varTokenPtr, *valueTokenPtr;
-    int simpleVarName, isScalar, localIndex, numWords;
+    int simpleVarName, isScalar, localIndex, numWords, i;
     DefineLineInformation;	/* TIP #280 */
 
     numWords = parsePtr->numWords;
@@ -169,10 +169,11 @@ TclCompileAppendCmd(
 	return TclCompileSetCmd(interp, parsePtr, cmdPtr, envPtr);
     } else if (numWords > 3) {
 	/*
-	 * APPEND instructions currently only handle one value.
+	 * APPEND instructions currently only handle one value, but we can
+	 * handle some multi-value cases by stringing them together.
 	 */
 
-	return TCL_ERROR;
+	goto appendMultiple;
     }
 
     /*
@@ -222,6 +223,42 @@ TclCompileAppendCmd(
     }
 
     return TCL_OK;
+
+  appendMultiple:
+    /*
+     * Can only handle the case where we are appending to a local scalar when
+     * there are multiple values to append.  Fortunately, this is common.
+     */
+
+    if (envPtr->procPtr == NULL) {
+	return TCL_ERROR;
+    }
+    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_ELEMENT,
+	    &localIndex, &simpleVarName, &isScalar, 1);
+    if (!isScalar || localIndex < 0) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Definitely appending to a local scalar; generate the words and append
+     * them.
+     */
+
+    valueTokenPtr = TokenAfter(varTokenPtr);
+    for (i = 2 ; i < numWords ; i++) {
+	CompileWord(envPtr, valueTokenPtr, interp, i);
+	valueTokenPtr = TokenAfter(valueTokenPtr);
+    }
+    TclEmitInstInt4(	  INST_REVERSE, numWords-2,		envPtr);
+    for (i = 2 ; i < numWords ;) {
+	Emit14Inst(	  INST_APPEND_SCALAR, localIndex,	envPtr);
+	if (++i < numWords) {
+	    TclEmitOpcode(INST_POP,				envPtr);
+	}
+    }
+
+    return TCL_OK;
 }
 
 /*
@@ -4067,8 +4104,8 @@ TclCompileLappendCmd(
 				 * compiled. */
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
-    Tcl_Token *varTokenPtr;
-    int simpleVarName, isScalar, localIndex, numWords;
+    Tcl_Token *varTokenPtr, *valueTokenPtr;
+    int simpleVarName, isScalar, localIndex, numWords, i, fwd, offsetFwd;
     DefineLineInformation;	/* TIP #280 */
 
     /*
@@ -4085,10 +4122,11 @@ TclCompileLappendCmd(
     }
     if (numWords != 3) {
 	/*
-	 * LAPPEND instructions currently only handle one value appends.
+	 * LAPPEND instructions currently only handle one value, but we can
+	 * handle some multi-value cases by stringing them together.
 	 */
 
-	return TCL_ERROR;
+	goto lappendMultiple;
     }
 
     /*
@@ -4141,6 +4179,45 @@ TclCompileLappendCmd(
     }
 
     return TCL_OK;
+
+  lappendMultiple:
+    /*
+     * Can only handle the case where we are appending to a local scalar when
+     * there are multiple values to append.  Fortunately, this is common.
+     */
+
+    if (envPtr->procPtr == NULL) {
+	return TCL_ERROR;
+    }
+    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_ELEMENT,
+	    &localIndex, &simpleVarName, &isScalar, 1);
+    if (!isScalar || localIndex < 0) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Definitely appending to a local scalar; generate the words and append
+     * them.
+     */
+
+    valueTokenPtr = TokenAfter(varTokenPtr);
+    for (i = 2 ; i < numWords ; i++) {
+	CompileWord(envPtr, valueTokenPtr, interp, i);
+	valueTokenPtr = TokenAfter(valueTokenPtr);
+    }
+    TclEmitInstInt4(	  INST_LIST, numWords-2,		envPtr);
+    TclEmitInstInt4(	  INST_EXIST_SCALAR, localIndex,	envPtr);
+    offsetFwd = CurrentOffset(envPtr);
+    TclEmitInstInt1(	  INST_JUMP_FALSE1, 0,			envPtr);
+    Emit14Inst(		  INST_LOAD_SCALAR, localIndex,		envPtr);
+    TclEmitInstInt4(	  INST_REVERSE, 2,			envPtr);
+    TclEmitOpcode(	  INST_LIST_CONCAT,			envPtr);
+    fwd = CurrentOffset(envPtr) - offsetFwd;
+    TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1);
+    Emit14Inst(		  INST_STORE_SCALAR, localIndex,	envPtr);
+
+    return TCL_OK;
 }
 
 /*
@@ -4390,14 +4467,7 @@ TclCompileListCmd(
     DefineLineInformation;	/* TIP #280 */
     Tcl_Token *valueTokenPtr;
     int i, numWords;
-
-    /*
-     * If we're not in a procedure, don't compile.
-     */
-
-    if (envPtr->procPtr == NULL) {
-	return TCL_ERROR;
-    }
+    Tcl_Obj *listObj, *objPtr;
 
     if (parsePtr->numWords == 1) {
 	/*
@@ -4405,20 +4475,57 @@ TclCompileListCmd(
 	 */
 
 	PushLiteral(envPtr, "", 0);
-    } else {
-	/*
-	 * Push the all values onto the stack.
-	 */
+	return TCL_OK;
+    }
+
+    /*
+     * Test if all arguments are compile-time known. If they are, we can
+     * implement with a simple push.
+     */
+
+    numWords = parsePtr->numWords;
+    valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    listObj = Tcl_NewObj();
+    for (i = 1; i < numWords && listObj != NULL; i++) {
+	objPtr = Tcl_NewObj();
+	if (TclWordKnownAtCompileTime(valueTokenPtr, objPtr)) {
+	    (void) Tcl_ListObjAppendElement(NULL, listObj, objPtr);
+	} else {
+	    Tcl_DecrRefCount(objPtr);
+	    Tcl_DecrRefCount(listObj);
+	    listObj = NULL;
+	}
+	valueTokenPtr = TokenAfter(valueTokenPtr);
+    }
+    if (listObj != NULL) {
+	int len;
+	const char *bytes = Tcl_GetStringFromObj(listObj, &len);
 
-	numWords = parsePtr->numWords;
-	valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
-	for (i = 1; i < numWords; i++) {
-	    CompileWord(envPtr, valueTokenPtr, interp, i);
-	    valueTokenPtr = TokenAfter(valueTokenPtr);
+	PushLiteral(envPtr, bytes, len);
+	Tcl_DecrRefCount(listObj);
+	if (len > 0) {
+	    /*
+	     * Force list interpretation!
+	     */
+
+	    TclEmitOpcode(	INST_DUP,		envPtr);
+	    TclEmitOpcode(	INST_LIST_LENGTH,	envPtr);
+	    TclEmitOpcode(	INST_POP,		envPtr);
 	}
-	TclEmitInstInt4(	INST_LIST, numWords - 1,	envPtr);
+	return TCL_OK;
     }
 
+    /*
+     * Push the all values onto the stack.
+     */
+
+    numWords = parsePtr->numWords;
+    valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    for (i = 1; i < numWords; i++) {
+	CompileWord(envPtr, valueTokenPtr, interp, i);
+	valueTokenPtr = TokenAfter(valueTokenPtr);
+    }
+    TclEmitInstInt4(	INST_LIST, numWords - 1,	envPtr);
     return TCL_OK;
 }
 
@@ -5578,15 +5685,20 @@ TclCompileReturnCmd(
 	objv[objc] = Tcl_NewObj();
 	Tcl_IncrRefCount(objv[objc]);
 	if (!TclWordKnownAtCompileTime(wordTokenPtr, objv[objc])) {
-	    objc++;
-	    status = TCL_ERROR;
-	    goto cleanup;
+	    /*
+	     * Non-literal, so punt to run-time.
+	     */
+
+	    for (; objc>=0 ; objc--) {
+		TclDecrRefCount(objv[objc]);
+	    }
+	    TclStackFree(interp, objv);
+	    goto issueRuntimeReturn;
 	}
 	wordTokenPtr = TokenAfter(wordTokenPtr);
     }
     status = TclMergeReturnOptions(interp, objc, objv,
 	    &returnOpts, &code, &level);
-  cleanup:
     while (--objc >= 0) {
 	TclDecrRefCount(objv[objc]);
     }
@@ -5649,6 +5761,7 @@ TclCompileReturnCmd(
 
 	    Tcl_DecrRefCount(returnOpts);
 	    TclEmitOpcode(INST_DONE, envPtr);
+	    envPtr->currStackDepth = savedStackDepth;
 	    return TCL_OK;
 	}
     }
@@ -5666,6 +5779,37 @@ TclCompileReturnCmd(
      */
 
     CompileReturnInternal(envPtr, INST_RETURN_IMM, code, level, returnOpts);
+    envPtr->currStackDepth = savedStackDepth + 1;
+    return TCL_OK;
+
+  issueRuntimeReturn:
+    /*
+     * Assemble the option dictionary (as a list as that's good enough).
+     */
+
+    wordTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    for (objc=1 ; objc<=numOptionWords ; objc++) {
+	CompileWord(envPtr, wordTokenPtr, interp, objc);
+	wordTokenPtr = TokenAfter(wordTokenPtr);
+    }
+    TclEmitInstInt4(INST_LIST, numOptionWords, envPtr);
+
+    /*
+     * Push the result.
+     */
+
+    if (explicitResult) {
+	CompileWord(envPtr, wordTokenPtr, interp, numWords-1);
+    } else {
+	PushLiteral(envPtr, "", 0);
+    }
+
+    /*
+     * Issue the RETURN itself.
+     */
+
+    TclEmitOpcode(INST_RETURN_STK, envPtr);
+    envPtr->currStackDepth = savedStackDepth + 1;
     return TCL_OK;
 }
 
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 0e98385..7f6b7d4 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -14,6 +14,7 @@
 
 #include "tclInt.h"
 #include "tclCompile.h"
+#include <assert.h>
 
 /*
  * Table of all AuxData types.
@@ -50,7 +51,7 @@ static int traceInitialized = 0;
  * existence of a procedure call frame to distinguish these.
  */
 
-InstructionDesc const tclInstructionTable[] = {
+const InstructionDesc const tclInstructionTable[] = {
     /* Name	      Bytes stackEffect #Opnds  Operand types */
     {"done",		  1,   -1,         0,	{OPERAND_NONE}},
 	/* Finish ByteCode execution and return stktop (top stack item) */
@@ -279,12 +280,12 @@ InstructionDesc const tclInstructionTable[] = {
 	/* Binary exponentiation operator: push (stknext ** stktop) */
 
     /*
-     * NOTE: the stack effects of expandStkTop and invokeExpanded are wrong -
-     * but it cannot be done right at compile time, the stack effect is only
-     * known at run time. The value for invokeExpanded is estimated better at
-     * compile time.
+     * NOTE: the stack effects of expandStkTop, invokeExpanded and
+     * listExpanded are wrong - but it cannot be done right at compile time,
+     * the stack effect is only known at run time. The value for both
+     * invokeExpanded and listExpanded are estimated better at compile time.
      * See the comments further down in this file, where INST_INVOKE_EXPANDED
-     * is emitted.
+     * and INST_LIST_EXPANDED are emitted.
      */
     {"expandStart",       1,    0,          0,	{OPERAND_NONE}},
 	/* Start of command with {*} (expanded) arguments */
@@ -534,6 +535,13 @@ InstructionDesc const tclInstructionTable[] = {
 	 * the word at the top of the stack;
 	 * <objc,objv> = <op4,top op4 after popping 1> */
 
+    {"listConcat",	 1,	-1,	  0,	{OPERAND_NONE}},
+	/* Concatenates the two lists at the top of the stack into a single
+	 * list and pushes that resulting list onto the stack.
+	 * Stack: ... list1 list2 => ... [lconcat list1 list2] */
+    {"listExpanded",	 1,	0,	  0,	{OPERAND_NONE}},
+	/* Construct a list from the words marked by the last 'expandStart' */
+
     {NULL, 0, 0, 0, {OPERAND_NONE}}
 };
 
@@ -554,6 +562,9 @@ static void		EnterCmdStartData(CompileEnv *envPtr,
 static void		FreeByteCodeInternalRep(Tcl_Obj *objPtr);
 static void		FreeSubstCodeInternalRep(Tcl_Obj *objPtr);
 static int		GetCmdLocEncodingSize(CompileEnv *envPtr);
+static int		IsCompactibleCompileEnv(Tcl_Interp *interp,
+			    CompileEnv *envPtr);
+static void		PeepholeOptimize(CompileEnv *envPtr);
 #ifdef TCL_COMPILE_STATS
 static void		RecordByteCodeStats(ByteCode *codePtr);
 #endif /* TCL_COMPILE_STATS */
@@ -654,6 +665,7 @@ TclSetByteCodeFromAny(
 				 * in frame. */
     int length, result = TCL_OK;
     const char *stringPtr;
+    Proc *procPtr = iPtr->compiledProcPtr;
     ContLineLoc *clLocPtr;
 
 #ifdef TCL_COMPILE_DEBUG
@@ -705,6 +717,38 @@ TclSetByteCodeFromAny(
     TclEmitOpcode(INST_DONE, &compEnv);
 
     /*
+     * Check for optimizations!
+     *
+     * Test if the generated code is free of most hazards; if so, recompile
+     * but with generation of INST_START_CMD disabled. This produces somewhat
+     * faster code in some cases, and more compact code in more.
+     */
+
+    if (Tcl_GetMaster(interp) == NULL &&
+	    !Tcl_LimitTypeEnabled(interp, TCL_LIMIT_COMMANDS|TCL_LIMIT_TIME)
+	    && IsCompactibleCompileEnv(interp, &compEnv)) {
+	TclFreeCompileEnv(&compEnv);
+	iPtr->compiledProcPtr = procPtr;
+	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.atCmdStart = 2;		/* The disabling magic. */
+	TclCompileScript(interp, stringPtr, length, &compEnv);
+	TclEmitOpcode(INST_DONE, &compEnv);
+    }
+
+    /*
+     * Apply some peephole optimizations that can cross specific/generic
+     * instruction generator boundaries.
+     */
+
+    PeepholeOptimize(&compEnv);
+
+    /*
      * Invoke the compilation hook procedure if one exists.
      */
 
@@ -973,6 +1017,202 @@ TclCleanupByteCode(
 }
 
 /*
+ * ---------------------------------------------------------------------
+ *
+ * IsCompactibleCompileEnv --
+ *
+ *	Checks to see if we may apply some basic compaction optimizations to a
+ *	piece of bytecode. Idempotent.
+ *
+ * ---------------------------------------------------------------------
+ */
+
+static int
+IsCompactibleCompileEnv(
+    Tcl_Interp *interp,
+    CompileEnv *envPtr)
+{
+    unsigned char *pc;
+    int size;
+
+    /*
+     * Special: procedures in the '::tcl' namespace (or its children) are
+     * considered to be well-behaved and so can have compaction applied even
+     * if it would otherwise be invalid.
+     */
+
+    if (envPtr->procPtr != NULL && envPtr->procPtr->cmdPtr != NULL
+	    && envPtr->procPtr->cmdPtr->nsPtr != NULL) {
+	Namespace *nsPtr = envPtr->procPtr->cmdPtr->nsPtr;
+
+	if (strcmp(nsPtr->fullName, "::tcl") == 0
+		|| strncmp(nsPtr->fullName, "::tcl::", 7) == 0) {
+	    return 1;
+	}
+    }
+
+    /*
+     * Go through and ensure that no operation involved can cause a desired
+     * change of bytecode sequence during running. This comes down to ensuring
+     * that there are no mapped variables (due to traces) or calls to external
+     * commands (traces, [uplevel] trickery). This is actually a very
+     * conservative check; it turns down a lot of code that is OK in practice.
+     */
+
+    for (pc = envPtr->codeStart ; pc < envPtr->codeNext ; pc += size) {
+	switch (*pc) {
+	    /* Invokes */
+	case INST_INVOKE_STK1:
+	case INST_INVOKE_STK4:
+	case INST_INVOKE_EXPANDED:
+	case INST_INVOKE_REPLACE:
+	    return 0;
+	    /* Runtime evals */
+	case INST_EVAL_STK:
+	case INST_EXPR_STK:
+	case INST_YIELD:
+	    return 0;
+	    /* Upvars */
+	case INST_UPVAR:
+	case INST_NSUPVAR:
+	case INST_VARIABLE:
+	    return 0;
+	}
+	size = tclInstructionTable[*pc].numBytes;
+	assert (size > 0);
+    }
+
+    return 1;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * PeepholeOptimize --
+ *
+ *	A very simple peephole optimizer for bytecode.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+PeepholeOptimize(
+    CompileEnv *envPtr)
+{
+    unsigned char *pc, *prev1 = NULL, *prev2 = NULL, *target;
+    int size, isNew;
+    Tcl_HashTable targets;
+    Tcl_HashEntry *hPtr;
+    Tcl_HashSearch hSearch;
+
+    /*
+     * Find places where we should be careful about replacing instructions
+     * because they are the targets of various types of jumps.
+     */
+
+    Tcl_InitHashTable(&targets, TCL_ONE_WORD_KEYS);
+    for (pc = envPtr->codeStart ; pc < envPtr->codeNext ; pc += size) {
+	size = tclInstructionTable[*pc].numBytes;
+	switch (*pc) {
+	case INST_JUMP1:
+	case INST_JUMP_TRUE1:
+	case INST_JUMP_FALSE1:
+	    target = pc + TclGetInt1AtPtr(pc+1);
+	    goto storeTarget;
+	case INST_JUMP4:
+	case INST_JUMP_TRUE4:
+	case INST_JUMP_FALSE4:
+	    target = pc + TclGetInt4AtPtr(pc+1);
+	    goto storeTarget;
+	case INST_BEGIN_CATCH4:
+	    target = envPtr->codeStart + envPtr->exceptArrayPtr[
+		    TclGetUInt4AtPtr(pc+1)].codeOffset;
+	storeTarget:
+	    (void) Tcl_CreateHashEntry(&targets, (void *) target, &isNew);
+	    break;
+	case INST_JUMP_TABLE:
+	    hPtr = Tcl_FirstHashEntry(
+		    &JUMPTABLEINFO(envPtr, pc+1)->hashTable, &hSearch);
+	    for (; hPtr ; hPtr = Tcl_NextHashEntry(&hSearch)) {
+		target = pc + (int) Tcl_GetHashValue(hPtr);
+		(void) Tcl_CreateHashEntry(&targets, (void *) target, &isNew);
+	    }
+	    break;
+	}
+    }
+
+    /*
+     * Replace PUSH/POP sequences (when non-hazardous) with NOPs.
+     */
+
+    (void) Tcl_CreateHashEntry(&targets, (void *) pc, &isNew);
+    for (pc = envPtr->codeStart ; pc < envPtr->codeNext ; pc += size) {
+	int blank = 0, i;
+
+	size = tclInstructionTable[*pc].numBytes;
+	prev2 = prev1;
+	prev1 = pc;
+	if (Tcl_FindHashEntry(&targets, (void *) (pc + size))) {
+	    continue;
+	}
+	switch (*pc) {
+	case INST_PUSH1:
+	    while (*(pc+size) == INST_NOP) {
+		size++;
+	    }
+	    if (*(pc+size) == INST_POP) {
+		blank = size + 1;
+	    } else if (*(pc+size) == INST_CONCAT1
+		    && TclGetUInt1AtPtr(pc + size + 1) == 2) {
+		Tcl_Obj *litPtr = TclFetchLiteral(envPtr,
+			TclGetUInt1AtPtr(pc + 1));
+		int numBytes;
+
+		(void) Tcl_GetStringFromObj(litPtr, &numBytes);
+		if (numBytes == 0) {
+		    blank = size + 2;
+		}
+	    }
+	    break;
+	case INST_PUSH4:
+	    while (*(pc+size) == INST_NOP) {
+		size++;
+	    }
+	    if (*(pc+size) == INST_POP) {
+		blank = size + 1;
+	    } else if (*(pc+size) == INST_CONCAT1
+		    && TclGetUInt1AtPtr(pc + size + 1) == 2) {
+		Tcl_Obj *litPtr = TclFetchLiteral(envPtr,
+			TclGetUInt4AtPtr(pc + 1));
+		int numBytes;
+
+		(void) Tcl_GetStringFromObj(litPtr, &numBytes);
+		if (numBytes == 0) {
+		    blank = size + 2;
+		}
+	    }
+	    break;
+	}
+	if (blank > 0) {
+	    for (i=0 ; i<blank ; i++) {
+		*(pc + i) = INST_NOP;
+	    }
+	    size = blank;
+	}
+    }
+
+    /*
+     * Trim a trailing double DONE.
+     */
+
+    if (prev1 && prev2 && *prev1 == INST_DONE && *prev2 == INST_DONE
+	    && !Tcl_FindHashEntry(&targets, (void *) prev1)) {
+	envPtr->codeNext--;
+    }
+    Tcl_DeleteHashTable(&targets);
+}
+
+/*
  *----------------------------------------------------------------------
  *
  * Tcl_SubstObj --
@@ -1194,6 +1434,8 @@ TclInitCompileEnv(
 {
     Interp *iPtr = (Interp *) interp;
 
+    assert(tclInstructionTable[LAST_INST_OPCODE+1].name == NULL);
+
     envPtr->iPtr = iPtr;
     envPtr->source = stringPtr;
     envPtr->numSrcBytes = numBytes;
@@ -1637,6 +1879,13 @@ TclCompileScript(
 	if (parsePtr->numWords > 0) {
 	    int expand = 0;	/* Set if there are dynamic expansions to
 				 * handle */
+	    int expandIgnoredWords = 0;
+				/* The number of *apparent* words that we are
+				 * generating code from directly during
+				 * expansion processing. For [list {*}blah]
+				 * expansion, we set this to one because we
+				 * ignore the first word and generate code
+				 * directly. */
 
 	    /*
 	     * If not the first command, pop the previous command's result
@@ -1689,7 +1938,7 @@ TclCompileScript(
 		    wordIdx < parsePtr->numWords;
 		    wordIdx++, tokenPtr += tokenPtr->numComponents + 1) {
 		if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
-		    expand = 1;
+		    expand = INST_INVOKE_EXPANDED;
 		    break;
 		}
 	    }
@@ -1802,7 +2051,7 @@ TclCompileScript(
 			 * command.
 			 */
 
-			if (envPtr->atCmdStart) {
+			if (envPtr->atCmdStart == 1) {
 			    if (savedCodeNext != 0) {
 				/*
 				 * Increase the number of commands being
@@ -1816,7 +2065,7 @@ TclCompileScript(
 				TclStoreInt4AtPtr(TclGetUInt4AtPtr(fixPtr)+1,
 					fixPtr);
 			    }
-			} else {
+			} else if (envPtr->atCmdStart == 0) {
 			    TclEmitInstInt4(INST_START_CMD, 0, envPtr);
 			    TclEmitInt4(1, envPtr);
 			    update = 1;
@@ -1860,7 +2109,7 @@ TclCompileScript(
 			    goto finishCommand;
 			}
 
-			if (envPtr->atCmdStart && savedCodeNext != 0) {
+			if (envPtr->atCmdStart == 1 && savedCodeNext != 0) {
 			    /*
 			     * Decrease the number of commands being started
 			     * at the current point. Note that this depends on
@@ -1899,6 +2148,26 @@ TclCompileScript(
 				TclFetchLiteral(envPtr, objIndex), cmdPtr);
 		    }
 		} else {
+		    if (wordIdx == 0 && expand) {
+			TclDStringClear(&ds);
+			TclDStringAppendToken(&ds, &tokenPtr[1]);
+			cmdPtr = (Command *) Tcl_FindCommand(interp,
+				Tcl_DStringValue(&ds),
+				(Tcl_Namespace *) cmdNsPtr, /*flags*/ 0);
+			if ((cmdPtr != NULL) &&
+				(cmdPtr->compileProc == TclCompileListCmd)) {
+			    /*
+			     * Special case! [list] command can be expanded
+			     * directly provided the first word is not the
+			     * expanded one.
+			     */
+
+			    expand = INST_LIST_EXPANDED;
+			    expandIgnoredWords = 1;
+			    continue;
+			}
+		    }
+
 		    /*
 		     * Simple argument word of a command. We reach this if and
 		     * only if the command word was not compiled for whatever
@@ -1941,10 +2210,13 @@ TclCompileScript(
 		 * Note that the estimates are not correct while the command
 		 * is being prepared and run, INST_EXPAND_STKTOP is not
 		 * stack-neutral in general.
+		 *
+		 * The opcodes that may be issued here (both assumed to be
+		 * non-zero) are INST_INVOKE_EXPANDED and INST_LIST_EXPANDED.
 		 */
 
-		TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr);
-		TclAdjustStackDepth((1-wordIdx), envPtr);
+		TclEmitOpcode(expand, envPtr);
+		TclAdjustStackDepth(1 + expandIgnoredWords - wordIdx, envPtr);
 	    } else if (wordIdx > 0) {
 		/*
 		 * Save PC -> command map for the TclArgumentBC* functions.
@@ -3692,7 +3964,7 @@ TclInitAuxDataTypeTable(void)
     Tcl_InitHashTable(&auxDataTypeTable, TCL_STRING_KEYS);
 
     /*
-     * There are only two AuxData type at this time, so register them here.
+     * There are only three AuxData types at this time, so register them here.
      */
 
     RegisterAuxDataType(&tclForeachInfoType);
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 79497d2..c68d3ec 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -309,7 +309,9 @@ typedef struct CompileEnv {
     int atCmdStart;		/* Flag to say whether an INST_START_CMD
 				 * should be issued; they should never be
 				 * issued repeatedly, as that is significantly
-				 * inefficient. */
+				 * inefficient. If set to 2, that instruction
+				 * should not be issued at all (by the generic
+				 * part of the command compiler). */
     ContLineLoc *clLoc;		/* If not NULL, the table holding the
 				 * locations of the invisible continuation
 				 * lines in the input script, to adjust the
@@ -713,8 +715,11 @@ typedef struct ByteCode {
 
 #define INST_INVOKE_REPLACE		163
 
+#define INST_LIST_CONCAT		164
+#define INST_LIST_EXPANDED		165
+
 /* The last opcode */
-#define LAST_INST_OPCODE		163
+#define LAST_INST_OPCODE		165
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for displaying
@@ -848,6 +853,9 @@ typedef struct ForeachInfo {
 
 MODULE_SCOPE const AuxDataType tclForeachInfoType;
 
+#define FOREACHINFO(envPtr, index) \
+    ((ForeachInfo*)((envPtr)->auxDataArrayPtr[TclGetUInt4AtPtr(index)].clientData))
+
 /*
  * Structure used to hold information about a switch command that is needed
  * during program execution. These structures are stored in CompileEnv and
@@ -861,6 +869,9 @@ typedef struct JumptableInfo {
 
 MODULE_SCOPE const AuxDataType tclJumptableInfoType;
 
+#define JUMPTABLEINFO(envPtr, index) \
+    ((JumptableInfo*)((envPtr)->auxDataArrayPtr[TclGetUInt4AtPtr(index)].clientData))
+
 /*
  * Structure used to hold information about a [dict update] command that is
  * needed during program execution. These structures are stored in CompileEnv
@@ -879,6 +890,9 @@ typedef struct {
 
 MODULE_SCOPE const AuxDataType tclDictUpdateInfoType;
 
+#define DICTUPDATEINFO(envPtr, index) \
+    ((DictUpdateInfo*)((envPtr)->auxDataArrayPtr[TclGetUInt4AtPtr(index)].clientData))
+
 /*
  * ClientData type used by the math operator commands.
  */
@@ -1090,6 +1104,18 @@ MODULE_SCOPE Tcl_Obj	*TclNewInstNameObj(unsigned char inst);
     } while (0)
 
 /*
+ * Macros used to update the flag that indicates if we are at the start of a
+ * command, based on whether the opcode is INST_START_COMMAND.
+ *
+ * void TclUpdateAtCmdStart(unsigned char op, CompileEnv *envPtr);
+ */
+
+#define TclUpdateAtCmdStart(op, envPtr) \
+    if ((envPtr)->atCmdStart < 2) {				     \
+	(envPtr)->atCmdStart = ((op) == INST_START_CMD ? 1 : 0);     \
+    }
+
+/*
  * Macro to emit an opcode byte into a CompileEnv's code array. The ANSI C
  * "prototype" for this macro is:
  *
@@ -1102,7 +1128,7 @@ MODULE_SCOPE Tcl_Obj	*TclNewInstNameObj(unsigned char inst);
 	    TclExpandCodeArray(envPtr);				\
 	}							\
 	*(envPtr)->codeNext++ = (unsigned char) (op);		\
-	(envPtr)->atCmdStart = ((op) == INST_START_CMD);	\
+	TclUpdateAtCmdStart(op, envPtr);			\
 	TclUpdateStackReqs(op, 0, envPtr);			\
     } while (0)
 
@@ -1154,7 +1180,7 @@ MODULE_SCOPE Tcl_Obj	*TclNewInstNameObj(unsigned char inst);
 	}								\
 	*(envPtr)->codeNext++ = (unsigned char) (op);			\
 	*(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i));	\
-	(envPtr)->atCmdStart = ((op) == INST_START_CMD);		\
+	TclUpdateAtCmdStart(op, envPtr);				\
 	TclUpdateStackReqs(op, i, envPtr);				\
     } while (0)
 
@@ -1172,7 +1198,7 @@ MODULE_SCOPE Tcl_Obj	*TclNewInstNameObj(unsigned char inst);
 		(unsigned char) ((unsigned int) (i) >>  8);	\
 	*(envPtr)->codeNext++ =					\
 		(unsigned char) ((unsigned int) (i)      );	\
-	(envPtr)->atCmdStart = ((op) == INST_START_CMD);	\
+	TclUpdateAtCmdStart(op, envPtr);			\
 	TclUpdateStackReqs(op, i, envPtr);			\
     } while (0)
 
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 029f402..f994ba5 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -2338,6 +2338,14 @@ TEBCresume(
 	}
 	inst = *(pc += 9);
 	goto peepholeStart;
+    } else if (inst == INST_NOP) {
+#ifndef TCL_COMPILE_DEBUG
+	while (inst == INST_NOP)
+#endif
+	{
+	    inst = *++pc;
+	}
+	goto peepholeStart;
     }
     
     switch (inst) {
@@ -2369,14 +2377,28 @@ TEBCresume(
 	TRACE(("=> "));
 	objResultPtr = POP_OBJECT();
 	result = Tcl_SetReturnOptions(interp, OBJ_AT_TOS);
-	Tcl_DecrRefCount(OBJ_AT_TOS);
-	OBJ_AT_TOS = objResultPtr;
 	if (result == TCL_OK) {
+	    Tcl_DecrRefCount(OBJ_AT_TOS);
+	    OBJ_AT_TOS = objResultPtr;
 	    TRACE_APPEND(("continuing to next instruction (result=\"%.30s\")",
 		    O2S(objResultPtr)));
 	    NEXT_INST_F(1, 0, 0);
+	} else if (result == TCL_ERROR) {
+	    /*
+	     * BEWARE! Must do this in this order, because an error in the
+	     * option dictionary overrides the result (and can be verified by
+	     * test).
+	     */
+
+	    Tcl_SetObjResult(interp, objResultPtr);
+	    Tcl_SetReturnOptions(interp, OBJ_AT_TOS);
+	    Tcl_DecrRefCount(OBJ_AT_TOS);
+	    OBJ_AT_TOS = objResultPtr;
+	} else {
+	    Tcl_DecrRefCount(OBJ_AT_TOS);
+	    OBJ_AT_TOS = objResultPtr;
+	    Tcl_SetObjResult(interp, objResultPtr);
 	}
-	Tcl_SetObjResult(interp, objResultPtr);
 	cleanup = 1;
 	goto processExceptionReturn;
 
@@ -2501,9 +2523,6 @@ TEBCresume(
 	TclDecrRefCount(objPtr);
 	NEXT_INST_F(1, 0, 0);
 
-    case INST_NOP:
-	NEXT_INST_F(1, 0, 0);
-
     case INST_DUP:
 	objResultPtr = OBJ_AT_TOS;
 	TRACE_WITH_OBJ(("=> "), objResultPtr);
@@ -4418,6 +4437,18 @@ TEBCresume(
 	TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
 	NEXT_INST_V(5, opnd, 1);
 
+    case INST_LIST_EXPANDED:
+	CLANG_ASSERT(auxObjList);
+	objc = CURR_DEPTH - auxObjList->internalRep.ptrAndLongRep.value;
+	POP_TAUX_OBJ();
+	objResultPtr = Tcl_NewListObj(objc, &OBJ_AT_DEPTH(objc-1));
+	TRACE_WITH_OBJ(("(%u) => ", objc), objResultPtr);
+	while (objc--) {
+	    valuePtr = POP_OBJECT();
+	    TclDecrRefCount(valuePtr);
+	}
+	NEXT_INST_F(1, 0, 1);
+
     case INST_LIST_LENGTH:
 	valuePtr = OBJ_AT_TOS;
 	if (TclListObjLength(interp, valuePtr, &length) != TCL_OK) {
@@ -4763,6 +4794,29 @@ TEBCresume(
 	objResultPtr = TCONST(match);
 	NEXT_INST_F(0, 2, 1);
 
+    case INST_LIST_CONCAT:
+	value2Ptr = OBJ_AT_TOS;
+	valuePtr = OBJ_UNDER_TOS;
+	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
+	if (Tcl_IsShared(valuePtr)) {
+	    objResultPtr = Tcl_DuplicateObj(valuePtr);
+	    if (Tcl_ListObjAppendList(interp, objResultPtr,
+		    value2Ptr) != TCL_OK) {
+		TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+		TclDecrRefCount(objResultPtr);
+		goto gotError;
+	    }
+	    TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
+	    NEXT_INST_F(1, 2, 1);
+	} else {
+	    if (Tcl_ListObjAppendList(interp, valuePtr, value2Ptr) != TCL_OK){
+		TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+		goto gotError;
+	    }
+	    TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr)));
+	    NEXT_INST_F(1, 1, 0);
+	}
+
     /*
      *	   End of INST_LIST and related instructions.
      * -----------------------------------------------------------------