diff options
| -rw-r--r-- | ChangeLog | 7 | ||||
| -rw-r--r-- | generic/tclBasic.c | 4 | ||||
| -rw-r--r-- | generic/tclCompCmds.c | 86 | ||||
| -rw-r--r-- | generic/tclExecute.c | 22 | ||||
| -rw-r--r-- | generic/tclInt.h | 4 |
5 files changed, 116 insertions, 7 deletions
@@ -1,5 +1,12 @@ 2001-08-31 Jeff Hobbs <jeffh@ActiveState.com> + * 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. + * doc/StringObj.3: added words of warning to use Tcl_ResetResult with the Tcl_Append* functions. 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, |