summaryrefslogtreecommitdiffstats
path: root/generic/tclCompCmds.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclCompCmds.c')
-rw-r--r--generic/tclCompCmds.c86
1 files changed, 84 insertions, 2 deletions
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.