merge trunk

7 files changed, 196 insertions, 151 deletions

diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index cd2ad13..fff7b43 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, listExpanded
+ *-   expandStart, expandStkTop, invokeExpanded
  *-   dictFirst, dictNext, dictDone
  *-   dictUpdateStart, dictUpdateEnd
  *-   jumpTable testing
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 5bb2352..57dc0f5 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -171,11 +171,16 @@ typedef struct {
     Tcl_ObjCmdProc *objProc;	/* Object-based function for command. */
     CompileProc *compileProc;	/* Function called to compile command. */
     Tcl_ObjCmdProc *nreProc;	/* NR-based function for command */
-    int isSafe;			/* If non-zero, command will be present in
-				 * safe interpreter. Otherwise it will be
-				 * hidden. */
+    int flags;			/* Various flag bits, as defined below. */
 } CmdInfo;
 
+#define CMD_IS_SAFE         1   /* Whether this command is part of the set of
+                                 * commands present by default in a safe
+                                 * interpreter. */
+/* CMD_COMPILES_EXPANDED - Whether the compiler for this command can handle
+ * expansion for itself rather than needing the generic layer to take care of
+ * it for it. Defined in tclInt.h. */
+
 /*
  * The built-in commands, and the functions that implement them:
  */
@@ -185,92 +190,92 @@ static const CmdInfo builtInCmds[] = {
      * Commands in the generic core.
      */
 
-    {"append",		Tcl_AppendObjCmd,	TclCompileAppendCmd,	NULL,	1},
-    {"apply",		Tcl_ApplyObjCmd,	NULL,			TclNRApplyObjCmd,	1},
-    {"break",		Tcl_BreakObjCmd,	TclCompileBreakCmd,	NULL,	1},
-    {"catch",		Tcl_CatchObjCmd,	TclCompileCatchCmd,	TclNRCatchObjCmd,	1},
-    {"concat",		Tcl_ConcatObjCmd,	NULL,			NULL,	1},
-    {"continue",	Tcl_ContinueObjCmd,	TclCompileContinueCmd,	NULL,	1},
-    {"coroutine",	NULL,			NULL,			TclNRCoroutineObjCmd,	1},
-    {"error",		Tcl_ErrorObjCmd,	TclCompileErrorCmd,	NULL,	1},
-    {"eval",		Tcl_EvalObjCmd,		NULL,			TclNREvalObjCmd,	1},
-    {"expr",		Tcl_ExprObjCmd,		TclCompileExprCmd,	TclNRExprObjCmd,	1},
-    {"for",		Tcl_ForObjCmd,		TclCompileForCmd,	TclNRForObjCmd,	1},
-    {"foreach",		Tcl_ForeachObjCmd,	TclCompileForeachCmd,	TclNRForeachCmd,	1},
-    {"format",		Tcl_FormatObjCmd,	TclCompileFormatCmd,	NULL,	1},
-    {"global",		Tcl_GlobalObjCmd,	TclCompileGlobalCmd,	NULL,	1},
-    {"if",		Tcl_IfObjCmd,		TclCompileIfCmd,	TclNRIfObjCmd,	1},
-    {"incr",		Tcl_IncrObjCmd,		TclCompileIncrCmd,	NULL,	1},
-    {"join",		Tcl_JoinObjCmd,		NULL,			NULL,	1},
-    {"lappend",		Tcl_LappendObjCmd,	TclCompileLappendCmd,	NULL,	1},
-    {"lassign",		Tcl_LassignObjCmd,	TclCompileLassignCmd,	NULL,	1},
-    {"lindex",		Tcl_LindexObjCmd,	TclCompileLindexCmd,	NULL,	1},
-    {"linsert",		Tcl_LinsertObjCmd,	NULL,			NULL,	1},
-    {"list",		Tcl_ListObjCmd,		TclCompileListCmd,	NULL,	1},
-    {"llength",		Tcl_LlengthObjCmd,	TclCompileLlengthCmd,	NULL,	1},
-    {"lmap",		Tcl_LmapObjCmd,		TclCompileLmapCmd,	TclNRLmapCmd,	1},
-    {"lrange",		Tcl_LrangeObjCmd,	TclCompileLrangeCmd,	NULL,	1},
-    {"lrepeat",		Tcl_LrepeatObjCmd,	NULL,			NULL,	1},
-    {"lreplace",	Tcl_LreplaceObjCmd,	TclCompileLreplaceCmd,	NULL,	1},
-    {"lreverse",	Tcl_LreverseObjCmd,	NULL,			NULL,	1},
-    {"lsearch",		Tcl_LsearchObjCmd,	NULL,			NULL,	1},
-    {"lset",		Tcl_LsetObjCmd,		TclCompileLsetCmd,	NULL,	1},
-    {"lsort",		Tcl_LsortObjCmd,	NULL,			NULL,	1},
-    {"package",		Tcl_PackageObjCmd,	NULL,			NULL,	1},
-    {"proc",		Tcl_ProcObjCmd,		NULL,			NULL,	1},
-    {"regexp",		Tcl_RegexpObjCmd,	TclCompileRegexpCmd,	NULL,	1},
-    {"regsub",		Tcl_RegsubObjCmd,	TclCompileRegsubCmd,	NULL,	1},
-    {"rename",		Tcl_RenameObjCmd,	NULL,			NULL,	1},
-    {"return",		Tcl_ReturnObjCmd,	TclCompileReturnCmd,	NULL,	1},
-    {"scan",		Tcl_ScanObjCmd,		NULL,			NULL,	1},
-    {"set",		Tcl_SetObjCmd,		TclCompileSetCmd,	NULL,	1},
-    {"split",		Tcl_SplitObjCmd,	NULL,			NULL,	1},
-    {"subst",		Tcl_SubstObjCmd,	TclCompileSubstCmd,	TclNRSubstObjCmd,	1},
-    {"switch",		Tcl_SwitchObjCmd,	TclCompileSwitchCmd,	TclNRSwitchObjCmd, 1},
-    {"tailcall",	NULL,			TclCompileTailcallCmd,	TclNRTailcallObjCmd,	1},
-    {"throw",		Tcl_ThrowObjCmd,	TclCompileThrowCmd,	NULL,	1},
-    {"trace",		Tcl_TraceObjCmd,	NULL,			NULL,	1},
-    {"try",		Tcl_TryObjCmd,		TclCompileTryCmd,	TclNRTryObjCmd,	1},
-    {"unset",		Tcl_UnsetObjCmd,	TclCompileUnsetCmd,	NULL,	1},
-    {"uplevel",		Tcl_UplevelObjCmd,	NULL,			TclNRUplevelObjCmd,	1},
-    {"upvar",		Tcl_UpvarObjCmd,	TclCompileUpvarCmd,	NULL,	1},
-    {"variable",	Tcl_VariableObjCmd,	TclCompileVariableCmd,	NULL,	1},
-    {"while",		Tcl_WhileObjCmd,	TclCompileWhileCmd,	TclNRWhileObjCmd,	1},
-    {"yield",		NULL,			TclCompileYieldCmd,	TclNRYieldObjCmd,	1},
-    {"yieldto",		NULL,			NULL,			TclNRYieldToObjCmd,	1},
+    {"append",		Tcl_AppendObjCmd,	TclCompileAppendCmd,	NULL,	CMD_IS_SAFE},
+    {"apply",		Tcl_ApplyObjCmd,	NULL,			TclNRApplyObjCmd,	CMD_IS_SAFE},
+    {"break",		Tcl_BreakObjCmd,	TclCompileBreakCmd,	NULL,	CMD_IS_SAFE},
+    {"catch",		Tcl_CatchObjCmd,	TclCompileCatchCmd,	TclNRCatchObjCmd,	CMD_IS_SAFE},
+    {"concat",		Tcl_ConcatObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
+    {"continue",	Tcl_ContinueObjCmd,	TclCompileContinueCmd,	NULL,	CMD_IS_SAFE},
+    {"coroutine",	NULL,			NULL,			TclNRCoroutineObjCmd,	CMD_IS_SAFE},
+    {"error",		Tcl_ErrorObjCmd,	TclCompileErrorCmd,	NULL,	CMD_IS_SAFE},
+    {"eval",		Tcl_EvalObjCmd,		NULL,			TclNREvalObjCmd,	CMD_IS_SAFE},
+    {"expr",		Tcl_ExprObjCmd,		TclCompileExprCmd,	TclNRExprObjCmd,	CMD_IS_SAFE},
+    {"for",		Tcl_ForObjCmd,		TclCompileForCmd,	TclNRForObjCmd,	CMD_IS_SAFE},
+    {"foreach",		Tcl_ForeachObjCmd,	TclCompileForeachCmd,	TclNRForeachCmd,	CMD_IS_SAFE},
+    {"format",		Tcl_FormatObjCmd,	TclCompileFormatCmd,	NULL,	CMD_IS_SAFE},
+    {"global",		Tcl_GlobalObjCmd,	TclCompileGlobalCmd,	NULL,	CMD_IS_SAFE},
+    {"if",		Tcl_IfObjCmd,		TclCompileIfCmd,	TclNRIfObjCmd,	CMD_IS_SAFE},
+    {"incr",		Tcl_IncrObjCmd,		TclCompileIncrCmd,	NULL,	CMD_IS_SAFE},
+    {"join",		Tcl_JoinObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
+    {"lappend",		Tcl_LappendObjCmd,	TclCompileLappendCmd,	NULL,	CMD_IS_SAFE},
+    {"lassign",		Tcl_LassignObjCmd,	TclCompileLassignCmd,	NULL,	CMD_IS_SAFE},
+    {"lindex",		Tcl_LindexObjCmd,	TclCompileLindexCmd,	NULL,	CMD_IS_SAFE},
+    {"linsert",		Tcl_LinsertObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
+    {"list",		Tcl_ListObjCmd,		TclCompileListCmd,	NULL,	CMD_IS_SAFE|CMD_COMPILES_EXPANDED},
+    {"llength",		Tcl_LlengthObjCmd,	TclCompileLlengthCmd,	NULL,	CMD_IS_SAFE},
+    {"lmap",		Tcl_LmapObjCmd,		TclCompileLmapCmd,	TclNRLmapCmd,	CMD_IS_SAFE},
+    {"lrange",		Tcl_LrangeObjCmd,	TclCompileLrangeCmd,	NULL,	CMD_IS_SAFE},
+    {"lrepeat",		Tcl_LrepeatObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
+    {"lreplace",	Tcl_LreplaceObjCmd,	TclCompileLreplaceCmd,	NULL,	CMD_IS_SAFE},
+    {"lreverse",	Tcl_LreverseObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
+    {"lsearch",		Tcl_LsearchObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
+    {"lset",		Tcl_LsetObjCmd,		TclCompileLsetCmd,	NULL,	CMD_IS_SAFE},
+    {"lsort",		Tcl_LsortObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
+    {"package",		Tcl_PackageObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
+    {"proc",		Tcl_ProcObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
+    {"regexp",		Tcl_RegexpObjCmd,	TclCompileRegexpCmd,	NULL,	CMD_IS_SAFE},
+    {"regsub",		Tcl_RegsubObjCmd,	TclCompileRegsubCmd,	NULL,	CMD_IS_SAFE},
+    {"rename",		Tcl_RenameObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
+    {"return",		Tcl_ReturnObjCmd,	TclCompileReturnCmd,	NULL,	CMD_IS_SAFE},
+    {"scan",		Tcl_ScanObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
+    {"set",		Tcl_SetObjCmd,		TclCompileSetCmd,	NULL,	CMD_IS_SAFE},
+    {"split",		Tcl_SplitObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
+    {"subst",		Tcl_SubstObjCmd,	TclCompileSubstCmd,	TclNRSubstObjCmd,	CMD_IS_SAFE},
+    {"switch",		Tcl_SwitchObjCmd,	TclCompileSwitchCmd,	TclNRSwitchObjCmd, CMD_IS_SAFE},
+    {"tailcall",	NULL,			TclCompileTailcallCmd,	TclNRTailcallObjCmd,	CMD_IS_SAFE},
+    {"throw",		Tcl_ThrowObjCmd,	TclCompileThrowCmd,	NULL,	CMD_IS_SAFE},
+    {"trace",		Tcl_TraceObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
+    {"try",		Tcl_TryObjCmd,		TclCompileTryCmd,	TclNRTryObjCmd,	CMD_IS_SAFE},
+    {"unset",		Tcl_UnsetObjCmd,	TclCompileUnsetCmd,	NULL,	CMD_IS_SAFE},
+    {"uplevel",		Tcl_UplevelObjCmd,	NULL,			TclNRUplevelObjCmd,	CMD_IS_SAFE},
+    {"upvar",		Tcl_UpvarObjCmd,	TclCompileUpvarCmd,	NULL,	CMD_IS_SAFE},
+    {"variable",	Tcl_VariableObjCmd,	TclCompileVariableCmd,	NULL,	CMD_IS_SAFE},
+    {"while",		Tcl_WhileObjCmd,	TclCompileWhileCmd,	TclNRWhileObjCmd,	CMD_IS_SAFE},
+    {"yield",		NULL,			TclCompileYieldCmd,	TclNRYieldObjCmd,	CMD_IS_SAFE},
+    {"yieldto",		NULL,			NULL,			TclNRYieldToObjCmd,	CMD_IS_SAFE},
 
     /*
      * Commands in the OS-interface. Note that many of these are unsafe.
      */
 
-    {"after",		Tcl_AfterObjCmd,	NULL,			NULL,	1},
+    {"after",		Tcl_AfterObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
     {"cd",		Tcl_CdObjCmd,		NULL,			NULL,	0},
-    {"close",		Tcl_CloseObjCmd,	NULL,			NULL,	1},
-    {"eof",		Tcl_EofObjCmd,		NULL,			NULL,	1},
+    {"close",		Tcl_CloseObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
+    {"eof",		Tcl_EofObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
     {"encoding",	Tcl_EncodingObjCmd,	NULL,			NULL,	0},
     {"exec",		Tcl_ExecObjCmd,		NULL,			NULL,	0},
     {"exit",		Tcl_ExitObjCmd,		NULL,			NULL,	0},
-    {"fblocked",	Tcl_FblockedObjCmd,	NULL,			NULL,	1},
+    {"fblocked",	Tcl_FblockedObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
     {"fconfigure",	Tcl_FconfigureObjCmd,	NULL,			NULL,	0},
-    {"fcopy",		Tcl_FcopyObjCmd,	NULL,			NULL,	1},
-    {"fileevent",	Tcl_FileEventObjCmd,	NULL,			NULL,	1},
-    {"flush",		Tcl_FlushObjCmd,	NULL,			NULL,	1},
-    {"gets",		Tcl_GetsObjCmd,		NULL,			NULL,	1},
+    {"fcopy",		Tcl_FcopyObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
+    {"fileevent",	Tcl_FileEventObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
+    {"flush",		Tcl_FlushObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
+    {"gets",		Tcl_GetsObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
     {"glob",		Tcl_GlobObjCmd,		NULL,			NULL,	0},
     {"load",		Tcl_LoadObjCmd,		NULL,			NULL,	0},
     {"open",		Tcl_OpenObjCmd,		NULL,			NULL,	0},
-    {"pid",		Tcl_PidObjCmd,		NULL,			NULL,	1},
-    {"puts",		Tcl_PutsObjCmd,		NULL,			NULL,	1},
+    {"pid",		Tcl_PidObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
+    {"puts",		Tcl_PutsObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
     {"pwd",		Tcl_PwdObjCmd,		NULL,			NULL,	0},
-    {"read",		Tcl_ReadObjCmd,		NULL,			NULL,	1},
-    {"seek",		Tcl_SeekObjCmd,		NULL,			NULL,	1},
+    {"read",		Tcl_ReadObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
+    {"seek",		Tcl_SeekObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
     {"socket",		Tcl_SocketObjCmd,	NULL,			NULL,	0},
     {"source",		Tcl_SourceObjCmd,	NULL,			TclNRSourceObjCmd,	0},
-    {"tell",		Tcl_TellObjCmd,		NULL,			NULL,	1},
-    {"time",		Tcl_TimeObjCmd,		NULL,			NULL,	1},
+    {"tell",		Tcl_TellObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
+    {"time",		Tcl_TimeObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
     {"unload",		Tcl_UnloadObjCmd,	NULL,			NULL,	0},
-    {"update",		Tcl_UpdateObjCmd,	NULL,			NULL,	1},
-    {"vwait",		Tcl_VwaitObjCmd,	NULL,			NULL,	1},
+    {"update",		Tcl_UpdateObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
+    {"vwait",		Tcl_VwaitObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
     {NULL,		NULL,			NULL,			NULL,	0}
 };
 
@@ -743,6 +748,9 @@ Tcl_CreateInterp(void)
 	    cmdPtr->deleteProc = NULL;
 	    cmdPtr->deleteData = NULL;
 	    cmdPtr->flags = 0;
+            if (cmdInfoPtr->flags & CMD_COMPILES_EXPANDED) {
+                cmdPtr->flags |= CMD_COMPILES_EXPANDED;
+            }
 	    cmdPtr->importRefPtr = NULL;
 	    cmdPtr->tracePtr = NULL;
 	    cmdPtr->nreProc = cmdInfoPtr->nreProc;
@@ -975,7 +983,7 @@ TclHideUnsafeCommands(
 	return TCL_ERROR;
     }
     for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) {
-	if (!cmdInfoPtr->isSafe) {
+	if (!(cmdInfoPtr->flags & CMD_IS_SAFE)) {
 	    Tcl_HideCommand(interp, cmdInfoPtr->name, cmdInfoPtr->name);
 	}
     }
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index c2495bd..a5678bf 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -4466,7 +4466,7 @@ TclCompileListCmd(
 {
     DefineLineInformation;	/* TIP #280 */
     Tcl_Token *valueTokenPtr;
-    int i, numWords;
+    int i, numWords, concat, build;
     Tcl_Obj *listObj, *objPtr;
 
     if (parsePtr->numWords == 1) {
@@ -4521,11 +4521,46 @@ TclCompileListCmd(
 
     numWords = parsePtr->numWords;
     valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    concat = build = 0;
     for (i = 1; i < numWords; i++) {
+	if (valueTokenPtr->type == TCL_TOKEN_EXPAND_WORD && build > 0) {
+	    TclEmitInstInt4(	INST_LIST, build,	envPtr);
+	    if (concat) {
+		TclEmitOpcode(	INST_LIST_CONCAT,	envPtr);
+	    }
+	    build = 0;
+	    concat = 1;
+	}
 	CompileWord(envPtr, valueTokenPtr, interp, i);
+	if (valueTokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
+	    if (concat) {
+		TclEmitOpcode(	INST_LIST_CONCAT,	envPtr);
+	    } else {
+		concat = 1;
+	    }
+	} else {
+	    build++;
+	}
 	valueTokenPtr = TokenAfter(valueTokenPtr);
     }
-    TclEmitInstInt4(	INST_LIST, numWords - 1,	envPtr);
+    if (build > 0) {
+	TclEmitInstInt4(	INST_LIST, build,	envPtr);
+	if (concat) {
+	    TclEmitOpcode(	INST_LIST_CONCAT,	envPtr);
+	}
+    }
+
+    /*
+     * If there was just one expanded word, we must ensure that it is a list
+     * at this point. We use an [lrange ... 0 end] for this (instead of
+     * [llength], as with literals) as we must drop any string representation
+     * that might be hanging around.
+     */
+
+    if (concat && numWords == 2) {
+	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,	envPtr);
+	TclEmitInt4(			-2,		envPtr);
+    }
     return TCL_OK;
 }
 
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 0844a78..1d1a680 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -280,12 +280,12 @@ const InstructionDesc const tclInstructionTable[] = {
 	/* Binary exponentiation operator: push (stknext ** stktop) */
 
     /*
-     * 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.
+     * 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.
      * See the comments further down in this file, where INST_INVOKE_EXPANDED
-     * and INST_LIST_EXPANDED are emitted.
+     * is emitted.
      */
     {"expandStart",       1,    0,          0,	{OPERAND_NONE}},
 	/* Start of command with {*} (expanded) arguments */
@@ -539,8 +539,6 @@ const InstructionDesc const tclInstructionTable[] = {
 	/* 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}}
 };
@@ -559,6 +557,8 @@ static void		EnterCmdExtentData(CompileEnv *envPtr,
 			    int cmdNumber, int numSrcBytes, int numCodeBytes);
 static void		EnterCmdStartData(CompileEnv *envPtr,
 			    int cmdNumber, int srcOffset, int codeOffset);
+static Command *	FindCommandFromToken(Tcl_Interp *interp,
+			    Tcl_Token *tokenPtr, Tcl_Namespace *namespacePtr);
 static void		FreeByteCodeInternalRep(Tcl_Obj *objPtr);
 static void		FreeSubstCodeInternalRep(Tcl_Obj *objPtr);
 static int		GetCmdLocEncodingSize(CompileEnv *envPtr);
@@ -1775,6 +1775,49 @@ TclWordKnownAtCompileTime(
 }
 
 /*
+ * ---------------------------------------------------------------------
+ *
+ * FindCommandFromToken --
+ *
+ *	A simple helper that looks up a command's compiler from its token.
+ *
+ * ---------------------------------------------------------------------
+ */
+
+static Command *
+FindCommandFromToken(
+    Tcl_Interp *interp,
+    Tcl_Token *tokenPtr,
+    Tcl_Namespace *namespacePtr)
+{
+    Tcl_DString ds;
+    Command *cmdPtr;
+
+    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	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),
+	    namespacePtr, /*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;
+}
+
+/*
  *----------------------------------------------------------------------
  *
  * TclCompileScript --
@@ -1816,7 +1859,6 @@ TclCompileScript(
     Command *cmdPtr;
     Tcl_Token *tokenPtr;
     int bytesLeft, isFirstCmd, wordIdx, currCmdIndex, commandLength, objIndex;
-    Tcl_DString ds;
     /* TIP #280 */
     ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
     int *wlines, wlineat, cmdLine, *clNext;
@@ -1826,8 +1868,6 @@ TclCompileScript(
 	Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv");
     }
 
-    Tcl_DStringInit(&ds);
-
     if (numBytes < 0) {
 	numBytes = strlen(script);
     }
@@ -1879,13 +1919,6 @@ 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
@@ -1938,11 +1971,27 @@ TclCompileScript(
 		    wordIdx < parsePtr->numWords;
 		    wordIdx++, tokenPtr += tokenPtr->numComponents + 1) {
 		if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
-		    expand = INST_INVOKE_EXPANDED;
+		    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. (That check is done inside FindCommandFromToken.)
+	     * This is as it should be.
+	     */
+
+	    if (expand) {
+		cmdPtr = FindCommandFromToken(interp, parsePtr->tokenPtr,
+			(Tcl_Namespace *) cmdNsPtr);
+		if (cmdPtr && (cmdPtr->flags & CMD_COMPILES_EXPANDED)) {
+		    expand = 0;
+		}
+	    }
+
 	    envPtr->numCommands++;
 	    currCmdIndex = envPtr->numCommands - 1;
 	    lastTopLevelCmdIndex = currCmdIndex;
@@ -1991,7 +2040,7 @@ TclCompileScript(
 
 		    TclCompileTokens(interp, tokenPtr+1,
 			    tokenPtr->numComponents, envPtr);
-		    if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
+		    if (expand && tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
 			TclEmitInstInt4(INST_EXPAND_STKTOP,
 				envPtr->currStackDepth, envPtr);
 		    }
@@ -2006,24 +2055,10 @@ TclCompileScript(
 		 */
 
 		if ((wordIdx == 0) && !expand) {
-		    /*
-		     * 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.
-		     */
-
-		    TclDStringClear(&ds);
-		    TclDStringAppendToken(&ds, &tokenPtr[1]);
-
-		    cmdPtr = (Command *) Tcl_FindCommand(interp,
-			    Tcl_DStringValue(&ds),
-			    (Tcl_Namespace *) cmdNsPtr, /*flags*/ 0);
+		    cmdPtr = FindCommandFromToken(interp, tokenPtr,
+			    (Tcl_Namespace *) cmdNsPtr);
 
 		    if ((cmdPtr != NULL)
-			    && (cmdPtr->compileProc != NULL)
-			    && !(cmdPtr->nsPtr->flags&NS_SUPPRESS_COMPILATION)
-			    && !(cmdPtr->flags & CMD_HAS_EXEC_TRACES)
 			    && !(iPtr->flags & DONT_COMPILE_CMDS_INLINE)) {
 			int code, savedNumCmds = envPtr->numCommands;
 			unsigned savedCodeNext =
@@ -2148,26 +2183,6 @@ 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
@@ -2210,13 +2225,10 @@ 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(expand, envPtr);
-		TclAdjustStackDepth(1 + expandIgnoredWords - wordIdx, envPtr);
+		TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr);
+		TclAdjustStackDepth(1 - wordIdx, envPtr);
 	    } else if (wordIdx > 0) {
 		/*
 		 * Save PC -> command map for the TclArgumentBC* functions.
@@ -2292,7 +2304,6 @@ TclCompileScript(
 
     envPtr->numSrcBytes = p - script;
     TclStackFree(interp, parsePtr);
-    Tcl_DStringFree(&ds);
 }
 
 /*
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 26284bd..3c697cc 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -716,10 +716,9 @@ 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		165
+#define LAST_INST_OPCODE		164
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for displaying
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index c1d6f84..fe27f0d 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -4270,18 +4270,6 @@ 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) {
diff --git a/generic/tclInt.h b/generic/tclInt.h
index e837ca5..4a31044 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -1681,6 +1681,9 @@ typedef struct Command {
  * CMD_HAS_EXEC_TRACES -	1 means that this command has at least one
  *				execution trace (as opposed to simple
  *				delete/rename traces) in its tracePtr list.
+ * CMD_COMPILES_EXPANDED -	1 means that this command has a compiler that
+ *				can handle expansion (provided it is not the
+ *				first word).
  * TCL_TRACE_RENAME -		A rename trace is in progress. Further
  *				recursive renames will not be traced.
  * TCL_TRACE_DELETE -		A delete trace is in progress. Further
@@ -1691,6 +1694,7 @@ typedef struct Command {
 #define CMD_IS_DELETED		    0x1
 #define CMD_TRACE_ACTIVE	    0x2
 #define CMD_HAS_EXEC_TRACES	    0x4
+#define CMD_COMPILES_EXPANDED	    0x8
 
 /*
  *----------------------------------------------------------------