summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c4
-rw-r--r--generic/tclCompCmds.c86
-rw-r--r--generic/tclExecute.c22
-rw-r--r--generic/tclInt.h4
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,
generated by cgit v0.12 at 2024-12-03 09:47:21 (GMT)