* generic/tcl.h: added TclCompileListCmd header

	* generic/tclBasic.c: added TclCompileListCmd compile proc
	* generic/tclCompCmds.c (TclCompileListCmd): function to compile
	the 'list' command at parse time.
	* generic/tclExecute.c (TclExecuteByteCode): definition of
	INST_LIST bytecode.

4 files changed, 109 insertions, 7 deletions

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 3f3d099..403d1a1 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclBasic.c,v 1.34 2001/08/14 13:45:57 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.35 2001/09/01 00:51:31 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -119,7 +119,7 @@ static CmdInfo builtInCmds[] = {
     {"linsert",		(Tcl_CmdProc *) NULL,	Tcl_LinsertObjCmd,
         (CompileProc *) NULL,		1},
     {"list",		(Tcl_CmdProc *) NULL,	Tcl_ListObjCmd,
-        (CompileProc *) NULL,		1},
+        TclCompileListCmd,		1},
     {"llength",		(Tcl_CmdProc *) NULL,	Tcl_LlengthObjCmd,
         TclCompileLlengthCmd,		1},
     {"load",		(Tcl_CmdProc *) NULL,	Tcl_LoadObjCmd,
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index fc357f3..73c4840 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCompCmds.c,v 1.12 2001/08/28 22:05:01 hobbs Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.13 2001/09/01 00:51:31 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -1513,7 +1513,7 @@ TclCompileIncrCmd(interp, parsePtr, envPtr)
 	    int numBytes = incrTokenPtr[1].size;
 	    char savedChar = word[numBytes];
 	    long n;
-	
+
 	    /*
 	     * Note there is a danger that modifying the string could have
 	     * undesirable side effects.  In this case, TclLooksLikeInt and
@@ -1823,6 +1823,88 @@ TclCompileLindexCmd(interp, parsePtr, envPtr)
 /*
  *----------------------------------------------------------------------
  *
+ * TclCompileListCmd --
+ *
+ *	Procedure called to compile the "list" command.
+ *
+ * Results:
+ *	The return value is a standard Tcl result, which is normally TCL_OK
+ *	unless there was an error while parsing string. If an error occurs
+ *	then the interpreter's result contains a standard error message. If
+ *	complation fails because the command requires a second level of
+ *	substitutions, TCL_OUT_LINE_COMPILE is returned indicating that the
+ *	command should be compiled "out of line" by emitting code to
+ *	invoke its command procedure (Tcl_ListObjCmd) at runtime.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the incr command.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the "list" command
+ *	at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileListCmd(interp, parsePtr, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    Tcl_Parse *parsePtr;	/* Points to a parse structure for the
+				 * command created by Tcl_ParseCommand. */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    /*
+     * If we're not in a procedure, don't compile.
+     */
+    if (envPtr->procPtr == NULL) {
+	return TCL_OUT_LINE_COMPILE;
+    }
+
+    envPtr->maxStackDepth = 0;
+    if (parsePtr->numWords == 1) {
+	/*
+	 * Empty args case
+	 */
+
+	TclEmitPush(TclRegisterLiteral(envPtr, "", 0, 0), envPtr);
+	envPtr->maxStackDepth = 1;
+    } else {
+	/*
+	 * Push the all values onto the stack.
+	 */
+	Tcl_Token *valueTokenPtr;
+	int i, code, numWords, depth = 0;
+
+	numWords = parsePtr->numWords;
+
+	valueTokenPtr = parsePtr->tokenPtr
+	    + (parsePtr->tokenPtr->numComponents + 1);
+	for (i = 1; i < numWords; i++) {
+	    if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+		TclEmitPush(TclRegisterLiteral(envPtr,
+			valueTokenPtr[1].start, valueTokenPtr[1].size,
+			/*onHeap*/ 0), envPtr);
+		depth++;
+	    } else {
+		code = TclCompileTokens(interp, valueTokenPtr+1,
+			valueTokenPtr->numComponents, envPtr);
+		if (code != TCL_OK) {
+		    envPtr->maxStackDepth = depth;
+		    return code;
+		}
+		depth += envPtr->maxStackDepth;
+	    }
+	    valueTokenPtr = valueTokenPtr + (valueTokenPtr->numComponents + 1);
+	}
+	TclEmitInstInt4(INST_LIST, numWords - 1, envPtr);
+    }
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TclCompileLlengthCmd --
  *
  *	Procedure called to compile the "llength" command.
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 97bb5ee..549e908 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclExecute.c,v 1.27 2001/08/30 12:04:13 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.28 2001/09/01 00:51:31 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -1388,7 +1388,7 @@ TclExecuteByteCode(interp, codePtr)
 	case INST_APPEND_ARRAY1:
 	    opnd = TclGetUInt1AtPtr(pc+1);
 	    pcAdjustment = 2;
-	    
+
 	    doAppendArray:
 	    valuePtr = POP_OBJECT();
 	    elemPtr = POP_OBJECT();
@@ -1415,6 +1415,24 @@ TclExecuteByteCode(interp, codePtr)
 	    /*
 	     * END APPEND INSTRUCTIONS
 	     */
+
+	case INST_LIST:
+	    /*
+	     * Pop the opnd (objc) top stack elements into a new list obj
+	     * and then decrement their ref counts. 
+	     */
+
+	    opnd = TclGetUInt4AtPtr(pc+1);
+	    valuePtr = Tcl_NewListObj(opnd, &(stackPtr[stackTop - (opnd-1)]));
+
+	    for (i = 0; i < opnd; i++) {
+		TclDecrRefCount(stackPtr[stackTop--]);
+	    }
+
+	    PUSH_OBJECT(valuePtr);
+	    TRACE_WITH_OBJ(("%u => " opnd), valuePtr);
+	    ADJUST_PC(5);
+
 	    /*
 	     * START LAPPEND INSTRUCTIONS
 	     */
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 049ab71..fce4832 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInt.h,v 1.61 2001/08/30 08:53:14 vincentdarley Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.62 2001/09/01 00:51:31 hobbs Exp $
  */
 
 #ifndef _TCLINT
@@ -2109,6 +2109,8 @@ EXTERN int	TclCompileLappendCmd _ANSI_ARGS_((Tcl_Interp *interp,
 		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
 EXTERN int	TclCompileLindexCmd _ANSI_ARGS_((Tcl_Interp *interp,
 		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+EXTERN int	TclCompileListCmd _ANSI_ARGS_((Tcl_Interp *interp,
+		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
 EXTERN int	TclCompileLlengthCmd _ANSI_ARGS_((Tcl_Interp *interp,
 		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
 EXTERN int	TclCompileReturnCmd _ANSI_ARGS_((Tcl_Interp *interp,