/[dtapublic]/projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclcompcmds.c

Diff of /projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclcompcmds.c

Parent Directory | Revision Log | View Patch Patch

-revision 64 by dashley,
Sun Oct 30 04:21:11 2016 UTC
+revision 71 by dashley,
Sat Nov  5 11:07:06 2016 UTC
 Line 1
- /* $Header$ */
- /*
-  * tclCompCmds.c --
-  *
-  *      This file contains compilation procedures that compile various
-  *      Tcl commands into a sequence of instructions ("bytecodes").
-  *
-  * Copyright (c) 1997-1998 Sun Microsystems, Inc.
-  *
-  * 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.1.1.1 2001/06/13 04:35:34 dtashley Exp $
-  */
- #include "tclInt.h"
- #include "tclCompile.h"
- /*
-  * Prototypes for procedures defined later in this file:
-  */
- static ClientData       DupForeachInfo _ANSI_ARGS_((ClientData clientData));
- static void             FreeForeachInfo _ANSI_ARGS_((
-                             ClientData clientData));
- /*
-  * The structures below define the AuxData types defined in this file.
-  */
- AuxDataType tclForeachInfoType = {
-     "ForeachInfo",                              /* name */
-     DupForeachInfo,                             /* dupProc */
-     FreeForeachInfo                             /* freeProc */
- };
- /*
-  *----------------------------------------------------------------------
-  *
-  * TclCompileBreakCmd --
-  *
-  *      Procedure called to compile the "break" command.
-  *
-  * Results:
-  *      The return value is a standard Tcl result, which is TCL_OK unless
-  *      there was an error during compilation. If an error occurs then
-  *      the interpreter's result contains a standard error message.
-  *
-  *      envPtr->maxStackDepth is updated with the maximum number of stack
-  *      elements needed to execute the command.
-  *
-  * Side effects:
-  *      Instructions are added to envPtr to execute the "break" command
-  *      at runtime.
-  *
-  *----------------------------------------------------------------------
-  */
- int
- TclCompileBreakCmd(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 (parsePtr->numWords != 1) {
-         Tcl_ResetResult(interp);
-         Tcl_AppendToObj(Tcl_GetObjResult(interp),
-                 "wrong # args: should be \"break\"", -1);
-         envPtr->maxStackDepth = 0;
-         return TCL_ERROR;
-     }
-     /*
-      * Emit a break instruction.
-      */
-     TclEmitOpcode(INST_BREAK, envPtr);
-     envPtr->maxStackDepth = 0;
-     return TCL_OK;
- }
- /*
-  *----------------------------------------------------------------------
-  *
-  * TclCompileCatchCmd --
-  *
-  *      Procedure called to compile the "catch" command.
-  *
-  * Results:
-  *      The return value is a standard Tcl result, which is TCL_OK if
-  *      compilation was successful. If an error occurs then the
-  *      interpreter's result contains a standard error message and TCL_ERROR
-  *      is returned. If the command is too complex for TclCompileCatchCmd,
-  *      TCL_OUT_LINE_COMPILE is returned indicating that the catch command
-  *      should be compiled "out of line" by emitting code to invoke its
-  *      command procedure at runtime.
-  *
-  *      envPtr->maxStackDepth is updated with the maximum number of stack
-  *      elements needed to execute the command.
-  *
-  * Side effects:
-  *      Instructions are added to envPtr to execute the "catch" command
-  *      at runtime.
-  *
-  *----------------------------------------------------------------------
-  */
- int
- TclCompileCatchCmd(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. */
- {
-     JumpFixup jumpFixup;
-     Tcl_Token *cmdTokenPtr, *nameTokenPtr;
-     char *name;
-     int localIndex, nameChars, range, maxDepth, startOffset, jumpDist;
-     int code;
-     char buffer[32 + TCL_INTEGER_SPACE];
-     envPtr->maxStackDepth = 0;
-     if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
-         Tcl_ResetResult(interp);
-         Tcl_AppendToObj(Tcl_GetObjResult(interp),
-                 "wrong # args: should be \"catch command ?varName?\"", -1);
-         return TCL_ERROR;
-     }
-     /*
-      * If a variable was specified and the catch command is at global level
-      * (not in a procedure), don't compile it inline: the payoff is
-      * too small.
-      */
-     if ((parsePtr->numWords == 3) && (envPtr->procPtr == NULL)) {
-         return TCL_OUT_LINE_COMPILE;
-     }
-     /*
-      * Make sure the variable name, if any, has no substitutions and just
-      * refers to a local scaler.
-      */
-     localIndex = -1;
-     cmdTokenPtr = parsePtr->tokenPtr
-             + (parsePtr->tokenPtr->numComponents + 1);
-     if (parsePtr->numWords == 3) {
-         nameTokenPtr = cmdTokenPtr + (cmdTokenPtr->numComponents + 1);
-         if (nameTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-             name = nameTokenPtr[1].start;
-             nameChars = nameTokenPtr[1].size;
-             if (!TclIsLocalScalar(name, nameChars)) {
-                 return TCL_OUT_LINE_COMPILE;
-             }
-             localIndex = TclFindCompiledLocal(nameTokenPtr[1].start,
-                     nameTokenPtr[1].size, /*create*/ 1,
-                     /*flags*/ VAR_SCALAR, envPtr->procPtr);
-         } else {
-            return TCL_OUT_LINE_COMPILE;
-         }
-     }
-     /*
-      * We will compile the catch command. Emit a beginCatch instruction at
-      * the start of the catch body: the subcommand it controls.
-      */
-     maxDepth = 0;
-     envPtr->exceptDepth++;
-     envPtr->maxExceptDepth =
-         TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
-     range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
-     TclEmitInstInt4(INST_BEGIN_CATCH4, range, envPtr);
-     startOffset = (envPtr->codeNext - envPtr->codeStart);
-     envPtr->exceptArrayPtr[range].codeOffset = startOffset;
-     code = TclCompileCmdWord(interp, cmdTokenPtr+1,
-             cmdTokenPtr->numComponents, envPtr);
-     if (code != TCL_OK) {
-         if (code == TCL_ERROR) {
-             sprintf(buffer, "\n    (\"catch\" body line %d)",
-                     interp->errorLine);
-             Tcl_AddObjErrorInfo(interp, buffer, -1);
-         }
-         goto done;
-     }
-     maxDepth = envPtr->maxStackDepth;
-     envPtr->exceptArrayPtr[range].numCodeBytes =
-             (envPtr->codeNext - envPtr->codeStart) - startOffset;
-     /*
-      * The "no errors" epilogue code: store the body's result into the
-      * variable (if any), push "0" (TCL_OK) as the catch's "no error"
-      * result, and jump around the "error case" code.
-      */
-     if (localIndex != -1) {
-         if (localIndex <= 255) {
-             TclEmitInstInt1(INST_STORE_SCALAR1, localIndex, envPtr);
-         } else {
-             TclEmitInstInt4(INST_STORE_SCALAR4, localIndex, envPtr);
-         }
-     }
-     TclEmitOpcode(INST_POP, envPtr);
-     TclEmitPush(TclRegisterLiteral(envPtr, "0", 1, /*onHeap*/ 0),
-             envPtr);
-     if (maxDepth == 0) {
-         maxDepth = 1;
-     }
-     TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
-     /*
-      * The "error case" code: store the body's result into the variable (if
-      * any), then push the error result code. The initial PC offset here is
-      * the catch's error target.
-      */
-     envPtr->exceptArrayPtr[range].catchOffset =
-             (envPtr->codeNext - envPtr->codeStart);
-     if (localIndex != -1) {
-         TclEmitOpcode(INST_PUSH_RESULT, envPtr);
-         if (localIndex <= 255) {
-             TclEmitInstInt1(INST_STORE_SCALAR1, localIndex, envPtr);
-         } else {
-             TclEmitInstInt4(INST_STORE_SCALAR4, localIndex, envPtr);
-         }
-         TclEmitOpcode(INST_POP, envPtr);
-     }
-     TclEmitOpcode(INST_PUSH_RETURN_CODE, envPtr);
-     /*
-      * Update the target of the jump after the "no errors" code, then emit
-      * an endCatch instruction at the end of the catch command.
-      */
-     jumpDist = (envPtr->codeNext - envPtr->codeStart)
-             - jumpFixup.codeOffset;
-     if (TclFixupForwardJump(envPtr, &jumpFixup, jumpDist, 127)) {
-         panic("TclCompileCatchCmd: bad jump distance %d\n", jumpDist);
-     }
-     TclEmitOpcode(INST_END_CATCH, envPtr);
-     done:
-     envPtr->exceptDepth--;
-     envPtr->maxStackDepth = maxDepth;
-     return code;
- }
- /*
-  *----------------------------------------------------------------------
-  *
-  * TclCompileContinueCmd --
-  *
-  *      Procedure called to compile the "continue" command.
-  *
-  * Results:
-  *      The return value is a standard Tcl result, which is TCL_OK unless
-  *      there was an error while parsing string. If an error occurs then
-  *      the interpreter's result contains a standard error message.
-  *
-  *      envPtr->maxStackDepth is updated with the maximum number of stack
-  *      elements needed to execute the command.
-  *
-  * Side effects:
-  *      Instructions are added to envPtr to execute the "continue" command
-  *      at runtime.
-  *
-  *----------------------------------------------------------------------
-  */
- int
- TclCompileContinueCmd(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. */
- {
-     /*
-      * There should be no argument after the "continue".
-      */
-     if (parsePtr->numWords != 1) {
-         Tcl_ResetResult(interp);
-         Tcl_AppendToObj(Tcl_GetObjResult(interp),
-                 "wrong # args: should be \"continue\"", -1);
-         envPtr->maxStackDepth = 0;
-         return TCL_ERROR;
-     }
-     /*
-      * Emit a continue instruction.
-      */
-     TclEmitOpcode(INST_CONTINUE, envPtr);
-     envPtr->maxStackDepth = 0;
-     return TCL_OK;
- }
- /*
-  *----------------------------------------------------------------------
-  *
-  * TclCompileExprCmd --
-  *
-  *      Procedure called to compile the "expr" command.
-  *
-  * Results:
-  *      The return value is a standard Tcl result, which is TCL_OK
-  *      unless there was an error while parsing string. If an error occurs
-  *      then the interpreter's result contains a standard error message.
-  *
-  *      envPtr->maxStackDepth is updated with the maximum number of stack
-  *      elements needed to execute the "expr" command.
-  *
-  * Side effects:
-  *      Instructions are added to envPtr to execute the "expr" command
-  *      at runtime.
-  *
-  *----------------------------------------------------------------------
-  */
- int
- TclCompileExprCmd(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 *firstWordPtr;
-     envPtr->maxStackDepth = 0;
-     if (parsePtr->numWords == 1) {
-         Tcl_ResetResult(interp);
-         Tcl_AppendToObj(Tcl_GetObjResult(interp),
-                 "wrong # args: should be \"expr arg ?arg ...?\"", -1);
-         return TCL_ERROR;
-     }
-     firstWordPtr = parsePtr->tokenPtr
-             + (parsePtr->tokenPtr->numComponents + 1);
-     return TclCompileExprWords(interp, firstWordPtr, (parsePtr->numWords-1),
-             envPtr);
- }
- /*
-  *----------------------------------------------------------------------
-  *
-  * TclCompileForCmd --
-  *
-  *      Procedure called to compile the "for" command.
-  *
-  * Results:
-  *      The return value is a standard Tcl result, which is TCL_OK unless
-  *      there was an error while parsing string. If an error occurs then
-  *      the interpreter's result contains a standard error message.
-  *
-  *      envPtr->maxStackDepth is updated with the maximum number of stack
-  *      elements needed to execute the command.
-  *
-  * Side effects:
-  *      Instructions are added to envPtr to execute the "for" command
-  *      at runtime.
-  *
-  *----------------------------------------------------------------------
-  */
- int
- TclCompileForCmd(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 *startTokenPtr, *testTokenPtr, *nextTokenPtr, *bodyTokenPtr;
-     JumpFixup jumpFalseFixup;
-     int maxDepth, jumpBackDist, jumpBackOffset, testCodeOffset, jumpDist;
-     int bodyRange, nextRange, code;
-     unsigned char *jumpPc;
-     char buffer[32 + TCL_INTEGER_SPACE];
-     envPtr->maxStackDepth = 0;
-     if (parsePtr->numWords != 5) {
-         Tcl_ResetResult(interp);
-         Tcl_AppendToObj(Tcl_GetObjResult(interp),
-                 "wrong # args: should be \"for start test next command\"", -1);
-         return TCL_ERROR;
-     }
-     /*
-      * If the test expression requires substitutions, don't compile the for
-      * command inline. E.g., the expression might cause the loop to never
-      * execute or execute forever, as in "for {} "$x > 5" {incr x} {}".
-      */
-     startTokenPtr = parsePtr->tokenPtr
-             + (parsePtr->tokenPtr->numComponents + 1);
-     testTokenPtr = startTokenPtr + (startTokenPtr->numComponents + 1);
-     if (testTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-         return TCL_OUT_LINE_COMPILE;
-     }
-     /*
-      * Create ExceptionRange records for the body and the "next" command.
-      * The "next" command's ExceptionRange supports break but not continue
-      * (and has a -1 continueOffset).
-      */
-     envPtr->exceptDepth++;
-     envPtr->maxExceptDepth =
-             TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
-     bodyRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
-     nextRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
-     /*
-      * Inline compile the initial command.
-      */
-     maxDepth = 0;
-     code = TclCompileCmdWord(interp, startTokenPtr+1,
-             startTokenPtr->numComponents, envPtr);
-     if (code != TCL_OK) {
-         if (code == TCL_ERROR) {
-             Tcl_AddObjErrorInfo(interp,
-                     "\n    (\"for\" initial command)", -1);
-         }
-         goto done;
-     }
-     maxDepth = envPtr->maxStackDepth;
-     TclEmitOpcode(INST_POP, envPtr);
-     /*
-      * Compile the test then emit the conditional jump that exits the for.
-      */
-     testCodeOffset = (envPtr->codeNext - envPtr->codeStart);
-     code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
-     if (code != TCL_OK) {
-         if (code == TCL_ERROR) {
-             Tcl_AddObjErrorInfo(interp,
-                     "\n    (\"for\" test expression)", -1);
-         }
-         goto done;
-     }
-     maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
-     TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);
-     /*
-      * Compile the loop body.
-      */
-     nextTokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1);
-     bodyTokenPtr = nextTokenPtr + (nextTokenPtr->numComponents + 1);
-     envPtr->exceptArrayPtr[bodyRange].codeOffset =
-             (envPtr->codeNext - envPtr->codeStart);
-     code = TclCompileCmdWord(interp, bodyTokenPtr+1,
-             bodyTokenPtr->numComponents, envPtr);
-     if (code != TCL_OK) {
-         if (code == TCL_ERROR) {
-             sprintf(buffer, "\n    (\"for\" body line %d)",
-                     interp->errorLine);
-             Tcl_AddObjErrorInfo(interp, buffer, -1);
-         }
-         goto done;
-     }
-     maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
-     envPtr->exceptArrayPtr[bodyRange].numCodeBytes =
-             (envPtr->codeNext - envPtr->codeStart)
-             - envPtr->exceptArrayPtr[bodyRange].codeOffset;
-     TclEmitOpcode(INST_POP, envPtr);
-     /*
-      * Compile the "next" subcommand.
-      */
-     envPtr->exceptArrayPtr[bodyRange].continueOffset =
-             (envPtr->codeNext - envPtr->codeStart);
-     envPtr->exceptArrayPtr[nextRange].codeOffset =
-             (envPtr->codeNext - envPtr->codeStart);
-     code = TclCompileCmdWord(interp, nextTokenPtr+1,
-             nextTokenPtr->numComponents, envPtr);
-     if (code != TCL_OK) {
-         if (code == TCL_ERROR) {
-             Tcl_AddObjErrorInfo(interp,
-                     "\n    (\"for\" loop-end command)", -1);
-         }
-         goto done;
-     }
-     maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
-     envPtr->exceptArrayPtr[nextRange].numCodeBytes =
-             (envPtr->codeNext - envPtr->codeStart)
-             - envPtr->exceptArrayPtr[nextRange].codeOffset;
-     TclEmitOpcode(INST_POP, envPtr);
-     /*
-      * Jump back to the test at the top of the loop. Generate a 4 byte jump
-      * if the distance to the test is > 120 bytes. This is conservative and
-      * ensures that we won't have to replace this jump if we later need to
-      * replace the ifFalse jump with a 4 byte jump.
-      */
-     jumpBackOffset = (envPtr->codeNext - envPtr->codeStart);
-     jumpBackDist = (jumpBackOffset - testCodeOffset);
-     if (jumpBackDist > 120) {
-         TclEmitInstInt4(INST_JUMP4, -jumpBackDist, envPtr);
-     } else {
-         TclEmitInstInt1(INST_JUMP1, -jumpBackDist, envPtr);
-     }
-     /*
-      * Fix the target of the jumpFalse after the test.
-      */
-     jumpDist = (envPtr->codeNext - envPtr->codeStart)
-             - jumpFalseFixup.codeOffset;
-     if (TclFixupForwardJump(envPtr, &jumpFalseFixup, jumpDist, 127)) {
-         /*
-          * Update the loop body and "next" command ExceptionRanges since
-          * they moved down.
-          */
-         envPtr->exceptArrayPtr[bodyRange].codeOffset += 3;
-         envPtr->exceptArrayPtr[bodyRange].continueOffset += 3;
-         envPtr->exceptArrayPtr[nextRange].codeOffset += 3;
-         /*
-          * Update the jump back to the test at the top of the loop since it
-          * also moved down 3 bytes.
-          */
-         jumpBackOffset += 3;
-         jumpPc = (envPtr->codeStart + jumpBackOffset);
-         jumpBackDist += 3;
-         if (jumpBackDist > 120) {
-             TclUpdateInstInt4AtPc(INST_JUMP4, -jumpBackDist, jumpPc);
-         } else {
-             TclUpdateInstInt1AtPc(INST_JUMP1, -jumpBackDist, jumpPc);
-         }
-     }
-     /*
-      * Set the loop's break target.
-      */
-     envPtr->exceptArrayPtr[bodyRange].breakOffset =
-             envPtr->exceptArrayPtr[nextRange].breakOffset =
-             (envPtr->codeNext - envPtr->codeStart);
-     /*
-      * The for command's result is an empty string.
-      */
-     TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr);
-     if (maxDepth == 0) {
-         maxDepth = 1;
-     }
-     code = TCL_OK;
-     done:
-     envPtr->maxStackDepth = maxDepth;
-     envPtr->exceptDepth--;
-     return code;
- }
- /*
-  *----------------------------------------------------------------------
-  *
-  * TclCompileForeachCmd --
-  *
-  *      Procedure called to compile the "foreach" command.
-  *
-  * Results:
-  *      The return value is a standard Tcl result, which is TCL_OK if
-  *      compilation was successful. If an error occurs then the
-  *      interpreter's result contains a standard error message and TCL_ERROR
-  *      is returned. If the command is too complex for TclCompileForeachCmd,
-  *      TCL_OUT_LINE_COMPILE is returned indicating that the foreach command
-  *      should be compiled "out of line" by emitting code to invoke its
-  *      command procedure at runtime.
-  *
-  *      envPtr->maxStackDepth is updated with the maximum number of stack
-  *      elements needed to execute the "while" command.
-  *
-  * Side effects:
-  *      Instructions are added to envPtr to execute the "foreach" command
-  *      at runtime.
-  *
-  *----------------------------------------------------------------------
-  */
- int
- TclCompileForeachCmd(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. */
- {
-     Proc *procPtr = envPtr->procPtr;
-     ForeachInfo *infoPtr;       /* Points to the structure describing this
-                                  * foreach command. Stored in a AuxData
-                                  * record in the ByteCode. */
-     int firstValueTemp;         /* Index of the first temp var in the frame
-                                  * used to point to a value list. */
-     int loopCtTemp;             /* Index of temp var holding the loop's
-                                  * iteration count. */
-     Tcl_Token *tokenPtr, *bodyTokenPtr;
-     char *varList;
-     unsigned char *jumpPc;
-     JumpFixup jumpFalseFixup;
-     int jumpDist, jumpBackDist, jumpBackOffset, maxDepth, infoIndex, range;
-     int numWords, numLists, numVars, loopIndex, tempVar, i, j, code;
-     char savedChar;
-     char buffer[32 + TCL_INTEGER_SPACE];
-     /*
-      * We parse the variable list argument words and create two arrays:
-      *    varcList[i] is number of variables in i-th var list
-      *    varvList[i] points to array of var names in i-th var list
-      */
- #define STATIC_VAR_LIST_SIZE 5
-     int varcListStaticSpace[STATIC_VAR_LIST_SIZE];
-     char **varvListStaticSpace[STATIC_VAR_LIST_SIZE];
-     int *varcList = varcListStaticSpace;
-     char ***varvList = varvListStaticSpace;
-     /*
-      * If the foreach command isn't in a procedure, don't compile it inline:
-      * the payoff is too small.
-      */
-     envPtr->maxStackDepth = 0;
-     if (procPtr == NULL) {
-         return TCL_OUT_LINE_COMPILE;
-     }
-     maxDepth = 0;
-     numWords = parsePtr->numWords;
-     if ((numWords < 4) || (numWords%2 != 0)) {
-         Tcl_ResetResult(interp);
-         Tcl_AppendToObj(Tcl_GetObjResult(interp),
-                 "wrong # args: should be \"foreach varList list ?varList list ...? command\"", -1);
-         return TCL_ERROR;
-     }
-     /*
-      * Allocate storage for the varcList and varvList arrays if necessary.
-      */
-     numLists = (numWords - 2)/2;
-     if (numLists > STATIC_VAR_LIST_SIZE) {
-         varcList = (int *) ckalloc(numLists * sizeof(int));
-         varvList = (char ***) ckalloc(numLists * sizeof(char **));
-     }
-     for (loopIndex = 0;  loopIndex < numLists;  loopIndex++) {
-         varcList[loopIndex] = 0;
-         varvList[loopIndex] = (char **) NULL;
-     }
-     /*
-      * Set the exception stack depth.
-      */
-     envPtr->exceptDepth++;
-     envPtr->maxExceptDepth =
-         TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
-     /*
-      * Break up each var list and set the varcList and varvList arrays.
-      * Don't compile the foreach inline if any var name needs substitutions
-      * or isn't a scalar, or if any var list needs substitutions.
-      */
-     loopIndex = 0;
-     for (i = 0, tokenPtr = parsePtr->tokenPtr;
-             i < numWords-1;
-             i++, tokenPtr += (tokenPtr->numComponents + 1)) {
-         if (i%2 == 1) {
-             if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-                 code = TCL_OUT_LINE_COMPILE;
-                 goto done;
-             }
-             varList = tokenPtr[1].start;
-             savedChar = varList[tokenPtr[1].size];
-             /*
-              * Note there is a danger that modifying the string could have
-              * undesirable side effects.  In this case, Tcl_SplitList does
-              * not have any dependencies on shared strings so we should be
-              * safe.
-              */
-             varList[tokenPtr[1].size] = '\0';
-             code = Tcl_SplitList(interp, varList,
-                     &varcList[loopIndex], &varvList[loopIndex]);
-             varList[tokenPtr[1].size] = savedChar;
-             if (code != TCL_OK) {
-                 goto done;
-             }
-             numVars = varcList[loopIndex];
-             for (j = 0;  j < numVars;  j++) {
-                 char *varName = varvList[loopIndex][j];
-                 if (!TclIsLocalScalar(varName, (int) strlen(varName))) {
-                     code = TCL_OUT_LINE_COMPILE;
-                     goto done;
-                 }
-             }
-             loopIndex++;
-         }
-     }
-     /*
-      * We will compile the foreach command.
-      * Reserve (numLists + 1) temporary variables:
-      *    - numLists temps to hold each value list
-      *    - 1 temp for the loop counter (index of next element in each list)
-      * At this time we don't try to reuse temporaries; if there are two
-      * nonoverlapping foreach loops, they don't share any temps.
-      */
-     firstValueTemp = -1;
-     for (loopIndex = 0;  loopIndex < numLists;  loopIndex++) {
-         tempVar = TclFindCompiledLocal(NULL, /*nameChars*/ 0,
-                 /*create*/ 1, /*flags*/ VAR_SCALAR, procPtr);
-         if (loopIndex == 0) {
-             firstValueTemp = tempVar;
-         }
-     }
-     loopCtTemp = TclFindCompiledLocal(NULL, /*nameChars*/ 0,
-             /*create*/ 1, /*flags*/ VAR_SCALAR, procPtr);
-     /*
-      * Create and initialize the ForeachInfo and ForeachVarList data
-      * structures describing this command. Then create a AuxData record
-      * pointing to the ForeachInfo structure.
-      */
-     infoPtr = (ForeachInfo *) ckalloc((unsigned)
-             (sizeof(ForeachInfo) + (numLists * sizeof(ForeachVarList *))));
-     infoPtr->numLists = numLists;
-     infoPtr->firstValueTemp = firstValueTemp;
-     infoPtr->loopCtTemp = loopCtTemp;
-     for (loopIndex = 0;  loopIndex < numLists;  loopIndex++) {
-         ForeachVarList *varListPtr;
-         numVars = varcList[loopIndex];
-         varListPtr = (ForeachVarList *) ckalloc((unsigned)
-                 sizeof(ForeachVarList) + (numVars * sizeof(int)));
-         varListPtr->numVars = numVars;
-         for (j = 0;  j < numVars;  j++) {
-             char *varName = varvList[loopIndex][j];
-             int nameChars = strlen(varName);
-             varListPtr->varIndexes[j] = TclFindCompiledLocal(varName,
-                     nameChars, /*create*/ 1, /*flags*/ VAR_SCALAR, procPtr);
-         }
-         infoPtr->varLists[loopIndex] = varListPtr;
-     }
-     infoIndex = TclCreateAuxData((ClientData) infoPtr, &tclForeachInfoType, envPtr);
-     /*
-      * Evaluate then store each value list in the associated temporary.
-      */
-     range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
-     loopIndex = 0;
-     for (i = 0, tokenPtr = parsePtr->tokenPtr;
-             i < numWords-1;
-             i++, tokenPtr += (tokenPtr->numComponents + 1)) {
-         if ((i%2 == 0) && (i > 0)) {
-             code = TclCompileTokens(interp, tokenPtr+1,
-                     tokenPtr->numComponents, envPtr);
-             if (code != TCL_OK) {
-                 goto done;
-             }
-             maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
-             tempVar = (firstValueTemp + loopIndex);
-             if (tempVar <= 255) {
-                 TclEmitInstInt1(INST_STORE_SCALAR1, tempVar, envPtr);
-             } else {
-                 TclEmitInstInt4(INST_STORE_SCALAR4, tempVar, envPtr);
-             }
-             TclEmitOpcode(INST_POP, envPtr);
-             loopIndex++;
-         }
-     }
-     bodyTokenPtr = tokenPtr;
-     /*
-      * Initialize the temporary var that holds the count of loop iterations.
-      */
-     TclEmitInstInt4(INST_FOREACH_START4, infoIndex, envPtr);
-     /*
-      * Top of loop code: assign each loop variable and check whether
-      * to terminate the loop.
-      */
-     envPtr->exceptArrayPtr[range].continueOffset =
-             (envPtr->codeNext - envPtr->codeStart);
-     TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex, envPtr);
-     TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);
-     /*
-      * Inline compile the loop body.
-      */
-     envPtr->exceptArrayPtr[range].codeOffset =
-             (envPtr->codeNext - envPtr->codeStart);
-     code = TclCompileCmdWord(interp, bodyTokenPtr+1,
-             bodyTokenPtr->numComponents, envPtr);
-     if (code != TCL_OK) {
-         if (code == TCL_ERROR) {
-             sprintf(buffer, "\n    (\"foreach\" body line %d)",
-                     interp->errorLine);
-             Tcl_AddObjErrorInfo(interp, buffer, -1);
-         }
-         goto done;
-     }
-     maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
-     envPtr->exceptArrayPtr[range].numCodeBytes =
-             (envPtr->codeNext - envPtr->codeStart)
-             - envPtr->exceptArrayPtr[range].codeOffset;
-     TclEmitOpcode(INST_POP, envPtr);
-     /*
-      * Jump back to the test at the top of the loop. Generate a 4 byte jump
-      * if the distance to the test is > 120 bytes. This is conservative and
-      * ensures that we won't have to replace this jump if we later need to
-      * replace the ifFalse jump with a 4 byte jump.
-      */
-     jumpBackOffset = (envPtr->codeNext - envPtr->codeStart);
-     jumpBackDist =
-         (jumpBackOffset - envPtr->exceptArrayPtr[range].continueOffset);
-     if (jumpBackDist > 120) {
-         TclEmitInstInt4(INST_JUMP4, -jumpBackDist, envPtr);
-     } else {
-         TclEmitInstInt1(INST_JUMP1, -jumpBackDist, envPtr);
-     }
-     /*
-      * Fix the target of the jump after the foreach_step test.
-      */
-     jumpDist = (envPtr->codeNext - envPtr->codeStart)
-             - jumpFalseFixup.codeOffset;
-     if (TclFixupForwardJump(envPtr, &jumpFalseFixup, jumpDist, 127)) {
-         /*
-          * Update the loop body's starting PC offset since it moved down.
-          */
-         envPtr->exceptArrayPtr[range].codeOffset += 3;
-         /*
-          * Update the jump back to the test at the top of the loop since it
-          * also moved down 3 bytes.
-          */
-         jumpBackOffset += 3;
-         jumpPc = (envPtr->codeStart + jumpBackOffset);
-         jumpBackDist += 3;
-         if (jumpBackDist > 120) {
-             TclUpdateInstInt4AtPc(INST_JUMP4, -jumpBackDist, jumpPc);
-         } else {
-             TclUpdateInstInt1AtPc(INST_JUMP1, -jumpBackDist, jumpPc);
-         }
-     }
-     /*
-      * Set the loop's break target.
-      */
-     envPtr->exceptArrayPtr[range].breakOffset =
-             (envPtr->codeNext - envPtr->codeStart);
-     /*
-      * The foreach command's result is an empty string.
-      */
-     TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr);
-     if (maxDepth == 0) {
-         maxDepth = 1;
-     }
-     done:
-     for (loopIndex = 0;  loopIndex < numLists;  loopIndex++) {
-         if (varvList[loopIndex] != (char **) NULL) {
-             ckfree((char *) varvList[loopIndex]);
-         }
-     }
-     if (varcList != varcListStaticSpace) {
-         ckfree((char *) varcList);
-         ckfree((char *) varvList);
-     }
-     envPtr->maxStackDepth = maxDepth;
-     envPtr->exceptDepth--;
-     return code;
- }
- /*
-  *----------------------------------------------------------------------
-  *
-  * DupForeachInfo --
-  *
-  *      This procedure duplicates a ForeachInfo structure created as
-  *      auxiliary data during the compilation of a foreach command.
-  *
-  * Results:
-  *      A pointer to a newly allocated copy of the existing ForeachInfo
-  *      structure is returned.
-  *
-  * Side effects:
-  *      Storage for the copied ForeachInfo record is allocated. If the
-  *      original ForeachInfo structure pointed to any ForeachVarList
-  *      records, these structures are also copied and pointers to them
-  *      are stored in the new ForeachInfo record.
-  *
-  *----------------------------------------------------------------------
-  */
- static ClientData
- DupForeachInfo(clientData)
-     ClientData clientData;      /* The foreach command's compilation
-                                  * auxiliary data to duplicate. */
- {
-     register ForeachInfo *srcPtr = (ForeachInfo *) clientData;
-     ForeachInfo *dupPtr;
-     register ForeachVarList *srcListPtr, *dupListPtr;
-     int numLists = srcPtr->numLists;
-     int numVars, i, j;
-     dupPtr = (ForeachInfo *) ckalloc((unsigned)
-             (sizeof(ForeachInfo) + (numLists * sizeof(ForeachVarList *))));
-     dupPtr->numLists = numLists;
-     dupPtr->firstValueTemp = srcPtr->firstValueTemp;
-     dupPtr->loopCtTemp = srcPtr->loopCtTemp;
-     for (i = 0;  i < numLists;  i++) {
-         srcListPtr = srcPtr->varLists[i];
-         numVars = srcListPtr->numVars;
-         dupListPtr = (ForeachVarList *) ckalloc((unsigned)
-                 sizeof(ForeachVarList) + numVars*sizeof(int));
-         dupListPtr->numVars = numVars;
-         for (j = 0;  j < numVars;  j++) {
-             dupListPtr->varIndexes[j] = srcListPtr->varIndexes[j];
-         }
-         dupPtr->varLists[i] = dupListPtr;
-     }
-     return (ClientData) dupPtr;
- }
- /*
-  *----------------------------------------------------------------------
-  *
-  * FreeForeachInfo --
-  *
-  *      Procedure to free a ForeachInfo structure created as auxiliary data
-  *      during the compilation of a foreach command.
-  *
-  * Results:
-  *      None.
-  *
-  * Side effects:
-  *      Storage for the ForeachInfo structure pointed to by the ClientData
-  *      argument is freed as is any ForeachVarList record pointed to by the
-  *      ForeachInfo structure.
-  *
-  *----------------------------------------------------------------------
-  */
- static void
- FreeForeachInfo(clientData)
-     ClientData clientData;      /* The foreach command's compilation
-                                  * auxiliary data to free. */
- {
-     register ForeachInfo *infoPtr = (ForeachInfo *) clientData;
-     register ForeachVarList *listPtr;
-     int numLists = infoPtr->numLists;
-     register int i;
-     for (i = 0;  i < numLists;  i++) {
-         listPtr = infoPtr->varLists[i];
-         ckfree((char *) listPtr);
-     }
-     ckfree((char *) infoPtr);
- }
- /*
-  *----------------------------------------------------------------------
-  *
-  * TclCompileIfCmd --
-  *
-  *      Procedure called to compile the "if" command.
-  *
-  * Results:
-  *      The return value is a standard Tcl result, which is TCL_OK if
-  *      compilation was successful. If an error occurs then the
-  *      interpreter's result contains a standard error message and TCL_ERROR
-  *      is returned. If the command is too complex for TclCompileIfCmd,
-  *      TCL_OUT_LINE_COMPILE is returned indicating that the if command
-  *      should be compiled "out of line" by emitting code to invoke its
-  *      command procedure at runtime.
-  *
-  *      envPtr->maxStackDepth is updated with the maximum number of stack
-  *      elements needed to execute the command.
-  *
-  * Side effects:
-  *      Instructions are added to envPtr to execute the "if" command
-  *      at runtime.
-  *
-  *----------------------------------------------------------------------
-  */
- int
- TclCompileIfCmd(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. */
- {
-     JumpFixupArray jumpFalseFixupArray;
-                                 /* Used to fix the ifFalse jump after each
-                                  * test when its target PC is determined. */
-     JumpFixupArray jumpEndFixupArray;
-                                 /* Used to fix the jump after each "then"
-                                  * body to the end of the "if" when that PC
-                                  * is determined. */
-     Tcl_Token *tokenPtr, *testTokenPtr;
-     int jumpDist, jumpFalseDist, jumpIndex;
-     int numWords, wordIdx, numBytes, maxDepth, j, code;
-     char *word;
-     char buffer[100];
-     TclInitJumpFixupArray(&jumpFalseFixupArray);
-     TclInitJumpFixupArray(&jumpEndFixupArray);
-     maxDepth = 0;
-     code = TCL_OK;
-     /*
-      * Each iteration of this loop compiles one "if expr ?then? body"
-      * or "elseif expr ?then? body" clause.
-      */
-     tokenPtr = parsePtr->tokenPtr;
-     wordIdx = 0;
-     numWords = parsePtr->numWords;
-     while (wordIdx < numWords) {
-         /*
-          * Stop looping if the token isn't "if" or "elseif".
-          */
-         if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-             break;
-         }
-         word = tokenPtr[1].start;
-         numBytes = tokenPtr[1].size;
-         if ((tokenPtr == parsePtr->tokenPtr)
-                 || ((numBytes == 6) && (strncmp(word, "elseif", 6) == 0))) {
-             tokenPtr += (tokenPtr->numComponents + 1);
-             wordIdx++;
-         } else {
-             break;
-         }
-         if (wordIdx >= numWords) {
-             sprintf(buffer,
-                     "wrong # args: no expression after \"%.30s\" argument",
-                     word);
-             Tcl_ResetResult(interp);
-             Tcl_AppendToObj(Tcl_GetObjResult(interp), buffer, -1);
-             code = TCL_ERROR;
-             goto done;
-         }
-         /*
-          * Compile the test expression then emit the conditional jump
-          * around the "then" part. If the expression word isn't simple,
-          * we back off and compile the if command out-of-line.
-          */
-         testTokenPtr = tokenPtr;
-         code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
-         if (code != TCL_OK) {
-             if (code == TCL_ERROR) {
-                 Tcl_AddObjErrorInfo(interp,
-                         "\n    (\"if\" test expression)", -1);
-             }
-             goto done;
-         }
-         maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
-         if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) {
-             TclExpandJumpFixupArray(&jumpFalseFixupArray);
-         }
-         jumpIndex = jumpFalseFixupArray.next;
-         jumpFalseFixupArray.next++;
-         TclEmitForwardJump(envPtr, TCL_FALSE_JUMP,
-                 &(jumpFalseFixupArray.fixup[jumpIndex]));
-         /*
-          * Skip over the optional "then" before the then clause.
-          */
-         tokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1);
-         wordIdx++;
-         if (wordIdx >= numWords) {
-             sprintf(buffer, "wrong # args: no script following \"%.20s\" argument", testTokenPtr->start);
-             Tcl_ResetResult(interp);
-             Tcl_AppendToObj(Tcl_GetObjResult(interp), buffer, -1);
-             code = TCL_ERROR;
-             goto done;
-         }
-         if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-             word = tokenPtr[1].start;
-             numBytes = tokenPtr[1].size;
-             if ((numBytes == 4) && (strncmp(word, "then", 4) == 0)) {
-                 tokenPtr += (tokenPtr->numComponents + 1);
-                 wordIdx++;
-                 if (wordIdx >= numWords) {
-                     Tcl_ResetResult(interp);
-                     Tcl_AppendToObj(Tcl_GetObjResult(interp),
-                             "wrong # args: no script following \"then\" argument", -1);
-                     code = TCL_ERROR;
-                     goto done;
-                 }
-             }
-         }
-         /*
-          * Compile the "then" command body.
-          */
-         code = TclCompileCmdWord(interp, tokenPtr+1,
-                 tokenPtr->numComponents, envPtr);
-         if (code != TCL_OK) {
-             if (code == TCL_ERROR) {
-                 sprintf(buffer, "\n    (\"if\" then script line %d)",
-                         interp->errorLine);
-                 Tcl_AddObjErrorInfo(interp, buffer, -1);
-             }
-             goto done;
-         }
-         maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
-         /*
-          * Jump to the end of the "if" command. Both jumpFalseFixupArray and
-          * jumpEndFixupArray are indexed by "jumpIndex".
-          */
-         if (jumpEndFixupArray.next >= jumpEndFixupArray.end) {
-             TclExpandJumpFixupArray(&jumpEndFixupArray);
-         }
-         jumpEndFixupArray.next++;
-         TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
-                 &(jumpEndFixupArray.fixup[jumpIndex]));
-         /*
-          * Fix the target of the jumpFalse after the test. Generate a 4 byte
-          * jump if the distance is > 120 bytes. This is conservative, and
-          * ensures that we won't have to replace this jump if we later also
-          * need to replace the proceeding jump to the end of the "if" with a
-          * 4 byte jump.
-          */
-         jumpDist = (envPtr->codeNext - envPtr->codeStart)
-                 - jumpFalseFixupArray.fixup[jumpIndex].codeOffset;
-         if (TclFixupForwardJump(envPtr,
-                 &(jumpFalseFixupArray.fixup[jumpIndex]), jumpDist, 120)) {
-             /*
-              * Adjust the code offset for the proceeding jump to the end
-              * of the "if" command.
-              */
-             jumpEndFixupArray.fixup[jumpIndex].codeOffset += 3;
-         }
-         tokenPtr += (tokenPtr->numComponents + 1);
-         wordIdx++;
-     }
-     /*
-      * Check for the optional else clause.
-      */
-     if ((wordIdx < numWords)
-             && (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD)) {
-         /*
-          * There is an else clause. Skip over the optional "else" word.
-          */
-         word = tokenPtr[1].start;
-         numBytes = tokenPtr[1].size;
-         if ((numBytes == 4) && (strncmp(word, "else", 4) == 0)) {
-             tokenPtr += (tokenPtr->numComponents + 1);
-             wordIdx++;
-             if (wordIdx >= numWords) {
-                 Tcl_ResetResult(interp);
-                 Tcl_AppendToObj(Tcl_GetObjResult(interp),
-                         "wrong # args: no script following \"else\" argument", -1);
-                 code = TCL_ERROR;
-                 goto done;
-             }
-         }
-         /*
-          * Compile the else command body.
-          */
-         code = TclCompileCmdWord(interp, tokenPtr+1,
-                 tokenPtr->numComponents, envPtr);
-         if (code != TCL_OK) {
-             if (code == TCL_ERROR) {
-                 sprintf(buffer, "\n    (\"if\" else script line %d)",
-                         interp->errorLine);
-                 Tcl_AddObjErrorInfo(interp, buffer, -1);
-             }
-             goto done;
-         }
-         maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
-         /*
-          * Make sure there are no words after the else clause.
-          */
-         wordIdx++;
-         if (wordIdx < numWords) {
-             Tcl_ResetResult(interp);
-             Tcl_AppendToObj(Tcl_GetObjResult(interp),
-                     "wrong # args: extra words after \"else\" clause in \"if\" command", -1);
-             code = TCL_ERROR;
-             goto done;
-         }
-     } else {
-         /*
-          * No else clause: the "if" command's result is an empty string.
-          */
-         TclEmitPush(TclRegisterLiteral(envPtr, "", 0,/*onHeap*/ 0), envPtr);
-         maxDepth = TclMax(1, maxDepth);
-     }
-     /*
-      * Fix the unconditional jumps to the end of the "if" command.
-      */
-     for (j = jumpEndFixupArray.next;  j > 0;  j--) {
-         jumpIndex = (j - 1);    /* i.e. process the closest jump first */
-         jumpDist = (envPtr->codeNext - envPtr->codeStart)
-                 - jumpEndFixupArray.fixup[jumpIndex].codeOffset;
-         if (TclFixupForwardJump(envPtr,
-                 &(jumpEndFixupArray.fixup[jumpIndex]), jumpDist, 127)) {
-             /*
-              * Adjust the immediately preceeding "ifFalse" jump. We moved
-              * it's target (just after this jump) down three bytes.
-              */
-             unsigned char *ifFalsePc = envPtr->codeStart
-                     + jumpFalseFixupArray.fixup[jumpIndex].codeOffset;
-             unsigned char opCode = *ifFalsePc;
-             if (opCode == INST_JUMP_FALSE1) {
-                 jumpFalseDist = TclGetInt1AtPtr(ifFalsePc + 1);
-                 jumpFalseDist += 3;
-                 TclStoreInt1AtPtr(jumpFalseDist, (ifFalsePc + 1));
-             } else if (opCode == INST_JUMP_FALSE4) {
-                 jumpFalseDist = TclGetInt4AtPtr(ifFalsePc + 1);
-                 jumpFalseDist += 3;
-                 TclStoreInt4AtPtr(jumpFalseDist, (ifFalsePc + 1));
-             } else {
-                 panic("TclCompileIfCmd: unexpected opcode updating ifFalse jump");
-             }
-         }
-     }
-     /*
-      * Free the jumpFixupArray array if malloc'ed storage was used.
-      */
-     done:
-     TclFreeJumpFixupArray(&jumpFalseFixupArray);
-     TclFreeJumpFixupArray(&jumpEndFixupArray);
-     envPtr->maxStackDepth = maxDepth;
-     return code;
- }
- /*
-  *----------------------------------------------------------------------
-  *
-  * TclCompileIncrCmd --
-  *
-  *      Procedure called to compile the "incr" command.
-  *
-  * Results:
-  *      The return value is a standard Tcl result, which is TCL_OK if
-  *      compilation was successful. If an error occurs then the
-  *      interpreter's result contains a standard error message and TCL_ERROR
-  *      is returned. If the command is too complex for TclCompileIncrCmd,
-  *      TCL_OUT_LINE_COMPILE is returned indicating that the incr command
-  *      should be compiled "out of line" by emitting code to invoke its
-  *      command procedure 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 "incr" command
-  *      at runtime.
-  *
-  *----------------------------------------------------------------------
-  */
- int
- TclCompileIncrCmd(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 *varTokenPtr, *incrTokenPtr;
-     Tcl_Parse elemParse;
-     int gotElemParse = 0;
-     char *name, *elName, *p;
-     int nameChars, elNameChars, haveImmValue, immValue, localIndex, i, code;
-     int maxDepth = 0;
-     char buffer[160];
-     envPtr->maxStackDepth = 0;
-     if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
-         Tcl_ResetResult(interp);
-         Tcl_AppendToObj(Tcl_GetObjResult(interp),
-                 "wrong # args: should be \"incr varName ?increment?\"", -1);
-         return TCL_ERROR;
-     }
-     name = NULL;
-     elName = NULL;
-     elNameChars = 0;
-     localIndex = -1;
-     code = TCL_OK;
-     varTokenPtr = parsePtr->tokenPtr
-             + (parsePtr->tokenPtr->numComponents + 1);
-     /*
-      * Check not only that the type is TCL_TOKEN_SIMPLE_WORD, but whether
-      * curly braces surround the variable name.
-      * This really matters for array elements to handle things like
-      *    set {x($foo)} 5
-      * which raises an undefined var error if we are not careful here.
-      * This goes with the hack in TclCompileSetCmd.
-      */
-     if ((varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) &&
-             (varTokenPtr->start[0] != '{')) {
-         /*
-          * A simple variable name. Divide it up into "name" and "elName"
-          * strings. If it is not a local variable, look it up at runtime.
-          */
-         name = varTokenPtr[1].start;
-         nameChars = varTokenPtr[1].size;
-         for (i = 0, p = name;  i < nameChars;  i++, p++) {
-             if (*p == '(') {
-                 char *openParen = p;
-                 p = (name + nameChars-1);
-                 if (*p == ')') { /* last char is ')' => array reference */
-                     nameChars = (openParen - name);
-                     elName = openParen+1;
-                     elNameChars = (p - elName);
-                 }
-                 break;
-             }
-         }
-         if (envPtr->procPtr != NULL) {
-             localIndex = TclFindCompiledLocal(name, nameChars,
-                     /*create*/ 0, /*flags*/ 0, envPtr->procPtr);
-             if (localIndex > 255) {           /* we'll push the name */
-                 localIndex = -1;
-             }
-         }
-         if (localIndex < 0) {
-             TclEmitPush(TclRegisterLiteral(envPtr, name, nameChars,
-                         /*onHeap*/ 0), envPtr);
-             maxDepth = 1;
-         }
-         /*
-          * Compile the element script, if any.
-          */
-         if (elName != NULL) {
-             /*
-              * Temporarily replace the '(' and ')' by '"'s.
-              */
-             *(elName-1) = '"';
-             *(elName+elNameChars) = '"';
-             code = Tcl_ParseCommand(interp, elName-1, elNameChars+2,
-                     /*nested*/ 0, &elemParse);
-             *(elName-1) = '(';
-             *(elName+elNameChars) = ')';
-             gotElemParse = 1;
-             if ((code != TCL_OK) || (elemParse.numWords > 1)) {
-                 sprintf(buffer, "\n    (parsing index for array \"%.*s\")",
-                         TclMin(nameChars, 100), name);
-                 Tcl_AddObjErrorInfo(interp, buffer, -1);
-                 code = TCL_ERROR;
-                 goto done;
-             } else if (elemParse.numWords == 1) {
-                 code = TclCompileTokens(interp, elemParse.tokenPtr+1,
-                         elemParse.tokenPtr->numComponents, envPtr);
-                 if (code != TCL_OK) {
-                     goto done;
-                 }
-                 maxDepth += envPtr->maxStackDepth;
-             } else {
-                 TclEmitPush(TclRegisterLiteral(envPtr, "", 0,
-                         /*alreadyAlloced*/ 0), envPtr);
-                 maxDepth += 1;
-             }
-         }
-     } else {
-         /*
-          * Not a simple variable name. Look it up at runtime.
-          */
-         code = TclCompileTokens(interp, varTokenPtr+1,
-                 varTokenPtr->numComponents, envPtr);
-         if (code != TCL_OK) {
-             goto done;
-         }
-         maxDepth = envPtr->maxStackDepth;
-     }
-     /*
-      * If an increment is given, push it, but see first if it's a small
-      * integer.
-      */
-     haveImmValue = 0;
-     immValue = 0;
-     if (parsePtr->numWords == 3) {
-         incrTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
-         if (incrTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-             char *word = incrTokenPtr[1].start;
-             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
-              * TclGetLong do not have any dependencies on shared strings so we
-              * should be safe.
-              */
-             word[numBytes] = '\0';
-             if (TclLooksLikeInt(word, numBytes)
-                     && (TclGetLong((Tcl_Interp *) NULL, word, &n) == TCL_OK)) {
-                 if ((-127 <= n) && (n <= 127)) {
-                     haveImmValue = 1;
-                     immValue = n;
-                 }
-             }
-             word[numBytes] = savedChar;
-             if (!haveImmValue) {
-                 TclEmitPush(TclRegisterLiteral(envPtr, word, numBytes,
-                        /*onHeap*/ 0), envPtr);
-                 maxDepth += 1;
-             }
-         } else {
-             code = TclCompileTokens(interp, incrTokenPtr+1,
-                     incrTokenPtr->numComponents, envPtr);
-             if (code != TCL_OK) {
-                 if (code == TCL_ERROR) {
-                     Tcl_AddObjErrorInfo(interp,
-                             "\n    (increment expression)", -1);
-                 }
-                 goto done;
-             }
-             maxDepth += envPtr->maxStackDepth;
-         }
-     } else {                    /* no incr amount given so use 1 */
-         haveImmValue = 1;
-         immValue = 1;
-     }
-     /*
-      * Emit the instruction to increment the variable.
-      */
-     if (name != NULL) {
-         if (elName == NULL) {
-             if (localIndex >= 0) {
-                 if (haveImmValue) {
-                     TclEmitInstInt1(INST_INCR_SCALAR1_IMM, localIndex,
-                                     envPtr);
-                     TclEmitInt1(immValue, envPtr);
-                 } else {
-                     TclEmitInstInt1(INST_INCR_SCALAR1, localIndex, envPtr);
-                 }
-             } else {
-                 if (haveImmValue) {
-                     TclEmitInstInt1(INST_INCR_SCALAR_STK_IMM, immValue,
-                                    envPtr);
-                 } else {
-                     TclEmitOpcode(INST_INCR_SCALAR_STK, envPtr);
-                 }
-             }
-         } else {
-             if (localIndex >= 0) {
-                 if (haveImmValue) {
-                     TclEmitInstInt1(INST_INCR_ARRAY1_IMM, localIndex,
-                                     envPtr);
-                     TclEmitInt1(immValue, envPtr);
-                 } else {
-                     TclEmitInstInt1(INST_INCR_ARRAY1, localIndex, envPtr);
-                 }
-             } else {
-                 if (haveImmValue) {
-                     TclEmitInstInt1(INST_INCR_ARRAY_STK_IMM, immValue,
-                                    envPtr);
-                 } else {
-                     TclEmitOpcode(INST_INCR_ARRAY_STK, envPtr);
-                 }
-             }
-         }
-     } else {                    /* non-simple variable name */
-         if (haveImmValue) {
-             TclEmitInstInt1(INST_INCR_STK_IMM, immValue, envPtr);
-         } else {
-             TclEmitOpcode(INST_INCR_STK, envPtr);
-         }
-     }
-     done:
-     if (gotElemParse) {
-         Tcl_FreeParse(&elemParse);
-     }
-     envPtr->maxStackDepth = maxDepth;
-     return code;
- }
- /*
-  *----------------------------------------------------------------------
-  *
-  * TclCompileSetCmd --
-  *
-  *      Procedure called to compile the "set" 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 set command requires a second level of
-  *      substitutions, TCL_OUT_LINE_COMPILE is returned indicating that the
-  *      set command should be compiled "out of line" by emitting code to
-  *      invoke its command procedure (Tcl_SetCmd) 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 "set" command
-  *      at runtime.
-  *
-  *----------------------------------------------------------------------
-  */
- int
- TclCompileSetCmd(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 *varTokenPtr, *valueTokenPtr;
-     Tcl_Parse elemParse;
-     int gotElemParse = 0;
-     register char *p;
-     char *name, *elName;
-     int nameChars, elNameChars;
-     register int i, n;
-     int isAssignment, simpleVarName, localIndex, numWords;
-     int maxDepth = 0;
-     int code = TCL_OK;
-     envPtr->maxStackDepth = 0;
-     numWords = parsePtr->numWords;
-     if ((numWords != 2) && (numWords != 3)) {
-         Tcl_ResetResult(interp);
-         Tcl_AppendToObj(Tcl_GetObjResult(interp),
-                 "wrong # args: should be \"set varName ?newValue?\"", -1);
-         return TCL_ERROR;
-     }
-     isAssignment = (numWords == 3);
-     /*
-      * 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.
-      */
-     simpleVarName = 0;
-     name = elName = NULL;
-     nameChars = elNameChars = 0;
-     localIndex = -1;
-     varTokenPtr = parsePtr->tokenPtr
-             + (parsePtr->tokenPtr->numComponents + 1);
-     /*
-      * Check not only that the type is TCL_TOKEN_SIMPLE_WORD, but whether
-      * curly braces surround the variable name.
-      * This really matters for array elements to handle things like
-      *    set {x($foo)} 5
-      * which raises an undefined var error if we are not careful here.
-      * This goes with the hack in TclCompileIncrCmd.
-      */
-     if ((varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) &&
-             (varTokenPtr->start[0] != '{')) {
-         simpleVarName = 1;
-         name = varTokenPtr[1].start;
-         nameChars = varTokenPtr[1].size;
-         /* last char is ')' => potential array reference */
-         if ( *(name + nameChars - 1) == ')') {
-             for (i = 0, p = name;  i < nameChars;  i++, p++) {
-                 if (*p == '(') {
-                     elName = p + 1;
-                     elNameChars = nameChars - i - 2;
-                     nameChars = i ;
-                     break;
-                 }
-             }
-         }
-         /*
-          * If elName contains any double quotes ("), we can't inline
-          * compile the element script using the replace '()' by '"'
-          * technique below.
-          */
-         for (i = 0, p = elName;  i < elNameChars;  i++, p++) {
-             if (*p == '"') {
-                 simpleVarName = 0;
-                 break;
-             }
-         }
-     } else if (((n = varTokenPtr->numComponents) > 1)
-             && (varTokenPtr[1].type == TCL_TOKEN_TEXT)
-             && (varTokenPtr[n].type == TCL_TOKEN_TEXT)
-             && (varTokenPtr[n].start[varTokenPtr[n].size - 1] == ')')) {
-         simpleVarName = 0;
-         /*
-          * Check for parentheses inside first token
-          */
-         for (i = 0, p = varTokenPtr[1].start;
-              i < varTokenPtr[1].size; i++, p++) {
-             if (*p == '(') {
-                 simpleVarName = 1;
-                 break;
-             }
-         }
-         if (simpleVarName) {
-             name = varTokenPtr[1].start;
-             nameChars = p - varTokenPtr[1].start;
-             elName = p + 1;
-             elNameChars = (varTokenPtr[n].start - p) + varTokenPtr[n].size - 2;
-             /*
-              * If elName contains any double quotes ("), we can't inline
-              * compile the element script using the replace '()' by '"'
-              * technique below.
-              */
-             for (i = 0, p = elName;  i < elNameChars;  i++, p++) {
-                 if (*p == '"') {
-                     simpleVarName = 0;
-                     break;
-                 }
-             }
-         }
-     }
-     if (simpleVarName) {
-         /*
-          * See whether name has any namespace separators (::'s).
-          */
-         int hasNsQualifiers = 0;
-         for (i = 0, p = name;  i < nameChars;  i++, p++) {
-             if ((*p == ':') && ((i+1) < nameChars) && (*(p+1) == ':')) {
-                 hasNsQualifiers = 1;
-                 break;
-             }
-         }
-         /*
-          * Look up the var name's index in the array of local vars in the
-          * proc frame. If retrieving the var's value and it doesn't already
-          * exist, push its name and look it up at runtime.
-          */
-         if ((envPtr->procPtr != NULL) && !hasNsQualifiers) {
-             localIndex = TclFindCompiledLocal(name, nameChars,
-                     /*create*/ isAssignment,
-                     /*flags*/ ((elName==NULL)? VAR_SCALAR : VAR_ARRAY),
-                     envPtr->procPtr);
-         }
-         if (localIndex >= 0) {
-             maxDepth = 0;
-         } else {
-             TclEmitPush(TclRegisterLiteral(envPtr, name, nameChars,
-                     /*onHeap*/ 0), envPtr);
-             maxDepth = 1;
-         }
-         /*
-          * Compile the element script, if any.
-          */
-         if (elName != NULL) {
-             /*
-              * Temporarily replace the '(' and ')' by '"'s.
-              */
-             *(elName-1) = '"';
-             *(elName+elNameChars) = '"';
-             code = Tcl_ParseCommand(interp, elName-1, elNameChars+2,
-                     /*nested*/ 0, &elemParse);
-             *(elName-1) = '(';
-             *(elName+elNameChars) = ')';
-             gotElemParse = 1;
-             if ((code != TCL_OK) || (elemParse.numWords > 1)) {
-                 char buffer[160];
-                 sprintf(buffer, "\n    (parsing index for array \"%.*s\")",
-                         TclMin(nameChars, 100), name);
-                 Tcl_AddObjErrorInfo(interp, buffer, -1);
-                 code = TCL_ERROR;
-                 goto done;
-             } else if (elemParse.numWords == 1) {
-                 code = TclCompileTokens(interp, elemParse.tokenPtr+1,
-                         elemParse.tokenPtr->numComponents, envPtr);
-                 if (code != TCL_OK) {
-                     goto done;
-                 }
-                 maxDepth += envPtr->maxStackDepth;
-             } else {
-                 TclEmitPush(TclRegisterLiteral(envPtr, "", 0,
-                         /*alreadyAlloced*/ 0), envPtr);
-                 maxDepth += 1;
-             }
-         }
-     } else {
-         /*
-          * The var name isn't simple: compile and push it.
-          */
-         code = TclCompileTokens(interp, varTokenPtr+1,
-                 varTokenPtr->numComponents, envPtr);
-         if (code != TCL_OK) {
-             goto done;
-         }
-         maxDepth += envPtr->maxStackDepth;
-     }
-     /*
-      * If we are doing an assignment, push the new value.
-      */
-     if (isAssignment) {
-         valueTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
-         if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-             TclEmitPush(TclRegisterLiteral(envPtr, valueTokenPtr[1].start,
-                     valueTokenPtr[1].size, /*onHeap*/ 0), envPtr);
-             maxDepth += 1;
-         } else {
-             code = TclCompileTokens(interp, valueTokenPtr+1,
-                     valueTokenPtr->numComponents, envPtr);
-             if (code != TCL_OK) {
-                 goto done;
-             }
-             maxDepth += envPtr->maxStackDepth;
-         }
-     }
-     /*
-      * Emit instructions to set/get the variable.
-      */
-     if (simpleVarName) {
-         if (elName == NULL) {
-             if (localIndex >= 0) {
-                 if (localIndex <= 255) {
-                     TclEmitInstInt1((isAssignment?
-                             INST_STORE_SCALAR1 : INST_LOAD_SCALAR1),
-                             localIndex, envPtr);
-                 } else {
-                     TclEmitInstInt4((isAssignment?
-                             INST_STORE_SCALAR4 : INST_LOAD_SCALAR4),
-                             localIndex, envPtr);
-                 }
-             } else {
-                 TclEmitOpcode((isAssignment?
-                         INST_STORE_SCALAR_STK : INST_LOAD_SCALAR_STK),
-                         envPtr);
-             }
-         } else {
-             if (localIndex >= 0) {
-                 if (localIndex <= 255) {
-                     TclEmitInstInt1((isAssignment?
-                             INST_STORE_ARRAY1 : INST_LOAD_ARRAY1),
-                             localIndex, envPtr);
-                 } else {
-                     TclEmitInstInt4((isAssignment?
-                             INST_STORE_ARRAY4 : INST_LOAD_ARRAY4),
-                             localIndex, envPtr);
-                 }
-             } else {
-                 TclEmitOpcode((isAssignment?
-                         INST_STORE_ARRAY_STK : INST_LOAD_ARRAY_STK),
-                         envPtr);
-             }
-         }
-     } else {
-         TclEmitOpcode((isAssignment? INST_STORE_STK : INST_LOAD_STK),
-                 envPtr);
-     }
-     done:
-     if (gotElemParse) {
-         Tcl_FreeParse(&elemParse);
-     }
-     envPtr->maxStackDepth = maxDepth;
-     return code;
- }
- /*
-  *----------------------------------------------------------------------
-  *
-  * TclCompileWhileCmd --
-  *
-  *      Procedure called to compile the "while" command.
-  *
-  * Results:
-  *      The return value is a standard Tcl result, which is TCL_OK if
-  *      compilation was successful. If an error occurs then the
-  *      interpreter's result contains a standard error message and TCL_ERROR
-  *      is returned. If compilation failed because the command is too
-  *      complex for TclCompileWhileCmd, TCL_OUT_LINE_COMPILE is returned
-  *      indicating that the while command should be compiled "out of line"
-  *      by emitting code to invoke its command procedure at runtime.
-  *
-  *      envPtr->maxStackDepth is updated with the maximum number of stack
-  *      elements needed to execute the "while" command.
-  *
-  * Side effects:
-  *      Instructions are added to envPtr to execute the "while" command
-  *      at runtime.
-  *
-  *----------------------------------------------------------------------
-  */
- int
- TclCompileWhileCmd(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 *testTokenPtr, *bodyTokenPtr;
-     JumpFixup jumpFalseFixup;
-     unsigned char *jumpPc;
-     int testCodeOffset, jumpDist, jumpBackDist, jumpBackOffset;
-     int range, maxDepth, code;
-     char buffer[32 + TCL_INTEGER_SPACE];
-     envPtr->maxStackDepth = 0;
-     maxDepth = 0;
-     if (parsePtr->numWords != 3) {
-         Tcl_ResetResult(interp);
-         Tcl_AppendToObj(Tcl_GetObjResult(interp),
-                 "wrong # args: should be \"while test command\"", -1);
-         return TCL_ERROR;
-     }
-     /*
-      * If the test expression requires substitutions, don't compile the
-      * while command inline. E.g., the expression might cause the loop to
-      * never execute or execute forever, as in "while "$x < 5" {}".
-      */
-     testTokenPtr = parsePtr->tokenPtr
-             + (parsePtr->tokenPtr->numComponents + 1);
-     if (testTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-         return TCL_OUT_LINE_COMPILE;
-     }
-     /*
-      * Create a ExceptionRange record for the loop body. This is used to
-      * implement break and continue.
-      */
-     envPtr->exceptDepth++;
-     envPtr->maxExceptDepth =
-         TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
-     range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
-     envPtr->exceptArrayPtr[range].continueOffset =
-             (envPtr->codeNext - envPtr->codeStart);
-     /*
-      * Compile the test expression then emit the conditional jump that
-      * terminates the while. We already know it's a simple word.
-      */
-     testCodeOffset = (envPtr->codeNext - envPtr->codeStart);
-     envPtr->exceptArrayPtr[range].continueOffset = testCodeOffset;
-     code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
-     if (code != TCL_OK) {
-         if (code == TCL_ERROR) {
-             Tcl_AddObjErrorInfo(interp,
-                     "\n    (\"while\" test expression)", -1);
-         }
-         goto error;
-     }
-     maxDepth = envPtr->maxStackDepth;
-     TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);
-     /*
-      * Compile the loop body.
-      */
-     bodyTokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1);
-     envPtr->exceptArrayPtr[range].codeOffset =
-             (envPtr->codeNext - envPtr->codeStart);
-     code = TclCompileCmdWord(interp, bodyTokenPtr+1,
-             bodyTokenPtr->numComponents, envPtr);
-     if (code != TCL_OK) {
-         if (code == TCL_ERROR) {
-             sprintf(buffer, "\n    (\"while\" body line %d)",
-                     interp->errorLine);
-             Tcl_AddObjErrorInfo(interp, buffer, -1);
-         }
-         goto error;
-     }
-     maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
-     envPtr->exceptArrayPtr[range].numCodeBytes =
-             (envPtr->codeNext - envPtr->codeStart)
-             - envPtr->exceptArrayPtr[range].codeOffset;
-     TclEmitOpcode(INST_POP, envPtr);
-     /*
-      * Jump back to the test at the top of the loop. Generate a 4 byte jump
-      * if the distance to the test is > 120 bytes. This is conservative and
-      * ensures that we won't have to replace this jump if we later need to
-      * replace the ifFalse jump with a 4 byte jump.
-      */
-     jumpBackOffset = (envPtr->codeNext - envPtr->codeStart);
-     jumpBackDist = (jumpBackOffset - testCodeOffset);
-     if (jumpBackDist > 120) {
-         TclEmitInstInt4(INST_JUMP4, -jumpBackDist, envPtr);
-     } else {
-         TclEmitInstInt1(INST_JUMP1, -jumpBackDist, envPtr);
-     }
-     /*
-      * Fix the target of the jumpFalse after the test.
-      */
-     jumpDist = (envPtr->codeNext - envPtr->codeStart)
-             - jumpFalseFixup.codeOffset;
-     if (TclFixupForwardJump(envPtr, &jumpFalseFixup, jumpDist, 127)) {
-         /*
-          * Update the loop body's starting PC offset since it moved down.
-          */
-         envPtr->exceptArrayPtr[range].codeOffset += 3;
-         /*
-          * Update the jump back to the test at the top of the loop since it
-          * also moved down 3 bytes.
-          */
-         jumpBackOffset += 3;
-         jumpPc = (envPtr->codeStart + jumpBackOffset);
-         jumpBackDist += 3;
-         if (jumpBackDist > 120) {
-             TclUpdateInstInt4AtPc(INST_JUMP4, -jumpBackDist, jumpPc);
-         } else {
-             TclUpdateInstInt1AtPc(INST_JUMP1, -jumpBackDist, jumpPc);
-         }
-     }
-     /*
-      * Set the loop's break target.
-      */
-     envPtr->exceptArrayPtr[range].breakOffset =
-             (envPtr->codeNext - envPtr->codeStart);
-     /*
-      * The while command's result is an empty string.
-      */
-     TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr);
-     if (maxDepth == 0) {
-         maxDepth = 1;
-     }
-     envPtr->maxStackDepth = maxDepth;
-     envPtr->exceptDepth--;
-     return TCL_OK;
-     error:
-     envPtr->maxStackDepth = maxDepth;
-     envPtr->exceptDepth--;
-     return code;
- }
- /* $History: tclcompcmds.c $
-  *
-  * *****************  Version 1  *****************
-  * User: Dtashley     Date: 1/02/01    Time: 1:28a
-  * Created in $/IjuScripter, IjuConsole/Source/Tcl Base
-  * Initial check-in.
-  */
- /* End of TCLCOMPCMDS.C */
+ /* $Header$ */
+ /*
+  * tclCompCmds.c --
+  *
+  *      This file contains compilation procedures that compile various
+  *      Tcl commands into a sequence of instructions ("bytecodes").
+  *
+  * Copyright (c) 1997-1998 Sun Microsystems, Inc.
+  *
+  * 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.1.1.1 2001/06/13 04:35:34 dtashley Exp $
+  */
+ #include "tclInt.h"
+ #include "tclCompile.h"
+ /*
+  * Prototypes for procedures defined later in this file:
+  */
+ static ClientData       DupForeachInfo _ANSI_ARGS_((ClientData clientData));
+ static void             FreeForeachInfo _ANSI_ARGS_((
+                             ClientData clientData));
+ /*
+  * The structures below define the AuxData types defined in this file.
+  */
+ AuxDataType tclForeachInfoType = {
+     "ForeachInfo",                              /* name */
+     DupForeachInfo,                             /* dupProc */
+     FreeForeachInfo                             /* freeProc */
+ };
+ /*
+  *----------------------------------------------------------------------
+  *
+  * TclCompileBreakCmd --
+  *
+  *      Procedure called to compile the "break" command.
+  *
+  * Results:
+  *      The return value is a standard Tcl result, which is TCL_OK unless
+  *      there was an error during compilation. If an error occurs then
+  *      the interpreter's result contains a standard error message.
+  *
+  *      envPtr->maxStackDepth is updated with the maximum number of stack
+  *      elements needed to execute the command.
+  *
+  * Side effects:
+  *      Instructions are added to envPtr to execute the "break" command
+  *      at runtime.
+  *
+  *----------------------------------------------------------------------
+  */
+ int
+ TclCompileBreakCmd(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 (parsePtr->numWords != 1) {
+         Tcl_ResetResult(interp);
+         Tcl_AppendToObj(Tcl_GetObjResult(interp),
+                 "wrong # args: should be \"break\"", -1);
+         envPtr->maxStackDepth = 0;
+         return TCL_ERROR;
+     }
+     /*
+      * Emit a break instruction.
+      */
+     TclEmitOpcode(INST_BREAK, envPtr);
+     envPtr->maxStackDepth = 0;
+     return TCL_OK;
+ }
+ /*
+  *----------------------------------------------------------------------
+  *
+  * TclCompileCatchCmd --
+  *
+  *      Procedure called to compile the "catch" command.
+  *
+  * Results:
+  *      The return value is a standard Tcl result, which is TCL_OK if
+  *      compilation was successful. If an error occurs then the
+  *      interpreter's result contains a standard error message and TCL_ERROR
+  *      is returned. If the command is too complex for TclCompileCatchCmd,
+  *      TCL_OUT_LINE_COMPILE is returned indicating that the catch command
+  *      should be compiled "out of line" by emitting code to invoke its
+  *      command procedure at runtime.
+  *
+  *      envPtr->maxStackDepth is updated with the maximum number of stack
+  *      elements needed to execute the command.
+  *
+  * Side effects:
+  *      Instructions are added to envPtr to execute the "catch" command
+  *      at runtime.
+  *
+  *----------------------------------------------------------------------
+  */
+ int
+ TclCompileCatchCmd(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. */
+ {
+     JumpFixup jumpFixup;
+     Tcl_Token *cmdTokenPtr, *nameTokenPtr;
+     char *name;
+     int localIndex, nameChars, range, maxDepth, startOffset, jumpDist;
+     int code;
+     char buffer[32 + TCL_INTEGER_SPACE];
+     envPtr->maxStackDepth = 0;
+     if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
+         Tcl_ResetResult(interp);
+         Tcl_AppendToObj(Tcl_GetObjResult(interp),
+                 "wrong # args: should be \"catch command ?varName?\"", -1);
+         return TCL_ERROR;
+     }
+     /*
+      * If a variable was specified and the catch command is at global level
+      * (not in a procedure), don't compile it inline: the payoff is
+      * too small.
+      */
+     if ((parsePtr->numWords == 3) && (envPtr->procPtr == NULL)) {
+         return TCL_OUT_LINE_COMPILE;
+     }
+     /*
+      * Make sure the variable name, if any, has no substitutions and just
+      * refers to a local scaler.
+      */
+     localIndex = -1;
+     cmdTokenPtr = parsePtr->tokenPtr
+             + (parsePtr->tokenPtr->numComponents + 1);
+     if (parsePtr->numWords == 3) {
+         nameTokenPtr = cmdTokenPtr + (cmdTokenPtr->numComponents + 1);
+         if (nameTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+             name = nameTokenPtr[1].start;
+             nameChars = nameTokenPtr[1].size;
+             if (!TclIsLocalScalar(name, nameChars)) {
+                 return TCL_OUT_LINE_COMPILE;
+             }
+             localIndex = TclFindCompiledLocal(nameTokenPtr[1].start,
+                     nameTokenPtr[1].size, /*create*/ 1,
+                     /*flags*/ VAR_SCALAR, envPtr->procPtr);
+         } else {
+            return TCL_OUT_LINE_COMPILE;
+         }
+     }
+     /*
+      * We will compile the catch command. Emit a beginCatch instruction at
+      * the start of the catch body: the subcommand it controls.
+      */
+     maxDepth = 0;
+     envPtr->exceptDepth++;
+     envPtr->maxExceptDepth =
+         TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
+     range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+     TclEmitInstInt4(INST_BEGIN_CATCH4, range, envPtr);
+     startOffset = (envPtr->codeNext - envPtr->codeStart);
+     envPtr->exceptArrayPtr[range].codeOffset = startOffset;
+     code = TclCompileCmdWord(interp, cmdTokenPtr+1,
+             cmdTokenPtr->numComponents, envPtr);
+     if (code != TCL_OK) {
+         if (code == TCL_ERROR) {
+             sprintf(buffer, "\n    (\"catch\" body line %d)",
+                     interp->errorLine);
+             Tcl_AddObjErrorInfo(interp, buffer, -1);
+         }
+         goto done;
+     }
+     maxDepth = envPtr->maxStackDepth;
+     envPtr->exceptArrayPtr[range].numCodeBytes =
+             (envPtr->codeNext - envPtr->codeStart) - startOffset;
+     /*
+      * The "no errors" epilogue code: store the body's result into the
+      * variable (if any), push "0" (TCL_OK) as the catch's "no error"
+      * result, and jump around the "error case" code.
+      */
+     if (localIndex != -1) {
+         if (localIndex <= 255) {
+             TclEmitInstInt1(INST_STORE_SCALAR1, localIndex, envPtr);
+         } else {
+             TclEmitInstInt4(INST_STORE_SCALAR4, localIndex, envPtr);
+         }
+     }
+     TclEmitOpcode(INST_POP, envPtr);
+     TclEmitPush(TclRegisterLiteral(envPtr, "0", 1, /*onHeap*/ 0),
+             envPtr);
+     if (maxDepth == 0) {
+         maxDepth = 1;
+     }
+     TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
+     /*
+      * The "error case" code: store the body's result into the variable (if
+      * any), then push the error result code. The initial PC offset here is
+      * the catch's error target.
+      */
+     envPtr->exceptArrayPtr[range].catchOffset =
+             (envPtr->codeNext - envPtr->codeStart);
+     if (localIndex != -1) {
+         TclEmitOpcode(INST_PUSH_RESULT, envPtr);
+         if (localIndex <= 255) {
+             TclEmitInstInt1(INST_STORE_SCALAR1, localIndex, envPtr);
+         } else {
+             TclEmitInstInt4(INST_STORE_SCALAR4, localIndex, envPtr);
+         }
+         TclEmitOpcode(INST_POP, envPtr);
+     }
+     TclEmitOpcode(INST_PUSH_RETURN_CODE, envPtr);
+     /*
+      * Update the target of the jump after the "no errors" code, then emit
+      * an endCatch instruction at the end of the catch command.
+      */
+     jumpDist = (envPtr->codeNext - envPtr->codeStart)
+             - jumpFixup.codeOffset;
+     if (TclFixupForwardJump(envPtr, &jumpFixup, jumpDist, 127)) {
+         panic("TclCompileCatchCmd: bad jump distance %d\n", jumpDist);
+     }
+     TclEmitOpcode(INST_END_CATCH, envPtr);
+     done:
+     envPtr->exceptDepth--;
+     envPtr->maxStackDepth = maxDepth;
+     return code;
+ }
+ /*
+  *----------------------------------------------------------------------
+  *
+  * TclCompileContinueCmd --
+  *
+  *      Procedure called to compile the "continue" command.
+  *
+  * Results:
+  *      The return value is a standard Tcl result, which is TCL_OK unless
+  *      there was an error while parsing string. If an error occurs then
+  *      the interpreter's result contains a standard error message.
+  *
+  *      envPtr->maxStackDepth is updated with the maximum number of stack
+  *      elements needed to execute the command.
+  *
+  * Side effects:
+  *      Instructions are added to envPtr to execute the "continue" command
+  *      at runtime.
+  *
+  *----------------------------------------------------------------------
+  */
+ int
+ TclCompileContinueCmd(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. */
+ {
+     /*
+      * There should be no argument after the "continue".
+      */
+     if (parsePtr->numWords != 1) {
+         Tcl_ResetResult(interp);
+         Tcl_AppendToObj(Tcl_GetObjResult(interp),
+                 "wrong # args: should be \"continue\"", -1);
+         envPtr->maxStackDepth = 0;
+         return TCL_ERROR;
+     }
+     /*
+      * Emit a continue instruction.
+      */
+     TclEmitOpcode(INST_CONTINUE, envPtr);
+     envPtr->maxStackDepth = 0;
+     return TCL_OK;
+ }
+ /*
+  *----------------------------------------------------------------------
+  *
+  * TclCompileExprCmd --
+  *
+  *      Procedure called to compile the "expr" command.
+  *
+  * Results:
+  *      The return value is a standard Tcl result, which is TCL_OK
+  *      unless there was an error while parsing string. If an error occurs
+  *      then the interpreter's result contains a standard error message.
+  *
+  *      envPtr->maxStackDepth is updated with the maximum number of stack
+  *      elements needed to execute the "expr" command.
+  *
+  * Side effects:
+  *      Instructions are added to envPtr to execute the "expr" command
+  *      at runtime.
+  *
+  *----------------------------------------------------------------------
+  */
+ int
+ TclCompileExprCmd(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 *firstWordPtr;
+     envPtr->maxStackDepth = 0;
+     if (parsePtr->numWords == 1) {
+         Tcl_ResetResult(interp);
+         Tcl_AppendToObj(Tcl_GetObjResult(interp),
+                 "wrong # args: should be \"expr arg ?arg ...?\"", -1);
+         return TCL_ERROR;
+     }
+     firstWordPtr = parsePtr->tokenPtr
+             + (parsePtr->tokenPtr->numComponents + 1);
+     return TclCompileExprWords(interp, firstWordPtr, (parsePtr->numWords-1),
+             envPtr);
+ }
+ /*
+  *----------------------------------------------------------------------
+  *
+  * TclCompileForCmd --
+  *
+  *      Procedure called to compile the "for" command.
+  *
+  * Results:
+  *      The return value is a standard Tcl result, which is TCL_OK unless
+  *      there was an error while parsing string. If an error occurs then
+  *      the interpreter's result contains a standard error message.
+  *
+  *      envPtr->maxStackDepth is updated with the maximum number of stack
+  *      elements needed to execute the command.
+  *
+  * Side effects:
+  *      Instructions are added to envPtr to execute the "for" command
+  *      at runtime.
+  *
+  *----------------------------------------------------------------------
+  */
+ int
+ TclCompileForCmd(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 *startTokenPtr, *testTokenPtr, *nextTokenPtr, *bodyTokenPtr;
+     JumpFixup jumpFalseFixup;
+     int maxDepth, jumpBackDist, jumpBackOffset, testCodeOffset, jumpDist;
+     int bodyRange, nextRange, code;
+     unsigned char *jumpPc;
+     char buffer[32 + TCL_INTEGER_SPACE];
+     envPtr->maxStackDepth = 0;
+     if (parsePtr->numWords != 5) {
+         Tcl_ResetResult(interp);
+         Tcl_AppendToObj(Tcl_GetObjResult(interp),
+                 "wrong # args: should be \"for start test next command\"", -1);
+         return TCL_ERROR;
+     }
+     /*
+      * If the test expression requires substitutions, don't compile the for
+      * command inline. E.g., the expression might cause the loop to never
+      * execute or execute forever, as in "for {} "$x > 5" {incr x} {}".
+      */
+     startTokenPtr = parsePtr->tokenPtr
+             + (parsePtr->tokenPtr->numComponents + 1);
+     testTokenPtr = startTokenPtr + (startTokenPtr->numComponents + 1);
+     if (testTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+         return TCL_OUT_LINE_COMPILE;
+     }
+     /*
+      * Create ExceptionRange records for the body and the "next" command.
+      * The "next" command's ExceptionRange supports break but not continue
+      * (and has a -1 continueOffset).
+      */
+     envPtr->exceptDepth++;
+     envPtr->maxExceptDepth =
+             TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
+     bodyRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
+     nextRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
+     /*
+      * Inline compile the initial command.
+      */
+     maxDepth = 0;
+     code = TclCompileCmdWord(interp, startTokenPtr+1,
+             startTokenPtr->numComponents, envPtr);
+     if (code != TCL_OK) {
+         if (code == TCL_ERROR) {
+             Tcl_AddObjErrorInfo(interp,
+                     "\n    (\"for\" initial command)", -1);
+         }
+         goto done;
+     }
+     maxDepth = envPtr->maxStackDepth;
+     TclEmitOpcode(INST_POP, envPtr);
+     /*
+      * Compile the test then emit the conditional jump that exits the for.
+      */
+     testCodeOffset = (envPtr->codeNext - envPtr->codeStart);
+     code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
+     if (code != TCL_OK) {
+         if (code == TCL_ERROR) {
+             Tcl_AddObjErrorInfo(interp,
+                     "\n    (\"for\" test expression)", -1);
+         }
+         goto done;
+     }
+     maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+     TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);
+     /*
+      * Compile the loop body.
+      */
+     nextTokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1);
+     bodyTokenPtr = nextTokenPtr + (nextTokenPtr->numComponents + 1);
+     envPtr->exceptArrayPtr[bodyRange].codeOffset =
+             (envPtr->codeNext - envPtr->codeStart);
+     code = TclCompileCmdWord(interp, bodyTokenPtr+1,
+             bodyTokenPtr->numComponents, envPtr);
+     if (code != TCL_OK) {
+         if (code == TCL_ERROR) {
+             sprintf(buffer, "\n    (\"for\" body line %d)",
+                     interp->errorLine);
+             Tcl_AddObjErrorInfo(interp, buffer, -1);
+         }
+         goto done;
+     }
+     maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+     envPtr->exceptArrayPtr[bodyRange].numCodeBytes =
+             (envPtr->codeNext - envPtr->codeStart)
+             - envPtr->exceptArrayPtr[bodyRange].codeOffset;
+     TclEmitOpcode(INST_POP, envPtr);
+     /*
+      * Compile the "next" subcommand.
+      */
+     envPtr->exceptArrayPtr[bodyRange].continueOffset =
+             (envPtr->codeNext - envPtr->codeStart);
+     envPtr->exceptArrayPtr[nextRange].codeOffset =
+             (envPtr->codeNext - envPtr->codeStart);
+     code = TclCompileCmdWord(interp, nextTokenPtr+1,
+             nextTokenPtr->numComponents, envPtr);
+     if (code != TCL_OK) {
+         if (code == TCL_ERROR) {
+             Tcl_AddObjErrorInfo(interp,
+                     "\n    (\"for\" loop-end command)", -1);
+         }
+         goto done;
+     }
+     maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+     envPtr->exceptArrayPtr[nextRange].numCodeBytes =
+             (envPtr->codeNext - envPtr->codeStart)
+             - envPtr->exceptArrayPtr[nextRange].codeOffset;
+     TclEmitOpcode(INST_POP, envPtr);
+     /*
+      * Jump back to the test at the top of the loop. Generate a 4 byte jump
+      * if the distance to the test is > 120 bytes. This is conservative and
+      * ensures that we won't have to replace this jump if we later need to
+      * replace the ifFalse jump with a 4 byte jump.
+      */
+     jumpBackOffset = (envPtr->codeNext - envPtr->codeStart);
+     jumpBackDist = (jumpBackOffset - testCodeOffset);
+     if (jumpBackDist > 120) {
+         TclEmitInstInt4(INST_JUMP4, -jumpBackDist, envPtr);
+     } else {
+         TclEmitInstInt1(INST_JUMP1, -jumpBackDist, envPtr);
+     }
+     /*
+      * Fix the target of the jumpFalse after the test.
+      */
+     jumpDist = (envPtr->codeNext - envPtr->codeStart)
+             - jumpFalseFixup.codeOffset;
+     if (TclFixupForwardJump(envPtr, &jumpFalseFixup, jumpDist, 127)) {
+         /*
+          * Update the loop body and "next" command ExceptionRanges since
+          * they moved down.
+          */
+         envPtr->exceptArrayPtr[bodyRange].codeOffset += 3;
+         envPtr->exceptArrayPtr[bodyRange].continueOffset += 3;
+         envPtr->exceptArrayPtr[nextRange].codeOffset += 3;
+         /*
+          * Update the jump back to the test at the top of the loop since it
+          * also moved down 3 bytes.
+          */
+         jumpBackOffset += 3;
+         jumpPc = (envPtr->codeStart + jumpBackOffset);
+         jumpBackDist += 3;
+         if (jumpBackDist > 120) {
+             TclUpdateInstInt4AtPc(INST_JUMP4, -jumpBackDist, jumpPc);
+         } else {
+             TclUpdateInstInt1AtPc(INST_JUMP1, -jumpBackDist, jumpPc);
+         }
+     }
+     /*
+      * Set the loop's break target.
+      */
+     envPtr->exceptArrayPtr[bodyRange].breakOffset =
+             envPtr->exceptArrayPtr[nextRange].breakOffset =
+             (envPtr->codeNext - envPtr->codeStart);
+     /*
+      * The for command's result is an empty string.
+      */
+     TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr);
+     if (maxDepth == 0) {
+         maxDepth = 1;
+     }
+     code = TCL_OK;
+     done:
+     envPtr->maxStackDepth = maxDepth;
+     envPtr->exceptDepth--;
+     return code;
+ }
+ /*
+  *----------------------------------------------------------------------
+  *
+  * TclCompileForeachCmd --
+  *
+  *      Procedure called to compile the "foreach" command.
+  *
+  * Results:
+  *      The return value is a standard Tcl result, which is TCL_OK if
+  *      compilation was successful. If an error occurs then the
+  *      interpreter's result contains a standard error message and TCL_ERROR
+  *      is returned. If the command is too complex for TclCompileForeachCmd,
+  *      TCL_OUT_LINE_COMPILE is returned indicating that the foreach command
+  *      should be compiled "out of line" by emitting code to invoke its
+  *      command procedure at runtime.
+  *
+  *      envPtr->maxStackDepth is updated with the maximum number of stack
+  *      elements needed to execute the "while" command.
+  *
+  * Side effects:
+  *      Instructions are added to envPtr to execute the "foreach" command
+  *      at runtime.
+  *
+  *----------------------------------------------------------------------
+  */
+ int
+ TclCompileForeachCmd(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. */
+ {
+     Proc *procPtr = envPtr->procPtr;
+     ForeachInfo *infoPtr;       /* Points to the structure describing this
+                                  * foreach command. Stored in a AuxData
+                                  * record in the ByteCode. */
+     int firstValueTemp;         /* Index of the first temp var in the frame
+                                  * used to point to a value list. */
+     int loopCtTemp;             /* Index of temp var holding the loop's
+                                  * iteration count. */
+     Tcl_Token *tokenPtr, *bodyTokenPtr;
+     char *varList;
+     unsigned char *jumpPc;
+     JumpFixup jumpFalseFixup;
+     int jumpDist, jumpBackDist, jumpBackOffset, maxDepth, infoIndex, range;
+     int numWords, numLists, numVars, loopIndex, tempVar, i, j, code;
+     char savedChar;
+     char buffer[32 + TCL_INTEGER_SPACE];
+     /*
+      * We parse the variable list argument words and create two arrays:
+      *    varcList[i] is number of variables in i-th var list
+      *    varvList[i] points to array of var names in i-th var list
+      */
+ #define STATIC_VAR_LIST_SIZE 5
+     int varcListStaticSpace[STATIC_VAR_LIST_SIZE];
+     char **varvListStaticSpace[STATIC_VAR_LIST_SIZE];
+     int *varcList = varcListStaticSpace;
+     char ***varvList = varvListStaticSpace;
+     /*
+      * If the foreach command isn't in a procedure, don't compile it inline:
+      * the payoff is too small.
+      */
+     envPtr->maxStackDepth = 0;
+     if (procPtr == NULL) {
+         return TCL_OUT_LINE_COMPILE;
+     }
+     maxDepth = 0;
+     numWords = parsePtr->numWords;
+     if ((numWords < 4) || (numWords%2 != 0)) {
+         Tcl_ResetResult(interp);
+         Tcl_AppendToObj(Tcl_GetObjResult(interp),
+                 "wrong # args: should be \"foreach varList list ?varList list ...? command\"", -1);
+         return TCL_ERROR;
+     }
+     /*
+      * Allocate storage for the varcList and varvList arrays if necessary.
+      */
+     numLists = (numWords - 2)/2;
+     if (numLists > STATIC_VAR_LIST_SIZE) {
+         varcList = (int *) ckalloc(numLists * sizeof(int));
+         varvList = (char ***) ckalloc(numLists * sizeof(char **));
+     }
+     for (loopIndex = 0;  loopIndex < numLists;  loopIndex++) {
+         varcList[loopIndex] = 0;
+         varvList[loopIndex] = (char **) NULL;
+     }
+     /*
+      * Set the exception stack depth.
+      */
+     envPtr->exceptDepth++;
+     envPtr->maxExceptDepth =
+         TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
+     /*
+      * Break up each var list and set the varcList and varvList arrays.
+      * Don't compile the foreach inline if any var name needs substitutions
+      * or isn't a scalar, or if any var list needs substitutions.
+      */
+     loopIndex = 0;
+     for (i = 0, tokenPtr = parsePtr->tokenPtr;
+             i < numWords-1;
+             i++, tokenPtr += (tokenPtr->numComponents + 1)) {
+         if (i%2 == 1) {
+             if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+                 code = TCL_OUT_LINE_COMPILE;
+                 goto done;
+             }
+             varList = tokenPtr[1].start;
+             savedChar = varList[tokenPtr[1].size];
+             /*
+              * Note there is a danger that modifying the string could have
+              * undesirable side effects.  In this case, Tcl_SplitList does
+              * not have any dependencies on shared strings so we should be
+              * safe.
+              */
+             varList[tokenPtr[1].size] = '\0';
+             code = Tcl_SplitList(interp, varList,
+                     &varcList[loopIndex], &varvList[loopIndex]);
+             varList[tokenPtr[1].size] = savedChar;
+             if (code != TCL_OK) {
+                 goto done;
+             }
+             numVars = varcList[loopIndex];
+             for (j = 0;  j < numVars;  j++) {
+                 char *varName = varvList[loopIndex][j];
+                 if (!TclIsLocalScalar(varName, (int) strlen(varName))) {
+                     code = TCL_OUT_LINE_COMPILE;
+                     goto done;
+                 }
+             }
+             loopIndex++;
+         }
+     }
+     /*
+      * We will compile the foreach command.
+      * Reserve (numLists + 1) temporary variables:
+      *    - numLists temps to hold each value list
+      *    - 1 temp for the loop counter (index of next element in each list)
+      * At this time we don't try to reuse temporaries; if there are two
+      * nonoverlapping foreach loops, they don't share any temps.
+      */
+     firstValueTemp = -1;
+     for (loopIndex = 0;  loopIndex < numLists;  loopIndex++) {
+         tempVar = TclFindCompiledLocal(NULL, /*nameChars*/ 0,
+                 /*create*/ 1, /*flags*/ VAR_SCALAR, procPtr);
+         if (loopIndex == 0) {
+             firstValueTemp = tempVar;
+         }
+     }
+     loopCtTemp = TclFindCompiledLocal(NULL, /*nameChars*/ 0,
+             /*create*/ 1, /*flags*/ VAR_SCALAR, procPtr);
+     /*
+      * Create and initialize the ForeachInfo and ForeachVarList data
+      * structures describing this command. Then create a AuxData record
+      * pointing to the ForeachInfo structure.
+      */
+     infoPtr = (ForeachInfo *) ckalloc((unsigned)
+             (sizeof(ForeachInfo) + (numLists * sizeof(ForeachVarList *))));
+     infoPtr->numLists = numLists;
+     infoPtr->firstValueTemp = firstValueTemp;
+     infoPtr->loopCtTemp = loopCtTemp;
+     for (loopIndex = 0;  loopIndex < numLists;  loopIndex++) {
+         ForeachVarList *varListPtr;
+         numVars = varcList[loopIndex];
+         varListPtr = (ForeachVarList *) ckalloc((unsigned)
+                 sizeof(ForeachVarList) + (numVars * sizeof(int)));
+         varListPtr->numVars = numVars;
+         for (j = 0;  j < numVars;  j++) {
+             char *varName = varvList[loopIndex][j];
+             int nameChars = strlen(varName);
+             varListPtr->varIndexes[j] = TclFindCompiledLocal(varName,
+                     nameChars, /*create*/ 1, /*flags*/ VAR_SCALAR, procPtr);
+         }
+         infoPtr->varLists[loopIndex] = varListPtr;
+     }
+     infoIndex = TclCreateAuxData((ClientData) infoPtr, &tclForeachInfoType, envPtr);
+     /*
+      * Evaluate then store each value list in the associated temporary.
+      */
+     range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
+     loopIndex = 0;
+     for (i = 0, tokenPtr = parsePtr->tokenPtr;
+             i < numWords-1;
+             i++, tokenPtr += (tokenPtr->numComponents + 1)) {
+         if ((i%2 == 0) && (i > 0)) {
+             code = TclCompileTokens(interp, tokenPtr+1,
+                     tokenPtr->numComponents, envPtr);
+             if (code != TCL_OK) {
+                 goto done;
+             }
+             maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+             tempVar = (firstValueTemp + loopIndex);
+             if (tempVar <= 255) {
+                 TclEmitInstInt1(INST_STORE_SCALAR1, tempVar, envPtr);
+             } else {
+                 TclEmitInstInt4(INST_STORE_SCALAR4, tempVar, envPtr);
+             }
+             TclEmitOpcode(INST_POP, envPtr);
+             loopIndex++;
+         }
+     }
+     bodyTokenPtr = tokenPtr;
+     /*
+      * Initialize the temporary var that holds the count of loop iterations.
+      */
+     TclEmitInstInt4(INST_FOREACH_START4, infoIndex, envPtr);
+     /*
+      * Top of loop code: assign each loop variable and check whether
+      * to terminate the loop.
+      */
+     envPtr->exceptArrayPtr[range].continueOffset =
+             (envPtr->codeNext - envPtr->codeStart);
+     TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex, envPtr);
+     TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);
+     /*
+      * Inline compile the loop body.
+      */
+     envPtr->exceptArrayPtr[range].codeOffset =
+             (envPtr->codeNext - envPtr->codeStart);
+     code = TclCompileCmdWord(interp, bodyTokenPtr+1,
+             bodyTokenPtr->numComponents, envPtr);
+     if (code != TCL_OK) {
+         if (code == TCL_ERROR) {
+             sprintf(buffer, "\n    (\"foreach\" body line %d)",
+                     interp->errorLine);
+             Tcl_AddObjErrorInfo(interp, buffer, -1);
+         }
+         goto done;
+     }
+     maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+     envPtr->exceptArrayPtr[range].numCodeBytes =
+             (envPtr->codeNext - envPtr->codeStart)
+             - envPtr->exceptArrayPtr[range].codeOffset;
+     TclEmitOpcode(INST_POP, envPtr);
+     /*
+      * Jump back to the test at the top of the loop. Generate a 4 byte jump
+      * if the distance to the test is > 120 bytes. This is conservative and
+      * ensures that we won't have to replace this jump if we later need to
+      * replace the ifFalse jump with a 4 byte jump.
+      */
+     jumpBackOffset = (envPtr->codeNext - envPtr->codeStart);
+     jumpBackDist =
+         (jumpBackOffset - envPtr->exceptArrayPtr[range].continueOffset);
+     if (jumpBackDist > 120) {
+         TclEmitInstInt4(INST_JUMP4, -jumpBackDist, envPtr);
+     } else {
+         TclEmitInstInt1(INST_JUMP1, -jumpBackDist, envPtr);
+     }
+     /*
+      * Fix the target of the jump after the foreach_step test.
+      */
+     jumpDist = (envPtr->codeNext - envPtr->codeStart)
+             - jumpFalseFixup.codeOffset;
+     if (TclFixupForwardJump(envPtr, &jumpFalseFixup, jumpDist, 127)) {
+         /*
+          * Update the loop body's starting PC offset since it moved down.
+          */
+         envPtr->exceptArrayPtr[range].codeOffset += 3;
+         /*
+          * Update the jump back to the test at the top of the loop since it
+          * also moved down 3 bytes.
+          */
+         jumpBackOffset += 3;
+         jumpPc = (envPtr->codeStart + jumpBackOffset);
+         jumpBackDist += 3;
+         if (jumpBackDist > 120) {
+             TclUpdateInstInt4AtPc(INST_JUMP4, -jumpBackDist, jumpPc);
+         } else {
+             TclUpdateInstInt1AtPc(INST_JUMP1, -jumpBackDist, jumpPc);
+         }
+     }
+     /*
+      * Set the loop's break target.
+      */
+     envPtr->exceptArrayPtr[range].breakOffset =
+             (envPtr->codeNext - envPtr->codeStart);
+     /*
+      * The foreach command's result is an empty string.
+      */
+     TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr);
+     if (maxDepth == 0) {
+         maxDepth = 1;
+     }
+     done:
+     for (loopIndex = 0;  loopIndex < numLists;  loopIndex++) {
+         if (varvList[loopIndex] != (char **) NULL) {
+             ckfree((char *) varvList[loopIndex]);
+         }
+     }
+     if (varcList != varcListStaticSpace) {
+         ckfree((char *) varcList);
+         ckfree((char *) varvList);
+     }
+     envPtr->maxStackDepth = maxDepth;
+     envPtr->exceptDepth--;
+     return code;
+ }
+ /*
+  *----------------------------------------------------------------------
+  *
+  * DupForeachInfo --
+  *
+  *      This procedure duplicates a ForeachInfo structure created as
+  *      auxiliary data during the compilation of a foreach command.
+  *
+  * Results:
+  *      A pointer to a newly allocated copy of the existing ForeachInfo
+  *      structure is returned.
+  *
+  * Side effects:
+  *      Storage for the copied ForeachInfo record is allocated. If the
+  *      original ForeachInfo structure pointed to any ForeachVarList
+  *      records, these structures are also copied and pointers to them
+  *      are stored in the new ForeachInfo record.
+  *
+  *----------------------------------------------------------------------
+  */
+ static ClientData
+ DupForeachInfo(clientData)
+     ClientData clientData;      /* The foreach command's compilation
+                                  * auxiliary data to duplicate. */
+ {
+     register ForeachInfo *srcPtr = (ForeachInfo *) clientData;
+     ForeachInfo *dupPtr;
+     register ForeachVarList *srcListPtr, *dupListPtr;
+     int numLists = srcPtr->numLists;
+     int numVars, i, j;
+     dupPtr = (ForeachInfo *) ckalloc((unsigned)
+             (sizeof(ForeachInfo) + (numLists * sizeof(ForeachVarList *))));
+     dupPtr->numLists = numLists;
+     dupPtr->firstValueTemp = srcPtr->firstValueTemp;
+     dupPtr->loopCtTemp = srcPtr->loopCtTemp;
+     for (i = 0;  i < numLists;  i++) {
+         srcListPtr = srcPtr->varLists[i];
+         numVars = srcListPtr->numVars;
+         dupListPtr = (ForeachVarList *) ckalloc((unsigned)
+                 sizeof(ForeachVarList) + numVars*sizeof(int));
+         dupListPtr->numVars = numVars;
+         for (j = 0;  j < numVars;  j++) {
+             dupListPtr->varIndexes[j] = srcListPtr->varIndexes[j];
+         }
+         dupPtr->varLists[i] = dupListPtr;
+     }
+     return (ClientData) dupPtr;
+ }
+ /*
+  *----------------------------------------------------------------------
+  *
+  * FreeForeachInfo --
+  *
+  *      Procedure to free a ForeachInfo structure created as auxiliary data
+  *      during the compilation of a foreach command.
+  *
+  * Results:
+  *      None.
+  *
+  * Side effects:
+  *      Storage for the ForeachInfo structure pointed to by the ClientData
+  *      argument is freed as is any ForeachVarList record pointed to by the
+  *      ForeachInfo structure.
+  *
+  *----------------------------------------------------------------------
+  */
+ static void
+ FreeForeachInfo(clientData)
+     ClientData clientData;      /* The foreach command's compilation
+                                  * auxiliary data to free. */
+ {
+     register ForeachInfo *infoPtr = (ForeachInfo *) clientData;
+     register ForeachVarList *listPtr;
+     int numLists = infoPtr->numLists;
+     register int i;
+     for (i = 0;  i < numLists;  i++) {
+         listPtr = infoPtr->varLists[i];
+         ckfree((char *) listPtr);
+     }
+     ckfree((char *) infoPtr);
+ }
+ /*
+  *----------------------------------------------------------------------
+  *
+  * TclCompileIfCmd --
+  *
+  *      Procedure called to compile the "if" command.
+  *
+  * Results:
+  *      The return value is a standard Tcl result, which is TCL_OK if
+  *      compilation was successful. If an error occurs then the
+  *      interpreter's result contains a standard error message and TCL_ERROR
+  *      is returned. If the command is too complex for TclCompileIfCmd,
+  *      TCL_OUT_LINE_COMPILE is returned indicating that the if command
+  *      should be compiled "out of line" by emitting code to invoke its
+  *      command procedure at runtime.
+  *
+  *      envPtr->maxStackDepth is updated with the maximum number of stack
+  *      elements needed to execute the command.
+  *
+  * Side effects:
+  *      Instructions are added to envPtr to execute the "if" command
+  *      at runtime.
+  *
+  *----------------------------------------------------------------------
+  */
+ int
+ TclCompileIfCmd(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. */
+ {
+     JumpFixupArray jumpFalseFixupArray;
+                                 /* Used to fix the ifFalse jump after each
+                                  * test when its target PC is determined. */
+     JumpFixupArray jumpEndFixupArray;
+                                 /* Used to fix the jump after each "then"
+                                  * body to the end of the "if" when that PC
+                                  * is determined. */
+     Tcl_Token *tokenPtr, *testTokenPtr;
+     int jumpDist, jumpFalseDist, jumpIndex;
+     int numWords, wordIdx, numBytes, maxDepth, j, code;
+     char *word;
+     char buffer[100];
+     TclInitJumpFixupArray(&jumpFalseFixupArray);
+     TclInitJumpFixupArray(&jumpEndFixupArray);
+     maxDepth = 0;
+     code = TCL_OK;
+     /*
+      * Each iteration of this loop compiles one "if expr ?then? body"
+      * or "elseif expr ?then? body" clause.
+      */
+     tokenPtr = parsePtr->tokenPtr;
+     wordIdx = 0;
+     numWords = parsePtr->numWords;
+     while (wordIdx < numWords) {
+         /*
+          * Stop looping if the token isn't "if" or "elseif".
+          */
+         if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+             break;
+         }
+         word = tokenPtr[1].start;
+         numBytes = tokenPtr[1].size;
+         if ((tokenPtr == parsePtr->tokenPtr)
+                 || ((numBytes == 6) && (strncmp(word, "elseif", 6) == 0))) {
+             tokenPtr += (tokenPtr->numComponents + 1);
+             wordIdx++;
+         } else {
+             break;
+         }
+         if (wordIdx >= numWords) {
+             sprintf(buffer,
+                     "wrong # args: no expression after \"%.30s\" argument",
+                     word);
+             Tcl_ResetResult(interp);
+             Tcl_AppendToObj(Tcl_GetObjResult(interp), buffer, -1);
+             code = TCL_ERROR;
+             goto done;
+         }
+         /*
+          * Compile the test expression then emit the conditional jump
+          * around the "then" part. If the expression word isn't simple,
+          * we back off and compile the if command out-of-line.
+          */
+         testTokenPtr = tokenPtr;
+         code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
+         if (code != TCL_OK) {
+             if (code == TCL_ERROR) {
+                 Tcl_AddObjErrorInfo(interp,
+                         "\n    (\"if\" test expression)", -1);
+             }
+             goto done;
+         }
+         maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+         if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) {
+             TclExpandJumpFixupArray(&jumpFalseFixupArray);
+         }
+         jumpIndex = jumpFalseFixupArray.next;
+         jumpFalseFixupArray.next++;
+         TclEmitForwardJump(envPtr, TCL_FALSE_JUMP,
+                 &(jumpFalseFixupArray.fixup[jumpIndex]));
+         /*
+          * Skip over the optional "then" before the then clause.
+          */
+         tokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1);
+         wordIdx++;
+         if (wordIdx >= numWords) {
+             sprintf(buffer, "wrong # args: no script following \"%.20s\" argument", testTokenPtr->start);
+             Tcl_ResetResult(interp);
+             Tcl_AppendToObj(Tcl_GetObjResult(interp), buffer, -1);
+             code = TCL_ERROR;
+             goto done;
+         }
+         if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+             word = tokenPtr[1].start;
+             numBytes = tokenPtr[1].size;
+             if ((numBytes == 4) && (strncmp(word, "then", 4) == 0)) {
+                 tokenPtr += (tokenPtr->numComponents + 1);
+                 wordIdx++;
+                 if (wordIdx >= numWords) {
+                     Tcl_ResetResult(interp);
+                     Tcl_AppendToObj(Tcl_GetObjResult(interp),
+                             "wrong # args: no script following \"then\" argument", -1);
+                     code = TCL_ERROR;
+                     goto done;
+                 }
+             }
+         }
+         /*
+          * Compile the "then" command body.
+          */
+         code = TclCompileCmdWord(interp, tokenPtr+1,
+                 tokenPtr->numComponents, envPtr);
+         if (code != TCL_OK) {
+             if (code == TCL_ERROR) {
+                 sprintf(buffer, "\n    (\"if\" then script line %d)",
+                         interp->errorLine);
+                 Tcl_AddObjErrorInfo(interp, buffer, -1);
+             }
+             goto done;
+         }
+         maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+         /*
+          * Jump to the end of the "if" command. Both jumpFalseFixupArray and
+          * jumpEndFixupArray are indexed by "jumpIndex".
+          */
+         if (jumpEndFixupArray.next >= jumpEndFixupArray.end) {
+             TclExpandJumpFixupArray(&jumpEndFixupArray);
+         }
+         jumpEndFixupArray.next++;
+         TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
+                 &(jumpEndFixupArray.fixup[jumpIndex]));
+         /*
+          * Fix the target of the jumpFalse after the test. Generate a 4 byte
+          * jump if the distance is > 120 bytes. This is conservative, and
+          * ensures that we won't have to replace this jump if we later also
+          * need to replace the proceeding jump to the end of the "if" with a
+          * 4 byte jump.
+          */
+         jumpDist = (envPtr->codeNext - envPtr->codeStart)
+                 - jumpFalseFixupArray.fixup[jumpIndex].codeOffset;
+         if (TclFixupForwardJump(envPtr,
+                 &(jumpFalseFixupArray.fixup[jumpIndex]), jumpDist, 120)) {
+             /*
+              * Adjust the code offset for the proceeding jump to the end
+              * of the "if" command.
+              */
+             jumpEndFixupArray.fixup[jumpIndex].codeOffset += 3;
+         }
+         tokenPtr += (tokenPtr->numComponents + 1);
+         wordIdx++;
+     }
+     /*
+      * Check for the optional else clause.
+      */
+     if ((wordIdx < numWords)
+             && (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD)) {
+         /*
+          * There is an else clause. Skip over the optional "else" word.
+          */
+         word = tokenPtr[1].start;
+         numBytes = tokenPtr[1].size;
+         if ((numBytes == 4) && (strncmp(word, "else", 4) == 0)) {
+             tokenPtr += (tokenPtr->numComponents + 1);
+             wordIdx++;
+             if (wordIdx >= numWords) {
+                 Tcl_ResetResult(interp);
+                 Tcl_AppendToObj(Tcl_GetObjResult(interp),
+                         "wrong # args: no script following \"else\" argument", -1);
+                 code = TCL_ERROR;
+                 goto done;
+             }
+         }
+         /*
+          * Compile the else command body.
+          */
+         code = TclCompileCmdWord(interp, tokenPtr+1,
+                 tokenPtr->numComponents, envPtr);
+         if (code != TCL_OK) {
+             if (code == TCL_ERROR) {
+                 sprintf(buffer, "\n    (\"if\" else script line %d)",
+                         interp->errorLine);
+                 Tcl_AddObjErrorInfo(interp, buffer, -1);
+             }
+             goto done;
+         }
+         maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+         /*
+          * Make sure there are no words after the else clause.
+          */
+         wordIdx++;
+         if (wordIdx < numWords) {
+             Tcl_ResetResult(interp);
+             Tcl_AppendToObj(Tcl_GetObjResult(interp),
+                     "wrong # args: extra words after \"else\" clause in \"if\" command", -1);
+             code = TCL_ERROR;
+             goto done;
+         }
+     } else {
+         /*
+          * No else clause: the "if" command's result is an empty string.
+          */
+         TclEmitPush(TclRegisterLiteral(envPtr, "", 0,/*onHeap*/ 0), envPtr);
+         maxDepth = TclMax(1, maxDepth);
+     }
+     /*
+      * Fix the unconditional jumps to the end of the "if" command.
+      */
+     for (j = jumpEndFixupArray.next;  j > 0;  j--) {
+         jumpIndex = (j - 1);    /* i.e. process the closest jump first */
+         jumpDist = (envPtr->codeNext - envPtr->codeStart)
+                 - jumpEndFixupArray.fixup[jumpIndex].codeOffset;
+         if (TclFixupForwardJump(envPtr,
+                 &(jumpEndFixupArray.fixup[jumpIndex]), jumpDist, 127)) {
+             /*
+              * Adjust the immediately preceeding "ifFalse" jump. We moved
+              * it's target (just after this jump) down three bytes.
+              */
+             unsigned char *ifFalsePc = envPtr->codeStart
+                     + jumpFalseFixupArray.fixup[jumpIndex].codeOffset;
+             unsigned char opCode = *ifFalsePc;
+             if (opCode == INST_JUMP_FALSE1) {
+                 jumpFalseDist = TclGetInt1AtPtr(ifFalsePc + 1);
+                 jumpFalseDist += 3;
+                 TclStoreInt1AtPtr(jumpFalseDist, (ifFalsePc + 1));
+             } else if (opCode == INST_JUMP_FALSE4) {
+                 jumpFalseDist = TclGetInt4AtPtr(ifFalsePc + 1);
+                 jumpFalseDist += 3;
+                 TclStoreInt4AtPtr(jumpFalseDist, (ifFalsePc + 1));
+             } else {
+                 panic("TclCompileIfCmd: unexpected opcode updating ifFalse jump");
+             }
+         }
+     }
+     /*
+      * Free the jumpFixupArray array if malloc'ed storage was used.
+      */
+     done:
+     TclFreeJumpFixupArray(&jumpFalseFixupArray);
+     TclFreeJumpFixupArray(&jumpEndFixupArray);
+     envPtr->maxStackDepth = maxDepth;
+     return code;
+ }
+ /*
+  *----------------------------------------------------------------------
+  *
+  * TclCompileIncrCmd --
+  *
+  *      Procedure called to compile the "incr" command.
+  *
+  * Results:
+  *      The return value is a standard Tcl result, which is TCL_OK if
+  *      compilation was successful. If an error occurs then the
+  *      interpreter's result contains a standard error message and TCL_ERROR
+  *      is returned. If the command is too complex for TclCompileIncrCmd,
+  *      TCL_OUT_LINE_COMPILE is returned indicating that the incr command
+  *      should be compiled "out of line" by emitting code to invoke its
+  *      command procedure 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 "incr" command
+  *      at runtime.
+  *
+  *----------------------------------------------------------------------
+  */
+ int
+ TclCompileIncrCmd(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 *varTokenPtr, *incrTokenPtr;
+     Tcl_Parse elemParse;
+     int gotElemParse = 0;
+     char *name, *elName, *p;
+     int nameChars, elNameChars, haveImmValue, immValue, localIndex, i, code;
+     int maxDepth = 0;
+     char buffer[160];
+     envPtr->maxStackDepth = 0;
+     if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
+         Tcl_ResetResult(interp);
+         Tcl_AppendToObj(Tcl_GetObjResult(interp),
+                 "wrong # args: should be \"incr varName ?increment?\"", -1);
+         return TCL_ERROR;
+     }
+     name = NULL;
+     elName = NULL;
+     elNameChars = 0;
+     localIndex = -1;
+     code = TCL_OK;
+     varTokenPtr = parsePtr->tokenPtr
+             + (parsePtr->tokenPtr->numComponents + 1);
+     /*
+      * Check not only that the type is TCL_TOKEN_SIMPLE_WORD, but whether
+      * curly braces surround the variable name.
+      * This really matters for array elements to handle things like
+      *    set {x($foo)} 5
+      * which raises an undefined var error if we are not careful here.
+      * This goes with the hack in TclCompileSetCmd.
+      */
+     if ((varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) &&
+             (varTokenPtr->start[0] != '{')) {
+         /*
+          * A simple variable name. Divide it up into "name" and "elName"
+          * strings. If it is not a local variable, look it up at runtime.
+          */
+         name = varTokenPtr[1].start;
+         nameChars = varTokenPtr[1].size;
+         for (i = 0, p = name;  i < nameChars;  i++, p++) {
+             if (*p == '(') {
+                 char *openParen = p;
+                 p = (name + nameChars-1);
+                 if (*p == ')') { /* last char is ')' => array reference */
+                     nameChars = (openParen - name);
+                     elName = openParen+1;
+                     elNameChars = (p - elName);
+                 }
+                 break;
+             }
+         }
+         if (envPtr->procPtr != NULL) {
+             localIndex = TclFindCompiledLocal(name, nameChars,
+                     /*create*/ 0, /*flags*/ 0, envPtr->procPtr);
+             if (localIndex > 255) {           /* we'll push the name */
+                 localIndex = -1;
+             }
+         }
+         if (localIndex < 0) {
+             TclEmitPush(TclRegisterLiteral(envPtr, name, nameChars,
+                         /*onHeap*/ 0), envPtr);
+             maxDepth = 1;
+         }
+         /*
+          * Compile the element script, if any.
+          */
+         if (elName != NULL) {
+             /*
+              * Temporarily replace the '(' and ')' by '"'s.
+              */
+             *(elName-1) = '"';
+             *(elName+elNameChars) = '"';
+             code = Tcl_ParseCommand(interp, elName-1, elNameChars+2,
+                     /*nested*/ 0, &elemParse);
+             *(elName-1) = '(';
+             *(elName+elNameChars) = ')';
+             gotElemParse = 1;
+             if ((code != TCL_OK) || (elemParse.numWords > 1)) {
+                 sprintf(buffer, "\n    (parsing index for array \"%.*s\")",
+                         TclMin(nameChars, 100), name);
+                 Tcl_AddObjErrorInfo(interp, buffer, -1);
+                 code = TCL_ERROR;
+                 goto done;
+             } else if (elemParse.numWords == 1) {
+                 code = TclCompileTokens(interp, elemParse.tokenPtr+1,
+                         elemParse.tokenPtr->numComponents, envPtr);
+                 if (code != TCL_OK) {
+                     goto done;
+                 }
+                 maxDepth += envPtr->maxStackDepth;
+             } else {
+                 TclEmitPush(TclRegisterLiteral(envPtr, "", 0,
+                         /*alreadyAlloced*/ 0), envPtr);
+                 maxDepth += 1;
+             }
+         }
+     } else {
+         /*
+          * Not a simple variable name. Look it up at runtime.
+          */
+         code = TclCompileTokens(interp, varTokenPtr+1,
+                 varTokenPtr->numComponents, envPtr);
+         if (code != TCL_OK) {
+             goto done;
+         }
+         maxDepth = envPtr->maxStackDepth;
+     }
+     /*
+      * If an increment is given, push it, but see first if it's a small
+      * integer.
+      */
+     haveImmValue = 0;
+     immValue = 0;
+     if (parsePtr->numWords == 3) {
+         incrTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
+         if (incrTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+             char *word = incrTokenPtr[1].start;
+             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
+              * TclGetLong do not have any dependencies on shared strings so we
+              * should be safe.
+              */
+             word[numBytes] = '\0';
+             if (TclLooksLikeInt(word, numBytes)
+                     && (TclGetLong((Tcl_Interp *) NULL, word, &n) == TCL_OK)) {
+                 if ((-127 <= n) && (n <= 127)) {
+                     haveImmValue = 1;
+                     immValue = n;
+                 }
+             }
+             word[numBytes] = savedChar;
+             if (!haveImmValue) {
+                 TclEmitPush(TclRegisterLiteral(envPtr, word, numBytes,
+                        /*onHeap*/ 0), envPtr);
+                 maxDepth += 1;
+             }
+         } else {
+             code = TclCompileTokens(interp, incrTokenPtr+1,
+                     incrTokenPtr->numComponents, envPtr);
+             if (code != TCL_OK) {
+                 if (code == TCL_ERROR) {
+                     Tcl_AddObjErrorInfo(interp,
+                             "\n    (increment expression)", -1);
+                 }
+                 goto done;
+             }
+             maxDepth += envPtr->maxStackDepth;
+         }
+     } else {                    /* no incr amount given so use 1 */
+         haveImmValue = 1;
+         immValue = 1;
+     }
+     /*
+      * Emit the instruction to increment the variable.
+      */
+     if (name != NULL) {
+         if (elName == NULL) {
+             if (localIndex >= 0) {
+                 if (haveImmValue) {
+                     TclEmitInstInt1(INST_INCR_SCALAR1_IMM, localIndex,
+                                     envPtr);
+                     TclEmitInt1(immValue, envPtr);
+                 } else {
+                     TclEmitInstInt1(INST_INCR_SCALAR1, localIndex, envPtr);
+                 }
+             } else {
+                 if (haveImmValue) {
+                     TclEmitInstInt1(INST_INCR_SCALAR_STK_IMM, immValue,
+                                    envPtr);
+                 } else {
+                     TclEmitOpcode(INST_INCR_SCALAR_STK, envPtr);
+                 }
+             }
+         } else {
+             if (localIndex >= 0) {
+                 if (haveImmValue) {
+                     TclEmitInstInt1(INST_INCR_ARRAY1_IMM, localIndex,
+                                     envPtr);
+                     TclEmitInt1(immValue, envPtr);
+                 } else {
+                     TclEmitInstInt1(INST_INCR_ARRAY1, localIndex, envPtr);
+                 }
+             } else {
+                 if (haveImmValue) {
+                     TclEmitInstInt1(INST_INCR_ARRAY_STK_IMM, immValue,
+                                    envPtr);
+                 } else {
+                     TclEmitOpcode(INST_INCR_ARRAY_STK, envPtr);
+                 }
+             }
+         }
+     } else {                    /* non-simple variable name */
+         if (haveImmValue) {
+             TclEmitInstInt1(INST_INCR_STK_IMM, immValue, envPtr);
+         } else {
+             TclEmitOpcode(INST_INCR_STK, envPtr);
+         }
+     }
+     done:
+     if (gotElemParse) {
+         Tcl_FreeParse(&elemParse);
+     }
+     envPtr->maxStackDepth = maxDepth;
+     return code;
+ }
+ /*
+  *----------------------------------------------------------------------
+  *
+  * TclCompileSetCmd --
+  *
+  *      Procedure called to compile the "set" 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 set command requires a second level of
+  *      substitutions, TCL_OUT_LINE_COMPILE is returned indicating that the
+  *      set command should be compiled "out of line" by emitting code to
+  *      invoke its command procedure (Tcl_SetCmd) 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 "set" command
+  *      at runtime.
+  *
+  *----------------------------------------------------------------------
+  */
+ int
+ TclCompileSetCmd(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 *varTokenPtr, *valueTokenPtr;
+     Tcl_Parse elemParse;
+     int gotElemParse = 0;
+     register char *p;
+     char *name, *elName;
+     int nameChars, elNameChars;
+     register int i, n;
+     int isAssignment, simpleVarName, localIndex, numWords;
+     int maxDepth = 0;
+     int code = TCL_OK;
+     envPtr->maxStackDepth = 0;
+     numWords = parsePtr->numWords;
+     if ((numWords != 2) && (numWords != 3)) {
+         Tcl_ResetResult(interp);
+         Tcl_AppendToObj(Tcl_GetObjResult(interp),
+                 "wrong # args: should be \"set varName ?newValue?\"", -1);
+         return TCL_ERROR;
+     }
+     isAssignment = (numWords == 3);
+     /*
+      * 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.
+      */
+     simpleVarName = 0;
+     name = elName = NULL;
+     nameChars = elNameChars = 0;
+     localIndex = -1;
+     varTokenPtr = parsePtr->tokenPtr
+             + (parsePtr->tokenPtr->numComponents + 1);
+     /*
+      * Check not only that the type is TCL_TOKEN_SIMPLE_WORD, but whether
+      * curly braces surround the variable name.
+      * This really matters for array elements to handle things like
+      *    set {x($foo)} 5
+      * which raises an undefined var error if we are not careful here.
+      * This goes with the hack in TclCompileIncrCmd.
+      */
+     if ((varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) &&
+             (varTokenPtr->start[0] != '{')) {
+         simpleVarName = 1;
+         name = varTokenPtr[1].start;
+         nameChars = varTokenPtr[1].size;
+         /* last char is ')' => potential array reference */
+         if ( *(name + nameChars - 1) == ')') {
+             for (i = 0, p = name;  i < nameChars;  i++, p++) {
+                 if (*p == '(') {
+                     elName = p + 1;
+                     elNameChars = nameChars - i - 2;
+                     nameChars = i ;
+                     break;
+                 }
+             }
+         }
+         /*
+          * If elName contains any double quotes ("), we can't inline
+          * compile the element script using the replace '()' by '"'
+          * technique below.
+          */
+         for (i = 0, p = elName;  i < elNameChars;  i++, p++) {
+             if (*p == '"') {
+                 simpleVarName = 0;
+                 break;
+             }
+         }
+     } else if (((n = varTokenPtr->numComponents) > 1)
+             && (varTokenPtr[1].type == TCL_TOKEN_TEXT)
+             && (varTokenPtr[n].type == TCL_TOKEN_TEXT)
+             && (varTokenPtr[n].start[varTokenPtr[n].size - 1] == ')')) {
+         simpleVarName = 0;
+         /*
+          * Check for parentheses inside first token
+          */
+         for (i = 0, p = varTokenPtr[1].start;
+              i < varTokenPtr[1].size; i++, p++) {
+             if (*p == '(') {
+                 simpleVarName = 1;
+                 break;
+             }
+         }
+         if (simpleVarName) {
+             name = varTokenPtr[1].start;
+             nameChars = p - varTokenPtr[1].start;
+             elName = p + 1;
+             elNameChars = (varTokenPtr[n].start - p) + varTokenPtr[n].size - 2;
+             /*
+              * If elName contains any double quotes ("), we can't inline
+              * compile the element script using the replace '()' by '"'
+              * technique below.
+              */
+             for (i = 0, p = elName;  i < elNameChars;  i++, p++) {
+                 if (*p == '"') {
+                     simpleVarName = 0;
+                     break;
+                 }
+             }
+         }
+     }
+     if (simpleVarName) {
+         /*
+          * See whether name has any namespace separators (::'s).
+          */
+         int hasNsQualifiers = 0;
+         for (i = 0, p = name;  i < nameChars;  i++, p++) {
+             if ((*p == ':') && ((i+1) < nameChars) && (*(p+1) == ':')) {
+                 hasNsQualifiers = 1;
+                 break;
+             }
+         }
+         /*
+          * Look up the var name's index in the array of local vars in the
+          * proc frame. If retrieving the var's value and it doesn't already
+          * exist, push its name and look it up at runtime.
+          */
+         if ((envPtr->procPtr != NULL) && !hasNsQualifiers) {
+             localIndex = TclFindCompiledLocal(name, nameChars,
+                     /*create*/ isAssignment,
+                     /*flags*/ ((elName==NULL)? VAR_SCALAR : VAR_ARRAY),
+                     envPtr->procPtr);
+         }
+         if (localIndex >= 0) {
+             maxDepth = 0;
+         } else {
+             TclEmitPush(TclRegisterLiteral(envPtr, name, nameChars,
+                     /*onHeap*/ 0), envPtr);
+             maxDepth = 1;
+         }
+         /*
+          * Compile the element script, if any.
+          */
+         if (elName != NULL) {
+             /*
+              * Temporarily replace the '(' and ')' by '"'s.
+              */
+             *(elName-1) = '"';
+             *(elName+elNameChars) = '"';
+             code = Tcl_ParseCommand(interp, elName-1, elNameChars+2,
+                     /*nested*/ 0, &elemParse);
+             *(elName-1) = '(';
+             *(elName+elNameChars) = ')';
+             gotElemParse = 1;
+             if ((code != TCL_OK) || (elemParse.numWords > 1)) {
+                 char buffer[160];
+                 sprintf(buffer, "\n    (parsing index for array \"%.*s\")",
+                         TclMin(nameChars, 100), name);
+                 Tcl_AddObjErrorInfo(interp, buffer, -1);
+                 code = TCL_ERROR;
+                 goto done;
+             } else if (elemParse.numWords == 1) {
+                 code = TclCompileTokens(interp, elemParse.tokenPtr+1,
+                         elemParse.tokenPtr->numComponents, envPtr);
+                 if (code != TCL_OK) {
+                     goto done;
+                 }
+                 maxDepth += envPtr->maxStackDepth;
+             } else {
+                 TclEmitPush(TclRegisterLiteral(envPtr, "", 0,
+                         /*alreadyAlloced*/ 0), envPtr);
+                 maxDepth += 1;
+             }
+         }
+     } else {
+         /*
+          * The var name isn't simple: compile and push it.
+          */
+         code = TclCompileTokens(interp, varTokenPtr+1,
+                 varTokenPtr->numComponents, envPtr);
+         if (code != TCL_OK) {
+             goto done;
+         }
+         maxDepth += envPtr->maxStackDepth;
+     }
+     /*
+      * If we are doing an assignment, push the new value.
+      */
+     if (isAssignment) {
+         valueTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
+         if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+             TclEmitPush(TclRegisterLiteral(envPtr, valueTokenPtr[1].start,
+                     valueTokenPtr[1].size, /*onHeap*/ 0), envPtr);
+             maxDepth += 1;
+         } else {
+             code = TclCompileTokens(interp, valueTokenPtr+1,
+                     valueTokenPtr->numComponents, envPtr);
+             if (code != TCL_OK) {
+                 goto done;
+             }
+             maxDepth += envPtr->maxStackDepth;
+         }
+     }
+     /*
+      * Emit instructions to set/get the variable.
+      */
+     if (simpleVarName) {
+         if (elName == NULL) {
+             if (localIndex >= 0) {
+                 if (localIndex <= 255) {
+                     TclEmitInstInt1((isAssignment?
+                             INST_STORE_SCALAR1 : INST_LOAD_SCALAR1),
+                             localIndex, envPtr);
+                 } else {
+                     TclEmitInstInt4((isAssignment?
+                             INST_STORE_SCALAR4 : INST_LOAD_SCALAR4),
+                             localIndex, envPtr);
+                 }
+             } else {
+                 TclEmitOpcode((isAssignment?
+                         INST_STORE_SCALAR_STK : INST_LOAD_SCALAR_STK),
+                         envPtr);
+             }
+         } else {
+             if (localIndex >= 0) {
+                 if (localIndex <= 255) {
+                     TclEmitInstInt1((isAssignment?
+                             INST_STORE_ARRAY1 : INST_LOAD_ARRAY1),
+                             localIndex, envPtr);
+                 } else {
+                     TclEmitInstInt4((isAssignment?
+                             INST_STORE_ARRAY4 : INST_LOAD_ARRAY4),
+                             localIndex, envPtr);
+                 }
+             } else {
+                 TclEmitOpcode((isAssignment?
+                         INST_STORE_ARRAY_STK : INST_LOAD_ARRAY_STK),
+                         envPtr);
+             }
+         }
+     } else {
+         TclEmitOpcode((isAssignment? INST_STORE_STK : INST_LOAD_STK),
+                 envPtr);
+     }
+     done:
+     if (gotElemParse) {
+         Tcl_FreeParse(&elemParse);
+     }
+     envPtr->maxStackDepth = maxDepth;
+     return code;
+ }
+ /*
+  *----------------------------------------------------------------------
+  *
+  * TclCompileWhileCmd --
+  *
+  *      Procedure called to compile the "while" command.
+  *
+  * Results:
+  *      The return value is a standard Tcl result, which is TCL_OK if
+  *      compilation was successful. If an error occurs then the
+  *      interpreter's result contains a standard error message and TCL_ERROR
+  *      is returned. If compilation failed because the command is too
+  *      complex for TclCompileWhileCmd, TCL_OUT_LINE_COMPILE is returned
+  *      indicating that the while command should be compiled "out of line"
+  *      by emitting code to invoke its command procedure at runtime.
+  *
+  *      envPtr->maxStackDepth is updated with the maximum number of stack
+  *      elements needed to execute the "while" command.
+  *
+  * Side effects:
+  *      Instructions are added to envPtr to execute the "while" command
+  *      at runtime.
+  *
+  *----------------------------------------------------------------------
+  */
+ int
+ TclCompileWhileCmd(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 *testTokenPtr, *bodyTokenPtr;
+     JumpFixup jumpFalseFixup;
+     unsigned char *jumpPc;
+     int testCodeOffset, jumpDist, jumpBackDist, jumpBackOffset;
+     int range, maxDepth, code;
+     char buffer[32 + TCL_INTEGER_SPACE];
+     envPtr->maxStackDepth = 0;
+     maxDepth = 0;
+     if (parsePtr->numWords != 3) {
+         Tcl_ResetResult(interp);
+         Tcl_AppendToObj(Tcl_GetObjResult(interp),
+                 "wrong # args: should be \"while test command\"", -1);
+         return TCL_ERROR;
+     }
+     /*
+      * If the test expression requires substitutions, don't compile the
+      * while command inline. E.g., the expression might cause the loop to
+      * never execute or execute forever, as in "while "$x < 5" {}".
+      */
+     testTokenPtr = parsePtr->tokenPtr
+             + (parsePtr->tokenPtr->numComponents + 1);
+     if (testTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+         return TCL_OUT_LINE_COMPILE;
+     }
+     /*
+      * Create a ExceptionRange record for the loop body. This is used to
+      * implement break and continue.
+      */
+     envPtr->exceptDepth++;
+     envPtr->maxExceptDepth =
+         TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
+     range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
+     envPtr->exceptArrayPtr[range].continueOffset =
+             (envPtr->codeNext - envPtr->codeStart);
+     /*
+      * Compile the test expression then emit the conditional jump that
+      * terminates the while. We already know it's a simple word.
+      */
+     testCodeOffset = (envPtr->codeNext - envPtr->codeStart);
+     envPtr->exceptArrayPtr[range].continueOffset = testCodeOffset;
+     code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
+     if (code != TCL_OK) {
+         if (code == TCL_ERROR) {
+             Tcl_AddObjErrorInfo(interp,
+                     "\n    (\"while\" test expression)", -1);
+         }
+         goto error;
+     }
+     maxDepth = envPtr->maxStackDepth;
+     TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);
+     /*
+      * Compile the loop body.
+      */
+     bodyTokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1);
+     envPtr->exceptArrayPtr[range].codeOffset =
+             (envPtr->codeNext - envPtr->codeStart);
+     code = TclCompileCmdWord(interp, bodyTokenPtr+1,
+             bodyTokenPtr->numComponents, envPtr);
+     if (code != TCL_OK) {
+         if (code == TCL_ERROR) {
+             sprintf(buffer, "\n    (\"while\" body line %d)",
+                     interp->errorLine);
+             Tcl_AddObjErrorInfo(interp, buffer, -1);
+         }
+         goto error;
+     }
+     maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+     envPtr->exceptArrayPtr[range].numCodeBytes =
+             (envPtr->codeNext - envPtr->codeStart)
+             - envPtr->exceptArrayPtr[range].codeOffset;
+     TclEmitOpcode(INST_POP, envPtr);
+     /*
+      * Jump back to the test at the top of the loop. Generate a 4 byte jump
+      * if the distance to the test is > 120 bytes. This is conservative and
+      * ensures that we won't have to replace this jump if we later need to
+      * replace the ifFalse jump with a 4 byte jump.
+      */
+     jumpBackOffset = (envPtr->codeNext - envPtr->codeStart);
+     jumpBackDist = (jumpBackOffset - testCodeOffset);
+     if (jumpBackDist > 120) {
+         TclEmitInstInt4(INST_JUMP4, -jumpBackDist, envPtr);
+     } else {
+         TclEmitInstInt1(INST_JUMP1, -jumpBackDist, envPtr);
+     }
+     /*
+      * Fix the target of the jumpFalse after the test.
+      */
+     jumpDist = (envPtr->codeNext - envPtr->codeStart)
+             - jumpFalseFixup.codeOffset;
+     if (TclFixupForwardJump(envPtr, &jumpFalseFixup, jumpDist, 127)) {
+         /*
+          * Update the loop body's starting PC offset since it moved down.
+          */
+         envPtr->exceptArrayPtr[range].codeOffset += 3;
+         /*
+          * Update the jump back to the test at the top of the loop since it
+          * also moved down 3 bytes.
+          */
+         jumpBackOffset += 3;
+         jumpPc = (envPtr->codeStart + jumpBackOffset);
+         jumpBackDist += 3;
+         if (jumpBackDist > 120) {
+             TclUpdateInstInt4AtPc(INST_JUMP4, -jumpBackDist, jumpPc);
+         } else {
+             TclUpdateInstInt1AtPc(INST_JUMP1, -jumpBackDist, jumpPc);
+         }
+     }
+     /*
+      * Set the loop's break target.
+      */
+     envPtr->exceptArrayPtr[range].breakOffset =
+             (envPtr->codeNext - envPtr->codeStart);
+     /*
+      * The while command's result is an empty string.
+      */
+     TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr);
+     if (maxDepth == 0) {
+         maxDepth = 1;
+     }
+     envPtr->maxStackDepth = maxDepth;
+     envPtr->exceptDepth--;
+     return TCL_OK;
+     error:
+     envPtr->maxStackDepth = maxDepth;
+     envPtr->exceptDepth--;
+     return code;
+ }
+ /* End of tclcompcmds.c */

 Legend:



Removed from v.64
 


changed lines


 
Added in v.71
 Legend:



Removed from v.64
 


changed lines


 
Added in v.71
-Removed from v.64
+Added in v.71

dashley@gmail.com	ViewVC Help
Powered by ViewVC 1.1.25