diff options
author | hobbs <hobbs> | 2001-09-01 00:51:30 (GMT) |
---|---|---|
committer | hobbs <hobbs> | 2001-09-01 00:51:30 (GMT) |
commit | e3a668d0116f88c8a2cb5a58378d1ff551f82255 (patch) | |
tree | b023a6cb73d9766f25ad188e04c1669744183279 /generic/tclCompCmds.c | |
parent | 64560d95933f485db584e3a2bdedb5c7d8362420 (diff) | |
download | tcl-e3a668d0116f88c8a2cb5a58378d1ff551f82255.zip tcl-e3a668d0116f88c8a2cb5a58378d1ff551f82255.tar.gz tcl-e3a668d0116f88c8a2cb5a58378d1ff551f82255.tar.bz2 |
* 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.
Diffstat (limited to 'generic/tclCompCmds.c')
-rw-r--r-- | generic/tclCompCmds.c | 86 |
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. |