summaryrefslogtreecommitdiffstats
path: root/generic/tclCompCmds.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclCompCmds.c')
-rw-r--r--generic/tclCompCmds.c122
1 files changed, 121 insertions, 1 deletions
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index d5cceb4..9ec265c 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -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: tclCompCmds.c,v 1.53 2004/01/13 23:15:02 dgp Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.54 2004/01/18 16:19:04 dkf Exp $
*/
#include "tclInt.h"
@@ -1743,6 +1743,126 @@ TclCompileLappendCmd(interp, parsePtr, envPtr)
/*
*----------------------------------------------------------------------
*
+ * TclCompileLassignCmd --
+ *
+ * Procedure called to compile the "lassign" command.
+ *
+ * Results:
+ * The return value is a standard Tcl result, which is TCL_OK if the
+ * compilation was successful. If the command cannot be byte-compiled,
+ * TCL_OUT_LINE_COMPILE is returned. If an error occurs then the
+ * interpreter's result contains an error message, and TCL_ERROR is
+ * returned.
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute the "lassign" command
+ * at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileLassignCmd(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. */
+{
+ Tcl_Token *tokenPtr;
+ int simpleVarName, isScalar, localIndex, numWords, code, idx;
+
+ numWords = parsePtr->numWords;
+ /*
+ * Check for command syntax error, but we'll punt that to runtime
+ */
+ if (numWords < 3) {
+ return TCL_OUT_LINE_COMPILE;
+ }
+
+ /*
+ * Generate code to push list being taken apart by [lassign].
+ */
+ tokenPtr = parsePtr->tokenPtr + (parsePtr->tokenPtr->numComponents + 1);
+ if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+ TclEmitPush(TclRegisterNewLiteral(envPtr,
+ tokenPtr[1].start, tokenPtr[1].size), envPtr);
+ } else {
+ code = TclCompileTokens(interp, tokenPtr+1,
+ tokenPtr->numComponents, envPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+ }
+
+ /*
+ * Generate code to assign values from the list to variables
+ */
+ for (idx=0 ; idx<numWords-2 ; idx++) {
+ tokenPtr += tokenPtr->numComponents + 1;
+
+ /*
+ * Generate the next variable name
+ */
+ code = TclPushVarName(interp, tokenPtr, envPtr, TCL_CREATE_VAR,
+ &localIndex, &simpleVarName, &isScalar);
+ if (code != TCL_OK) {
+ return code;
+ }
+
+ /*
+ * Emit instructions to get the idx'th item out of the list
+ * value on the stack and assign it to the variable.
+ */
+ if (simpleVarName) {
+ if (isScalar) {
+ if (localIndex >= 0) {
+ TclEmitOpcode(INST_DUP, envPtr);
+ TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
+ if (localIndex <= 255) {
+ TclEmitInstInt1(INST_STORE_SCALAR1, localIndex, envPtr);
+ } else {
+ TclEmitInstInt4(INST_STORE_SCALAR4, localIndex, envPtr);
+ }
+ } else {
+ TclEmitInstInt4(INST_OVER, 1, envPtr);
+ TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
+ TclEmitOpcode(INST_STORE_SCALAR_STK, envPtr);
+ }
+ } else {
+ if (localIndex >= 0) {
+ TclEmitInstInt4(INST_OVER, 1, envPtr);
+ TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
+ if (localIndex <= 255) {
+ TclEmitInstInt1(INST_STORE_ARRAY1, localIndex, envPtr);
+ } else {
+ TclEmitInstInt4(INST_STORE_ARRAY4, localIndex, envPtr);
+ }
+ } else {
+ TclEmitInstInt4(INST_OVER, 2, envPtr);
+ TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
+ TclEmitOpcode(INST_STORE_ARRAY_STK, envPtr);
+ }
+ }
+ } else {
+ TclEmitInstInt4(INST_OVER, 1, envPtr);
+ TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
+ TclEmitOpcode(INST_STORE_STK, envPtr);
+ }
+ TclEmitOpcode(INST_POP, envPtr);
+ }
+
+ /*
+ * Generate code to leave the rest of the list on the stack.
+ */
+ TclEmitInstInt4(INST_LIST_RANGE_IMM, idx, envPtr);
+ TclEmitInt4(-2, envPtr); /* -2 == "end" */
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclCompileLindexCmd --
*
* Procedure called to compile the "lindex" command.