summaryrefslogtreecommitdiffstats
path: root/generic/tclCompCmds.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclCompCmds.c')
-rw-r--r--generic/tclCompCmds.c308
1 files changed, 293 insertions, 15 deletions
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 5e24b97..9ea0064 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -5,11 +5,12 @@
* Tcl commands into a sequence of instructions ("bytecodes").
*
* Copyright (c) 1997-1998 Sun Microsystems, Inc.
+ * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
*
* 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.14 2001/09/19 18:17:54 hobbs Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.15 2001/11/14 23:17:03 hobbs Exp $
*/
#include "tclInt.h"
@@ -1822,40 +1823,60 @@ TclCompileLindexCmd(interp, parsePtr, envPtr)
Tcl_Token *varTokenPtr;
int code, depth, i;
- if (parsePtr->numWords != 3) {
- Tcl_SetResult(interp, "wrong # args: should be \"lindex list index\"",
- TCL_STATIC);
- return TCL_ERROR;
+ int numWords;
+ numWords = parsePtr->numWords;
+
+ /*
+ * Quit if too few args
+ */
+
+ if ( numWords <= 1 ) {
+ return TCL_OUT_LINE_COMPILE;
}
+
varTokenPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
-
+
depth = 0;
-
+
/*
- * Push the two operands onto the stack.
+ * Push the operands onto the stack.
*/
-
- for (i = 0; i < 2; i++) {
+
+ for ( i = 1 ; i < numWords ; i++ ) {
if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
- TclEmitPush(TclRegisterLiteral(envPtr,
- varTokenPtr[1].start, varTokenPtr[1].size,
- 0), envPtr);
+ TclEmitPush( TclRegisterLiteral( envPtr,
+ varTokenPtr[1].start,
+ varTokenPtr[1].size,
+ 0),
+ envPtr);
depth++;
} else {
code = TclCompileTokens(interp, varTokenPtr+1,
- varTokenPtr->numComponents, envPtr);
+ varTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
+ envPtr->maxStackDepth = depth;
return code;
}
depth += envPtr->maxStackDepth;
}
varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
}
+
+ /*
+ * Emit INST_LIST_INDEX if objc==3, or INST_LIST_INDEX_MULTI
+ * if there are multiple index args.
+ */
envPtr->maxStackDepth = depth;
- TclEmitOpcode(INST_LIST_INDEX, envPtr);
+ if ( numWords == 3 ) {
+ TclEmitOpcode( INST_LIST_INDEX, envPtr );
+ } else {
+ TclEmitInstInt4( INST_LIST_INDEX_MULTI, numWords-2, envPtr );
+ }
+
return TCL_OK;
+
}
/*
@@ -2004,6 +2025,263 @@ TclCompileLlengthCmd(interp, parsePtr, envPtr)
/*
*----------------------------------------------------------------------
*
+ * TclCompileLsetCmd --
+ *
+ * Procedure called to compile the "lset" command.
+ *
+ * Results:
+ * The return value is a standard Tcl result, which is TCL_OK if
+ * the compilation was successful. If the "lset" command is too
+ * complex for this function, then TCL_OUT_LINE_COMPILE is returned,
+ * indicating that the command should be compiled "out of line"
+ * (that is, not byte-compiled). If an error occurs, TCL_ERROR is
+ * returned, and the interpreter result contains an error message.
+ *
+ * envPtr->maxStackDepth is updated with a conservative estimate
+ * of the number of stack elements needed to execute the command.
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute the "lset" command
+ * at runtime.
+ *
+ * The general template for execution of the "lset" command is:
+ * (1) Instructions to push the variable name, unless the
+ * variable is local to the stack frame.
+ * (2) If the variable is an array element, instructions
+ * to push the array element name.
+ * (3) Instructions to push each of zero or more "index" arguments
+ * to the stack, followed with the "newValue" element.
+ * (4) Instructions to duplicate the variable name and/or array
+ * element name onto the top of the stack, if either was
+ * pushed at steps (1) and (2).
+ * (5) The appropriate INST_LOAD_* instruction to place the
+ * original value of the list variable at top of stack.
+ * (6) At this point, the stack contains:
+ * varName? arrayElementName? index1 index2 ... newValue oldList
+ * The compiler emits one of INST_LSET_FLAT or INST_LSET_LIST
+ * according as whether there is exactly one index element (LIST)
+ * or either zero or else two or more (FLAT). This instruction
+ * removes everything from the stack except for the two names
+ * and pushes the new value of the variable.
+ * (7) Finally, INST_STORE_* stores the new value in the variable
+ * and cleans up the stack.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileLsetCmd( interp, parsePtr, envPtr )
+ Tcl_Interp* interp; /* Tcl interpreter for error reporting */
+ Tcl_Parse* parsePtr; /* Points to a parse structure for
+ * the command */
+ CompileEnv* envPtr; /* Holds the resulting instructions */
+{
+
+ int depth = 0; /* Current depth of stack */
+ int tempDepth; /* Depth used for emitting one part
+ * of the code burst. */
+ int maxDepth = 0; /* Max depth used anywhere in the
+ * code burst */
+
+ Tcl_Token* varTokenPtr; /* Pointer to the Tcl_Token representing
+ * the parse of the variable name */
+
+ int result; /* Status return from library calls */
+
+ int localIndex; /* Index of var in local var table */
+ int simpleVarName; /* Flag == 1 if var name is simple */
+ int isScalar; /* Flag == 1 if scalar, 0 if array */
+
+ int i;
+
+ /* Check argument count */
+
+ if ( parsePtr->numWords < 3 ) {
+ /* Fail at run time, not in compilation */
+ return TCL_OUT_LINE_COMPILE;
+ }
+
+ /*
+ * Decide if we can use a frame slot for the var/array name or if we
+ * need to emit code to compute and push the name at runtime. We use a
+ * frame slot (entry in the array of local vars) if we are compiling a
+ * procedure body and if the name is simple text that does not include
+ * namespace qualifiers.
+ */
+
+ varTokenPtr = parsePtr->tokenPtr
+ + (parsePtr->tokenPtr->numComponents + 1);
+ tempDepth = 0;
+ result = TclPushVarName( interp, varTokenPtr, envPtr, 0,
+ &localIndex, &tempDepth,
+ &simpleVarName, &isScalar );
+ if ( tempDepth > maxDepth ) {
+ maxDepth = tempDepth;
+ }
+ if (result != TCL_OK) {
+ envPtr->maxStackDepth = maxDepth;
+ return result;
+ }
+
+ /* Figure out how much is now on stack. */
+
+ depth = 0;
+ if ( simpleVarName ) {
+ if ( localIndex < 0 ) {
+ ++depth; /* We have pushed a variable name. */
+ }
+ if ( !isScalar ) {
+ ++depth; /* We have pushed an array element */
+ }
+ } else {
+ ++depth; /* Variable is complex; it's pushed to stack */
+ }
+
+ /* Push the "index" args and the new element value. */
+
+ for ( i = 2; i < parsePtr->numWords; ++i ) {
+
+ /* Advance to next arg */
+
+ varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
+
+ /* Push an arg */
+
+ if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+ TclEmitPush( TclRegisterLiteral( envPtr,
+ varTokenPtr[1].start,
+ varTokenPtr[1].size,
+ 0),
+ envPtr);
+ ++depth;
+ if ( depth > maxDepth ) {
+ maxDepth = depth;
+ }
+ } else {
+ envPtr->maxStackDepth = depth;
+ result = TclCompileTokens(interp, varTokenPtr+1,
+ varTokenPtr->numComponents, envPtr);
+ ++depth;
+ if ( envPtr->maxStackDepth > maxDepth ) {
+ maxDepth = envPtr->maxStackDepth;
+ }
+ if ( result != TCL_OK ) {
+ envPtr->maxStackDepth = maxDepth;
+ return result;
+ }
+ }
+ }
+
+ /*
+ * Duplicate the variable name if it's been pushed.
+ */
+
+ if ( !simpleVarName || localIndex < 0 ) {
+ if ( !simpleVarName || isScalar ) {
+ tempDepth = parsePtr->numWords - 2;
+ } else {
+ tempDepth = parsePtr->numWords - 1;
+ }
+ TclEmitInstInt4( INST_OVER, tempDepth, envPtr );
+ ++depth;
+ if ( depth > maxDepth ) {
+ maxDepth = depth;
+ }
+ }
+
+ /*
+ * Duplicate an array index if one's been pushed
+ */
+
+ if ( simpleVarName && !isScalar ) {
+ if ( localIndex < 0 ) {
+ tempDepth = parsePtr->numWords - 1;
+ } else {
+ tempDepth = parsePtr->numWords - 2;
+ }
+ TclEmitInstInt4( INST_OVER, tempDepth, envPtr );
+ ++depth;
+ if ( depth > maxDepth ) {
+ maxDepth = depth;
+ }
+ }
+
+ /*
+ * Emit code to load the variable's value.
+ */
+
+ if ( !simpleVarName ) {
+ TclEmitOpcode( INST_LOAD_STK, envPtr );
+ } else if ( isScalar ) {
+ if ( localIndex < 0 ) {
+ TclEmitOpcode( INST_LOAD_SCALAR_STK, envPtr );
+ } else if ( localIndex < 0x100 ) {
+ TclEmitInstInt1( INST_LOAD_SCALAR1, localIndex, envPtr );
+ } else {
+ TclEmitInstInt4( INST_LOAD_SCALAR4, localIndex, envPtr );
+ }
+ } else {
+ if ( localIndex < 0 ) {
+ TclEmitOpcode( INST_LOAD_ARRAY_STK, envPtr );
+ } else if ( localIndex < 0x100 ) {
+ TclEmitInstInt1( INST_LOAD_ARRAY1, localIndex, envPtr );
+ } else {
+ TclEmitInstInt4( INST_LOAD_ARRAY4, localIndex, envPtr );
+ }
+ }
+
+ /*
+ * Stack has now reached the maximum depth it will attain
+ * during this code burst.
+ */
+
+ ++depth;
+ if ( depth > maxDepth ) {
+ maxDepth = depth;
+ }
+ envPtr->maxStackDepth = maxDepth;
+
+ /*
+ * Emit the correct variety of 'lset' instruction
+ */
+
+ if ( parsePtr->numWords == 4 ) {
+ TclEmitOpcode( INST_LSET_LIST, envPtr );
+ } else {
+ TclEmitInstInt4( INST_LSET_FLAT, (parsePtr->numWords - 3), envPtr );
+ }
+
+ /*
+ * Emit code to put the value back in the variable
+ */
+
+ if ( !simpleVarName ) {
+ TclEmitOpcode( INST_STORE_STK, envPtr );
+ } else if ( isScalar ) {
+ if ( localIndex < 0 ) {
+ TclEmitOpcode( INST_STORE_SCALAR_STK, envPtr );
+ } else if ( localIndex < 0x100 ) {
+ TclEmitInstInt1( INST_STORE_SCALAR1, localIndex, envPtr );
+ } else {
+ TclEmitInstInt4( INST_STORE_SCALAR4, localIndex, envPtr );
+ }
+ } else {
+ if ( localIndex < 0 ) {
+ TclEmitOpcode( INST_STORE_ARRAY_STK, envPtr );
+ } else if ( localIndex < 0x100 ) {
+ TclEmitInstInt1( INST_STORE_ARRAY1, localIndex, envPtr );
+ } else {
+ TclEmitInstInt4( INST_STORE_ARRAY4, localIndex, envPtr );
+ }
+ }
+
+ return TCL_OK;
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclCompileReturnCmd --
*
* Procedure called to compile the "return" command.