Logo Search packages:      
Sourcecode: tcltk8.0-ja version File versions  Download package

tclCompile.c

/* 
 * tclCompile.c --
 *
 *    This file contains procedures that compile Tcl commands or parts
 *    of commands (like quoted strings or nested sub-commands) into a
 *    sequence of instructions ("bytecodes"). 
 *
 * Copyright (c) 1996-1997 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: tclCompile.c,v 1.11 1998/09/14 18:39:58 stanton Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"

/*
 * Variable that controls whether compilation tracing is enabled and, if so,
 * what level of tracing is desired:
 *    0: no compilation tracing
 *    1: summarize compilation of top level cmds and proc bodies
 *    2: display all instructions of each ByteCode compiled
 * This variable is linked to the Tcl variable "tcl_traceCompile".
 */

int tclTraceCompile = 0;
static int traceInitialized = 0;

/*
 * Count of the number of compilations and various other compilation-
 * related statistics.
 */

#ifdef TCL_COMPILE_STATS
long tclNumCompilations = 0;
double tclTotalSourceBytes = 0.0;
double tclTotalCodeBytes = 0.0;

double tclTotalInstBytes = 0.0;
double tclTotalObjBytes = 0.0;
double tclTotalExceptBytes = 0.0;
double tclTotalAuxBytes = 0.0;
double tclTotalCmdMapBytes = 0.0;

double tclCurrentSourceBytes = 0.0;
double tclCurrentCodeBytes = 0.0;

int tclSourceCount[32];
int tclByteCodeCount[32];
#endif /* TCL_COMPILE_STATS */

/*
 * A table describing the Tcl bytecode instructions. The entries in this
 * table must correspond to the list of instructions in tclInt.h. The names
 * "op1" and "op4" refer to an instruction's one or four byte first operand.
 * Similarly, "stktop" and "stknext" refer to the topmost and next to
 * topmost stack elements.
 *
 * Note that the load, store, and incr instructions do not distinguish local
 * from global variables; the bytecode interpreter at runtime uses the
 * existence of a procedure call frame to distinguish these.
 */

InstructionDesc instructionTable[] = {
   /* Name        Bytes #Opnds Operand types        Stack top, next   */
    {"done",                1,   0,   {OPERAND_NONE}},
        /* Finish ByteCode execution and return stktop (top stack item) */
    {"push1",               2,   1,   {OPERAND_UINT1}},
        /* Push object at ByteCode objArray[op1] */
    {"push4",               5,   1,   {OPERAND_UINT4}},
        /* Push object at ByteCode objArray[op4] */
    {"pop",           1,   0,   {OPERAND_NONE}},
        /* Pop the topmost stack object */
    {"dup",           1,   0,   {OPERAND_NONE}},
        /* Duplicate the topmost stack object and push the result */
    {"concat1",             2,   1,   {OPERAND_UINT1}},
        /* Concatenate the top op1 items and push result */
    {"invokeStk1",        2,   1,   {OPERAND_UINT1}},
        /* Invoke command named objv[0]; <objc,objv> = <op1,top op1> */
    {"invokeStk4",        5,   1,   {OPERAND_UINT4}},
        /* Invoke command named objv[0]; <objc,objv> = <op4,top op4> */
    {"evalStk",           1,   0,   {OPERAND_NONE}},
        /* Evaluate command in stktop using Tcl_EvalObj. */
    {"exprStk",           1,   0,   {OPERAND_NONE}},
        /* Execute expression in stktop using Tcl_ExprStringObj. */
    
    {"loadScalar1",       2,   1,   {OPERAND_UINT1}},
        /* Load scalar variable at index op1 <= 255 in call frame */
    {"loadScalar4",       5,   1,   {OPERAND_UINT4}},
        /* Load scalar variable at index op1 >= 256 in call frame */
    {"loadScalarStk",     1,   0,   {OPERAND_NONE}},
        /* Load scalar variable; scalar's name is stktop */
    {"loadArray1",        2,   1,   {OPERAND_UINT1}},
        /* Load array element; array at slot op1<=255, element is stktop */
    {"loadArray4",        5,   1,   {OPERAND_UINT4}},
        /* Load array element; array at slot op1 > 255, element is stktop */
    {"loadArrayStk",      1,   0,   {OPERAND_NONE}},
        /* Load array element; element is stktop, array name is stknext */
    {"loadStk",           1,   0,   {OPERAND_NONE}},
        /* Load general variable; unparsed variable name is stktop */
    {"storeScalar1",      2,   1,   {OPERAND_UINT1}},
        /* Store scalar variable at op1<=255 in frame; value is stktop */
    {"storeScalar4",      5,   1,   {OPERAND_UINT4}},
        /* Store scalar variable at op1 > 255 in frame; value is stktop */
    {"storeScalarStk",    1,   0,   {OPERAND_NONE}},
        /* Store scalar; value is stktop, scalar name is stknext */
    {"storeArray1",       2,   1,   {OPERAND_UINT1}},
        /* Store array element; array at op1<=255, value is top then elem */
    {"storeArray4",       5,   1,   {OPERAND_UINT4}},
        /* Store array element; array at op1>=256, value is top then elem */
    {"storeArrayStk",     1,   0,   {OPERAND_NONE}},
        /* Store array element; value is stktop, then elem, array names */
    {"storeStk",          1,   0,   {OPERAND_NONE}},
        /* Store general variable; value is stktop, then unparsed name */
    
    {"incrScalar1",       2,   1,   {OPERAND_UINT1}},
        /* Incr scalar at index op1<=255 in frame; incr amount is stktop */
    {"incrScalarStk",     1,   0,   {OPERAND_NONE}},
        /* Incr scalar; incr amount is stktop, scalar's name is stknext */
    {"incrArray1",        2,   1,   {OPERAND_UINT1}},
        /* Incr array elem; arr at slot op1<=255, amount is top then elem */
    {"incrArrayStk",      1,   0,   {OPERAND_NONE}},
        /* Incr array element; amount is top then elem then array names */
    {"incrStk",           1,   0,   {OPERAND_NONE}},
        /* Incr general variable; amount is stktop then unparsed var name */
    {"incrScalar1Imm",    3,   2,   {OPERAND_UINT1, OPERAND_INT1}},
        /* Incr scalar at slot op1 <= 255; amount is 2nd operand byte */
    {"incrScalarStkImm",  2,   1,   {OPERAND_INT1}},
        /* Incr scalar; scalar name is stktop; incr amount is op1 */
    {"incrArray1Imm",     3,   2,   {OPERAND_UINT1, OPERAND_INT1}},
        /* Incr array elem; array at slot op1 <= 255, elem is stktop,
       * amount is 2nd operand byte */
    {"incrArrayStkImm",   2,   1,   {OPERAND_INT1}},
        /* Incr array element; elem is top then array name, amount is op1 */
    {"incrStkImm",        2,   1,   {OPERAND_INT1}},
        /* Incr general variable; unparsed name is top, amount is op1 */
    
    {"jump1",             2,   1,   {OPERAND_INT1}},
        /* Jump relative to (pc + op1) */
    {"jump4",             5,   1,   {OPERAND_INT4}},
        /* Jump relative to (pc + op4) */
    {"jumpTrue1",         2,   1,   {OPERAND_INT1}},
        /* Jump relative to (pc + op1) if stktop expr object is true */
    {"jumpTrue4",         5,   1,   {OPERAND_INT4}},
        /* Jump relative to (pc + op4) if stktop expr object is true */
    {"jumpFalse1",        2,   1,   {OPERAND_INT1}},
        /* Jump relative to (pc + op1) if stktop expr object is false */
    {"jumpFalse4",        5,   1,   {OPERAND_INT4}},
        /* Jump relative to (pc + op4) if stktop expr object is false */

    {"lor",               1,   0,   {OPERAND_NONE}},
        /* Logical or:  push (stknext || stktop) */
    {"land",              1,   0,   {OPERAND_NONE}},
        /* Logical and: push (stknext && stktop) */
    {"bitor",             1,   0,   {OPERAND_NONE}},
        /* Bitwise or:  push (stknext | stktop) */
    {"bitxor",            1,   0,   {OPERAND_NONE}},
        /* Bitwise xor  push (stknext ^ stktop) */
    {"bitand",            1,   0,   {OPERAND_NONE}},
        /* Bitwise and: push (stknext & stktop) */
    {"eq",                1,   0,   {OPERAND_NONE}},
        /* Equal: push (stknext == stktop) */
    {"neq",               1,   0,   {OPERAND_NONE}},
        /* Not equal:   push (stknext != stktop) */
    {"lt",                1,   0,   {OPERAND_NONE}},
        /* Less:  push (stknext < stktop) */
    {"gt",                1,   0,   {OPERAND_NONE}},
        /* Greater:     push (stknext || stktop) */
    {"le",                1,   0,   {OPERAND_NONE}},
        /* Logical or:  push (stknext || stktop) */
    {"ge",                1,   0,   {OPERAND_NONE}},
        /* Logical or:  push (stknext || stktop) */
    {"lshift",            1,   0,   {OPERAND_NONE}},
        /* Left shift:  push (stknext << stktop) */
    {"rshift",            1,   0,   {OPERAND_NONE}},
        /* Right shift: push (stknext >> stktop) */
    {"add",               1,   0,   {OPERAND_NONE}},
        /* Add:         push (stknext + stktop) */
    {"sub",               1,   0,   {OPERAND_NONE}},
        /* Sub:         push (stkext - stktop) */
    {"mult",              1,   0,   {OPERAND_NONE}},
        /* Multiply:    push (stknext * stktop) */
    {"div",               1,   0,   {OPERAND_NONE}},
        /* Divide:      push (stknext / stktop) */
    {"mod",               1,   0,   {OPERAND_NONE}},
        /* Mod:         push (stknext % stktop) */
    {"uplus",             1,   0,   {OPERAND_NONE}},
        /* Unary plus:  push +stktop */
    {"uminus",            1,   0,   {OPERAND_NONE}},
        /* Unary minus: push -stktop */
    {"bitnot",            1,   0,   {OPERAND_NONE}},
        /* Bitwise not: push ~stktop */
    {"not",               1,   0,   {OPERAND_NONE}},
        /* Logical not: push !stktop */
    {"callBuiltinFunc1",  2,   1,   {OPERAND_UINT1}},
        /* Call builtin math function with index op1; any args are on stk */
    {"callFunc1",         2,   1,   {OPERAND_UINT1}},
        /* Call non-builtin func objv[0]; <objc,objv>=<op1,top op1>  */
    {"tryCvtToNumeric",   1,   0,   {OPERAND_NONE}},
        /* Try converting stktop to first int then double if possible. */

    {"break",             1,   0,   {OPERAND_NONE}},
        /* Abort closest enclosing loop; if none, return TCL_BREAK code. */
    {"continue",          1,   0,   {OPERAND_NONE}},
        /* Skip to next iteration of closest enclosing loop; if none,
       * return TCL_CONTINUE code. */

    {"foreach_start4",    5,   1,   {OPERAND_UINT4}},
        /* Initialize execution of a foreach loop. Operand is aux data index
       * of the ForeachInfo structure for the foreach command. */
    {"foreach_step4",     5,   1,   {OPERAND_UINT4}},
        /* "Step" or begin next iteration of foreach loop. Push 0 if to
       *  terminate loop, else push 1. */

    {"beginCatch4",       5,   1,   {OPERAND_UINT4}},
        /* Record start of catch with the operand's exception range index.
       * Push the current stack depth onto a special catch stack. */
    {"endCatch",    1,   0,   {OPERAND_NONE}},
        /* End of last catch. Pop the bytecode interpreter's catch stack. */
    {"pushResult",        1,   0,   {OPERAND_NONE}},
        /* Push the interpreter's object result onto the stack. */
    {"pushReturnCode",    1,   0,   {OPERAND_NONE}},
        /* Push interpreter's return code (e.g. TCL_OK or TCL_ERROR) as
       * a new object onto the stack. */
    {0}
};

/*
 * The following table assigns a type to each character. Only types
 * meaningful to Tcl parsing are represented here. The table is
 * designed to be referenced with either signed or unsigned characters,
 * so it has 384 entries. The first 128 entries correspond to negative
 * character values, the next 256 correspond to positive character
 * values. The last 128 entries are identical to the first 128. The
 * table is always indexed with a 128-byte offset (the 128th entry
 * corresponds to a 0 character value).
 */

unsigned char tclTypeTable[] = {
    /*
     * Negative character values, from -128 to -1:
     */

    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,

    /*
     * Positive character values, from 0-127:
     */

    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_SPACE,         TCL_COMMAND_END,   TCL_SPACE,
    TCL_SPACE,         TCL_SPACE,         TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_SPACE,         TCL_NORMAL,        TCL_QUOTE,         TCL_NORMAL,
    TCL_DOLLAR,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_COMMAND_END,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_OPEN_BRACKET,
    TCL_BACKSLASH,     TCL_COMMAND_END,   TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_OPEN_BRACE,
    TCL_NORMAL,        TCL_CLOSE_BRACE,   TCL_NORMAL,        TCL_NORMAL,

    /*
     * Large unsigned character values, from 128-255:
     */

    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
};

/*
 * Table of all AuxData types.
 */

static Tcl_HashTable auxDataTypeTable;
static int auxDataTypeTableInitialized = 0;    /* 0 means not yet
                                                * initialized. */

/*
 * Prototypes for procedures defined later in this file:
 */

static void       AdvanceToNextWord _ANSI_ARGS_((char *string,
                      CompileEnv *envPtr));
static int        CollectArgInfo _ANSI_ARGS_((Tcl_Interp *interp,
                      char *string, char *lastChar, int flags,
                      ArgInfo *argInfoPtr));
static int        CompileBraces _ANSI_ARGS_((Tcl_Interp *interp,
                      char *string, char *lastChar, int flags,
                      CompileEnv *envPtr));
static int        CompileCmdWordInline _ANSI_ARGS_((
                      Tcl_Interp *interp, char *string,
                      char *lastChar, int flags, CompileEnv *envPtr));
static int        CompileExprWord _ANSI_ARGS_((Tcl_Interp *interp,
                      char *string, char *lastChar, int flags, 
                      CompileEnv *envPtr));
static int        CompileMultipartWord _ANSI_ARGS_((
                      Tcl_Interp *interp, char *string,
                      char *lastChar, int flags, CompileEnv *envPtr));
static int        CompileWord _ANSI_ARGS_((Tcl_Interp *interp,
                      char *string, char *lastChar, int flags, 
                      CompileEnv *envPtr));
static int        CreateExceptionRange _ANSI_ARGS_((
                      ExceptionRangeType type, CompileEnv *envPtr));
static void       DupByteCodeInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
                      Tcl_Obj *copyPtr));
static ClientData DupForeachInfo _ANSI_ARGS_((ClientData clientData));
static unsigned char *  EncodeCmdLocMap _ANSI_ARGS_((
                      CompileEnv *envPtr, ByteCode *codePtr,
                      unsigned char *startPtr));
static void       EnterCmdExtentData _ANSI_ARGS_((
                      CompileEnv *envPtr, int cmdNumber,
                      int numSrcChars, int numCodeBytes));
static void       EnterCmdStartData _ANSI_ARGS_((
                      CompileEnv *envPtr, int cmdNumber,
                      int srcOffset, int codeOffset));
static void       ExpandObjectArray _ANSI_ARGS_((CompileEnv *envPtr));
static void       FreeForeachInfo _ANSI_ARGS_((
                      ClientData clientData));
static void       FreeByteCodeInternalRep _ANSI_ARGS_((
                      Tcl_Obj *objPtr));
static void       FreeArgInfo _ANSI_ARGS_((ArgInfo *argInfoPtr));
static int        GetCmdLocEncodingSize _ANSI_ARGS_((
                      CompileEnv *envPtr));
static void       InitArgInfo _ANSI_ARGS_((ArgInfo *argInfoPtr));
static int        IsLocalScalar  _ANSI_ARGS_((char *name, int len));
static int        LookupCompiledLocal _ANSI_ARGS_((
                      char *name, int nameChars, int createIfNew,
                      int flagsIfCreated, Proc *procPtr));
static int        SetByteCodeFromAny _ANSI_ARGS_((Tcl_Interp *interp,
                      Tcl_Obj *objPtr));
static void       UpdateStringOfByteCode _ANSI_ARGS_((Tcl_Obj *objPtr));
#ifdef KANJI
static int        GetKanjiVarAndEl _ANSI_ARGS_((char *src, int len,
                      char **varName, char **elName,
                      int *varLen, int *elLen, CompileEnv *envPtr));
#endif /* KANJI */

/*
 * The structure below defines the bytecode Tcl object type by
 * means of procedures that can be invoked by generic object code.
 */

Tcl_ObjType tclByteCodeType = {
    "bytecode",               /* name */
    FreeByteCodeInternalRep,  /* freeIntRepProc */
    DupByteCodeInternalRep,   /* dupIntRepProc */
    UpdateStringOfByteCode,   /* updateStringProc */
    SetByteCodeFromAny        /* setFromAnyProc */
};

/*
 * The structures below define the AuxData types defined in this file.
 */

AuxDataType tclForeachInfoType = {
    "ForeachInfo",                        /* name */
    DupForeachInfo,                       /* dupProc */
    FreeForeachInfo                       /* freeProc */
};

/*
 *----------------------------------------------------------------------
 *
 * TclPrintByteCodeObj --
 *
 *    This procedure prints ("disassembles") the instructions of a
 *    bytecode object to stdout.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    None.
 *
 *----------------------------------------------------------------------
 */

void
TclPrintByteCodeObj(interp, objPtr)
    Tcl_Interp *interp;       /* Used only for Tcl_GetStringFromObj. */
    Tcl_Obj *objPtr;          /* The bytecode object to disassemble. */
{
    ByteCode* codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
    unsigned char *codeStart, *codeLimit, *pc;
    unsigned char *codeDeltaNext, *codeLengthNext;
    unsigned char *srcDeltaNext, *srcLengthNext;
    int codeOffset, codeLen, srcOffset, srcLen;
    int numCmds, numObjs, delta, objBytes, i;

    if (codePtr->refCount <= 0) {
      return;                 /* already freed */
    }

    codeStart = codePtr->codeStart;
    codeLimit = (codeStart + codePtr->numCodeBytes);
    numCmds = codePtr->numCommands;
    numObjs = codePtr->numObjects;

    objBytes = (numObjs * sizeof(Tcl_Obj));
    for (i = 0;  i < numObjs;  i++) {
      Tcl_Obj *litObjPtr = codePtr->objArrayPtr[i];
      if (litObjPtr->bytes != NULL) {
          objBytes += litObjPtr->length;
      }
    }

    /*
     * Print header lines describing the ByteCode.
     */

    fprintf(stdout, "\nByteCode 0x%x, ref ct %u, epoch %u, interp 0x%x(epoch %u)\n",
          (unsigned int) codePtr, codePtr->refCount,
          codePtr->compileEpoch, (unsigned int) codePtr->iPtr,
          codePtr->iPtr->compileEpoch);
    fprintf(stdout, "  Source ");
    TclPrintSource(stdout, codePtr->source,
          TclMin(codePtr->numSrcChars, 70));
    fprintf(stdout, "\n  Cmds %d, chars %d, inst %d, objs %u, aux %d, stk depth %u, code/src %.2f\n",
          numCmds, codePtr->numSrcChars, codePtr->numCodeBytes, numObjs,
          codePtr->numAuxDataItems, codePtr->maxStackDepth,
          (codePtr->numSrcChars?
                  ((float)codePtr->totalSize)/((float)codePtr->numSrcChars) : 0.0));
    fprintf(stdout, "  Code %d = %d(header)+%d(inst)+%d(objs)+%d(exc)+%d(aux)+%d(cmd map)\n",
          codePtr->totalSize, sizeof(ByteCode), codePtr->numCodeBytes,
          objBytes, (codePtr->numExcRanges * sizeof(ExceptionRange)),
          (codePtr->numAuxDataItems * sizeof(AuxData)),
          codePtr->numCmdLocBytes);

    /*
     * If the ByteCode is the compiled body of a Tcl procedure, print
     * information about that procedure. Note that we don't know the
     * procedure's name since ByteCode's can be shared among procedures.
     */
    
    if (codePtr->procPtr != NULL) {
      Proc *procPtr = codePtr->procPtr;
      int numCompiledLocals = procPtr->numCompiledLocals;
      fprintf(stdout,
              "  Proc 0x%x, ref ct %d, args %d, compiled locals %d\n",
            (unsigned int) procPtr, procPtr->refCount, procPtr->numArgs,
            numCompiledLocals);
      if (numCompiledLocals > 0) {
          CompiledLocal *localPtr = procPtr->firstLocalPtr;
          for (i = 0;  i < numCompiledLocals;  i++) {
            fprintf(stdout, "      %d: slot %d%s%s%s%s%s%s",
                  i, localPtr->frameIndex,
                  ((localPtr->flags & VAR_SCALAR)?  ", scalar"  : ""),
                  ((localPtr->flags & VAR_ARRAY)?  ", array"  : ""),
                  ((localPtr->flags & VAR_LINK)?  ", link"  : ""),
                  ((localPtr->flags & VAR_ARGUMENT)?  ", arg"  : ""),
                  ((localPtr->flags & VAR_TEMPORARY)? ", temp" : ""),
                  ((localPtr->flags & VAR_RESOLVED)? ", resolved" : ""));
            if (TclIsVarTemporary(localPtr)) {
                fprintf(stdout,     "\n");
            } else {
                fprintf(stdout,     ", name=\"%s\"\n", localPtr->name);
            }
            localPtr = localPtr->nextPtr;
          }
      }
    }

    /*
     * Print the ExceptionRange array.
     */

    if (codePtr->numExcRanges > 0) {
      fprintf(stdout, "  Exception ranges %d, depth %d:\n",
              codePtr->numExcRanges, codePtr->maxExcRangeDepth);
      for (i = 0;  i < codePtr->numExcRanges;  i++) {
          ExceptionRange *rangePtr = &(codePtr->excRangeArrayPtr[i]);
          fprintf(stdout, "      %d: level %d, %s, pc %d-%d, ",
                i, rangePtr->nestingLevel,
                ((rangePtr->type == LOOP_EXCEPTION_RANGE)? "loop":"catch"),
                rangePtr->codeOffset,
                (rangePtr->codeOffset + rangePtr->numCodeBytes - 1));
          switch (rangePtr->type) {
          case LOOP_EXCEPTION_RANGE:
            fprintf(stdout,   "continue %d, break %d\n",
                    rangePtr->continueOffset, rangePtr->breakOffset);
            break;
          case CATCH_EXCEPTION_RANGE:
            fprintf(stdout,   "catch %d\n", rangePtr->catchOffset);
            break;
          default:
            panic("TclPrintSource: unrecognized ExceptionRange type %d\n",
                    rangePtr->type);
          }
      }
    }
    
    /*
     * If there were no commands (e.g., an expression or an empty string
     * was compiled), just print all instructions and return.
     */

    if (numCmds == 0) {
      pc = codeStart;
      while (pc < codeLimit) {
          fprintf(stdout, "    ");
          pc += TclPrintInstruction(codePtr, pc);
      }
      return;
    }
    
    /*
     * Print table showing the code offset, source offset, and source
     * length for each command. These are encoded as a sequence of bytes.
     */

    fprintf(stdout, "  Commands %d:", numCmds);
    codeDeltaNext = codePtr->codeDeltaStart;
    codeLengthNext = codePtr->codeLengthStart;
    srcDeltaNext  = codePtr->srcDeltaStart;
    srcLengthNext = codePtr->srcLengthStart;
    codeOffset = srcOffset = 0;
    for (i = 0;  i < numCmds;  i++) {
      if ((unsigned int) (*codeDeltaNext) == (unsigned int) 0xFF) {
          codeDeltaNext++;
          delta = TclGetInt4AtPtr(codeDeltaNext);
          codeDeltaNext += 4;
      } else {
          delta = TclGetInt1AtPtr(codeDeltaNext);
          codeDeltaNext++;
      }
      codeOffset += delta;

      if ((unsigned int) (*codeLengthNext) == (unsigned int) 0xFF) {
          codeLengthNext++;
          codeLen = TclGetInt4AtPtr(codeLengthNext);
          codeLengthNext += 4;
      } else {
          codeLen = TclGetInt1AtPtr(codeLengthNext);
          codeLengthNext++;
      }
      
      if ((unsigned int) (*srcDeltaNext) == (unsigned int) 0xFF) {
          srcDeltaNext++;
          delta = TclGetInt4AtPtr(srcDeltaNext);
          srcDeltaNext += 4;
      } else {
          delta = TclGetInt1AtPtr(srcDeltaNext);
          srcDeltaNext++;
      }
      srcOffset += delta;

      if ((unsigned int) (*srcLengthNext) == (unsigned int) 0xFF) {
          srcLengthNext++;
          srcLen = TclGetInt4AtPtr(srcLengthNext);
          srcLengthNext += 4;
      } else {
          srcLen = TclGetInt1AtPtr(srcLengthNext);
          srcLengthNext++;
      }
      
      fprintf(stdout,   "%s%4d: pc %d-%d, source %d-%d",
            ((i % 2)? " " : "\n   "),
            (i+1), codeOffset, (codeOffset + codeLen - 1),
            srcOffset, (srcOffset + srcLen - 1));
    }
    if ((numCmds > 0) && ((numCmds % 2) != 0)) {
      fprintf(stdout,   "\n");
    }
    
    /*
     * Print each instruction. If the instruction corresponds to the start
     * of a command, print the command's source. Note that we don't need
     * the code length here.
     */

    codeDeltaNext = codePtr->codeDeltaStart;
    srcDeltaNext  = codePtr->srcDeltaStart;
    srcLengthNext = codePtr->srcLengthStart;
    codeOffset = srcOffset = 0;
    pc = codeStart;
    for (i = 0;  i < numCmds;  i++) {
      if ((unsigned int) (*codeDeltaNext) == (unsigned int) 0xFF) {
          codeDeltaNext++;
          delta = TclGetInt4AtPtr(codeDeltaNext);
          codeDeltaNext += 4;
      } else {
          delta = TclGetInt1AtPtr(codeDeltaNext);
          codeDeltaNext++;
      }
      codeOffset += delta;

      if ((unsigned int) (*srcDeltaNext) == (unsigned int) 0xFF) {
          srcDeltaNext++;
          delta = TclGetInt4AtPtr(srcDeltaNext);
          srcDeltaNext += 4;
      } else {
          delta = TclGetInt1AtPtr(srcDeltaNext);
          srcDeltaNext++;
      }
      srcOffset += delta;

      if ((unsigned int) (*srcLengthNext) == (unsigned int) 0xFF) {
          srcLengthNext++;
          srcLen = TclGetInt4AtPtr(srcLengthNext);
          srcLengthNext += 4;
      } else {
          srcLen = TclGetInt1AtPtr(srcLengthNext);
          srcLengthNext++;
      }

      /*
       * Print instructions before command i.
       */
      
      while ((pc-codeStart) < codeOffset) {
          fprintf(stdout, "    ");
          pc += TclPrintInstruction(codePtr, pc);
      }

      fprintf(stdout, "  Command %d: ", (i+1));
      TclPrintSource(stdout, (codePtr->source + srcOffset),
              TclMin(srcLen, 70));
      fprintf(stdout, "\n");
    }
    if (pc < codeLimit) {
      /*
       * Print instructions after the last command.
       */

      while (pc < codeLimit) {
          fprintf(stdout, "    ");
          pc += TclPrintInstruction(codePtr, pc);
      }
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclPrintInstruction --
 *
 *    This procedure prints ("disassembles") one instruction from a
 *    bytecode object to stdout.
 *
 * Results:
 *    Returns the length in bytes of the current instruiction.
 *
 * Side effects:
 *    None.
 *
 *----------------------------------------------------------------------
 */

int
TclPrintInstruction(codePtr, pc)
    ByteCode* codePtr;        /* Bytecode containing the instruction. */
    unsigned char *pc;        /* Points to first byte of instruction. */
{
    Proc *procPtr = codePtr->procPtr;
    unsigned char opCode = *pc;
    register InstructionDesc *instDesc = &instructionTable[opCode];
    unsigned char *codeStart = codePtr->codeStart;
    unsigned int pcOffset = (pc - codeStart);
    int opnd, elemLen, i, j;
    Tcl_Obj *elemPtr;
    char *string;
    
    fprintf(stdout, "(%u) %s ", pcOffset, instDesc->name);
    for (i = 0;  i < instDesc->numOperands;  i++) {
      switch (instDesc->opTypes[i]) {
      case OPERAND_INT1:
          opnd = TclGetInt1AtPtr(pc+1+i);
          if ((i == 0) && ((opCode == INST_JUMP1)
                       || (opCode == INST_JUMP_TRUE1)
                         || (opCode == INST_JUMP_FALSE1))) {
            fprintf(stdout, "%d     # pc %u", opnd, (pcOffset + opnd));
          } else {
            fprintf(stdout, "%d", opnd);
          }
          break;
      case OPERAND_INT4:
          opnd = TclGetInt4AtPtr(pc+1+i);
          if ((i == 0) && ((opCode == INST_JUMP4)
                       || (opCode == INST_JUMP_TRUE4)
                         || (opCode == INST_JUMP_FALSE4))) {
            fprintf(stdout, "%d     # pc %u", opnd, (pcOffset + opnd));
          } else {
            fprintf(stdout, "%d", opnd);
          }
          break;
      case OPERAND_UINT1:
          opnd = TclGetUInt1AtPtr(pc+1+i);
          if ((i == 0) && (opCode == INST_PUSH1)) {
            elemPtr = codePtr->objArrayPtr[opnd];
            string = Tcl_GetStringFromObj(elemPtr, &elemLen);
            fprintf(stdout, "%u     # ", (unsigned int) opnd);
            TclPrintSource(stdout, string, TclMin(elemLen, 40));
          } else if ((i == 0) && ((opCode == INST_LOAD_SCALAR1)
                            || (opCode == INST_LOAD_ARRAY1)
                            || (opCode == INST_STORE_SCALAR1)
                            || (opCode == INST_STORE_ARRAY1))) {
            int localCt = procPtr->numCompiledLocals;
            CompiledLocal *localPtr = procPtr->firstLocalPtr;
            if (opnd >= localCt) {
                panic("TclPrintInstruction: bad local var index %u (%u locals)\n",
                       (unsigned int) opnd, localCt);
                return instDesc->numBytes;
            }
            for (j = 0;  j < opnd;  j++) {
                localPtr = localPtr->nextPtr;
            }
            if (TclIsVarTemporary(localPtr)) {
                fprintf(stdout, "%u # temp var %u",
                      (unsigned int) opnd, (unsigned int) opnd);
            } else {
                fprintf(stdout, "%u # var ", (unsigned int) opnd);
                TclPrintSource(stdout, localPtr->name, 40);
            }
          } else {
            fprintf(stdout, "%u ", (unsigned int) opnd);
          }
          break;
      case OPERAND_UINT4:
          opnd = TclGetUInt4AtPtr(pc+1+i);
          if (opCode == INST_PUSH4) {
            elemPtr = codePtr->objArrayPtr[opnd];
            string = Tcl_GetStringFromObj(elemPtr, &elemLen);
            fprintf(stdout, "%u     # ", opnd);
            TclPrintSource(stdout, string, TclMin(elemLen, 40));
          } else if ((i == 0) && ((opCode == INST_LOAD_SCALAR4)
                            || (opCode == INST_LOAD_ARRAY4)
                            || (opCode == INST_STORE_SCALAR4)
                            || (opCode == INST_STORE_ARRAY4))) {
            int localCt = procPtr->numCompiledLocals;
            CompiledLocal *localPtr = procPtr->firstLocalPtr;
            if (opnd >= localCt) {
                panic("TclPrintInstruction: bad local var index %u (%u locals)\n",
                       (unsigned int) opnd, localCt);
                return instDesc->numBytes;
            }
            for (j = 0;  j < opnd;  j++) {
                localPtr = localPtr->nextPtr;
            }
            if (TclIsVarTemporary(localPtr)) {
                fprintf(stdout, "%u # temp var %u",
                      (unsigned int) opnd, (unsigned int) opnd);
            } else {
                fprintf(stdout, "%u # var ", (unsigned int) opnd);
                TclPrintSource(stdout, localPtr->name, 40);
            }
          } else {
            fprintf(stdout, "%u ", (unsigned int) opnd);
          }
          break;
      case OPERAND_NONE:
      default:
          break;
      }
    }
    fprintf(stdout, "\n");
    return instDesc->numBytes;
}

/*
 *----------------------------------------------------------------------
 *
 * TclPrintSource --
 *
 *    This procedure prints up to a specified number of characters from
 *    the argument string to a specified file. It tries to produce legible
 *    output by adding backslashes as necessary.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Outputs characters to the specified file.
 *
 *----------------------------------------------------------------------
 */

void
TclPrintSource(outFile, string, maxChars)
    FILE *outFile;            /* The file to print the source to. */
    char *string;       /* The string to print. */
    int maxChars;       /* Maximum number of chars to print. */
{
    register char *p;
    register int i = 0;

    if (string == NULL) {
      fprintf(outFile, "\"\"");
      return;
    }

    fprintf(outFile, "\"");
    p = string;
    for (;  (*p != '\0') && (i < maxChars);  p++, i++) {
      switch (*p) {
          case '"':
            fprintf(outFile, "\\\"");
            continue;
          case '\f':
            fprintf(outFile, "\\f");
            continue;
          case '\n':
            fprintf(outFile, "\\n");
            continue;
            case '\r':
            fprintf(outFile, "\\r");
            continue;
          case '\t':
            fprintf(outFile, "\\t");
            continue;
            case '\v':
            fprintf(outFile, "\\v");
            continue;
          default:
            fprintf(outFile, "%c", *p);
            continue;
      }
    }
    fprintf(outFile, "\"");
}

/*
 *----------------------------------------------------------------------
 *
 * FreeByteCodeInternalRep --
 *
 *    Part of the bytecode Tcl object type implementation. Frees the
 *    storage associated with a bytecode object's internal representation
 *    unless its code is actively being executed.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    The bytecode object's internal rep is marked invalid and its
 *    code gets freed unless the code is actively being executed.
 *    In that case the cleanup is delayed until the last execution
 *    of the code completes.
 *
 *----------------------------------------------------------------------
 */

static void
FreeByteCodeInternalRep(objPtr)
    register Tcl_Obj *objPtr; /* Object whose internal rep to free. */
{
    register ByteCode *codePtr =
          (ByteCode *) objPtr->internalRep.otherValuePtr;

    codePtr->refCount--;
    if (codePtr->refCount <= 0) {
      TclCleanupByteCode(codePtr);
    }
    objPtr->typePtr = NULL;
    objPtr->internalRep.otherValuePtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCleanupByteCode --
 *
 *    This procedure does all the real work of freeing up a bytecode
 *    object's ByteCode structure. It's called only when the structure's
 *    reference count becomes zero.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Frees objPtr's bytecode internal representation and sets
 *    its type and objPtr->internalRep.otherValuePtr NULL. Also
 *    decrements the ref counts on each object in its object array,
 *    and frees its auxiliary data items.
 *
 *----------------------------------------------------------------------
 */

void
TclCleanupByteCode(codePtr)
    ByteCode *codePtr;        /* ByteCode to free. */
{
    Tcl_Obj **objArrayPtr = codePtr->objArrayPtr;
    int numObjects = codePtr->numObjects;
    int numAuxDataItems = codePtr->numAuxDataItems;
    register AuxData *auxDataPtr;
    register Tcl_Obj *elemPtr;
    register int i;

#ifdef TCL_COMPILE_STATS    
    tclCurrentSourceBytes -= (double) codePtr->numSrcChars;
    tclCurrentCodeBytes -= (double) codePtr->totalSize;
#endif /* TCL_COMPILE_STATS */

    /*
     * A single heap object holds the ByteCode structure and its code,
     * object, command location, and auxiliary data arrays. This means we
     * only need to 1) decrement the ref counts on the objects in its
     * object array, 2) call the free procs for the auxiliary data items,
     * and 3) free the ByteCode structure's heap object.
     */

    for (i = 0;  i < numObjects;  i++) {
      elemPtr = objArrayPtr[i];
      TclDecrRefCount(elemPtr);
    }

    auxDataPtr = codePtr->auxDataArrayPtr;
    for (i = 0;  i < numAuxDataItems;  i++) {
      if (auxDataPtr->type->freeProc != NULL) {
          auxDataPtr->type->freeProc(auxDataPtr->clientData);
      }
      auxDataPtr++;
    }
    
    ckfree((char *) codePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * DupByteCodeInternalRep --
 *
 *    Part of the bytecode Tcl object type implementation. However, it
 *    does not copy the internal representation of a bytecode Tcl_Obj, but
 *    instead leaves the new object untyped (with a NULL type pointer).
 *    Code will be compiled for the new object only if necessary.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    None.
 *
 *----------------------------------------------------------------------
 */

static void
DupByteCodeInternalRep(srcPtr, copyPtr)
    Tcl_Obj *srcPtr;          /* Object with internal rep to copy. */
    Tcl_Obj *copyPtr;         /* Object with internal rep to set. */
{
    return;
}

/*
 *-----------------------------------------------------------------------
 *
 * SetByteCodeFromAny --
 *
 *    Part of the bytecode Tcl object type implementation. Attempts to
 *    generate an byte code internal form for the Tcl object "objPtr" by
 *    compiling its string representation.
 *
 * Results:
 *    The return value is a standard Tcl object result. If an error occurs
 *    during compilation, an error message is left in the interpreter's
 *    result unless "interp" is NULL.
 *
 * Side effects:
 *    Frees the old internal representation. If no error occurs, then the
 *    compiled code is stored as "objPtr"s bytecode representation.
 *    Also, if debugging, initializes the "tcl_traceCompile" Tcl variable
 *    used to trace compilations.
 *
 *----------------------------------------------------------------------
 */

static int
SetByteCodeFromAny(interp, objPtr)
    Tcl_Interp *interp;       /* The interpreter for which the code is
                         * compiled. */
    Tcl_Obj *objPtr;          /* The object to convert. */
{
    Interp *iPtr = (Interp *) interp;
    char *string;
    CompileEnv compEnv;       /* Compilation environment structure
                         * allocated in frame. */
    AuxData *auxDataPtr;
    register int i;
    int length, result;

    if (!traceInitialized) {
        if (Tcl_LinkVar(interp, "tcl_traceCompile",
                  (char *) &tclTraceCompile,  TCL_LINK_INT) != TCL_OK) {
            panic("SetByteCodeFromAny: unable to create link for tcl_traceCompile variable");
        }
        traceInitialized = 1;
    }
    
    string = Tcl_GetStringFromObj(objPtr, &length);
    TclInitCompileEnv(interp, &compEnv, string);
    result = TclCompileString(interp, string, string+length,
          iPtr->evalFlags, &compEnv);
    if (result == TCL_OK) {
      /*
       * Add a "done" instruction at the end of the instruction sequence.
       */
    
      TclEmitOpcode(INST_DONE, &compEnv);
      
      /*
       * Convert the object to a ByteCode object.
       */

      TclInitByteCodeObj(objPtr, &compEnv);
    } else {
      /*
       * Compilation errors. Decrement the ref counts on any objects in
       * the object array and free any aux data items prior to freeing
       * the compilation environment.
       */
      
      for (i = 0;  i < compEnv.objArrayNext;  i++) {
          Tcl_Obj *elemPtr = compEnv.objArrayPtr[i];
          Tcl_DecrRefCount(elemPtr);
      }

      auxDataPtr = compEnv.auxDataArrayPtr;
      for (i = 0;  i < compEnv.auxDataArrayNext;  i++) {
          if (auxDataPtr->type->freeProc != NULL) {
            auxDataPtr->type->freeProc(auxDataPtr->clientData);
          }
          auxDataPtr++;
      }
    }
    TclFreeCompileEnv(&compEnv);

    if (result == TCL_OK) {
      if (tclTraceCompile == 2) {
          TclPrintByteCodeObj(interp, objPtr);
      }
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfByteCode --
 *
 *    Part of the bytecode Tcl object type implementation. Called to
 *    update the string representation for a byte code object.
 *    Note: This procedure does not free an existing old string rep
 *    so storage will be lost if this has not already been done.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Generates a panic. 
 *
 *----------------------------------------------------------------------
 */

static void
UpdateStringOfByteCode(objPtr)
    register Tcl_Obj *objPtr; /* ByteCode object with string rep that 
                         * needs updating. */
{
    /*
     * This procedure is never invoked since the internal representation of
     * a bytecode object is never modified.
     */

    panic("UpdateStringOfByteCode should never be called.");
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitCompileEnv --
 *
 *    Initializes a CompileEnv compilation environment structure for the
 *    compilation of a string in an interpreter.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    The CompileEnv structure is initialized.
 *
 *----------------------------------------------------------------------
 */

void
TclInitCompileEnv(interp, envPtr, string)
    Tcl_Interp *interp;        /* The interpreter for which a CompileEnv
                          * structure is initialized. */
    register CompileEnv *envPtr; /* Points to the CompileEnv structure to
                          * initialize. */
    char *string;        /* The source string to be compiled. */
{
    Interp *iPtr = (Interp *) interp;
    
    envPtr->iPtr = iPtr;
    envPtr->source = string;
    envPtr->procPtr = iPtr->compiledProcPtr;
    envPtr->numCommands = 0;
    envPtr->excRangeDepth = 0;
    envPtr->maxExcRangeDepth = 0;
    envPtr->maxStackDepth = 0;
    Tcl_InitHashTable(&(envPtr->objTable), TCL_STRING_KEYS);
    envPtr->pushSimpleWords = 1;
    envPtr->wordIsSimple = 0;
    envPtr->numSimpleWordChars = 0;
    envPtr->exprIsJustVarRef = 0;
    envPtr->exprIsComparison = 0;
    envPtr->termOffset = 0;

    envPtr->codeStart = envPtr->staticCodeSpace;
    envPtr->codeNext = envPtr->codeStart;
    envPtr->codeEnd = (envPtr->codeStart + COMPILEENV_INIT_CODE_BYTES);
    envPtr->mallocedCodeArray = 0;

    envPtr->objArrayPtr = envPtr->staticObjArraySpace;
    envPtr->objArrayNext = 0;
    envPtr->objArrayEnd = COMPILEENV_INIT_NUM_OBJECTS;
    envPtr->mallocedObjArray = 0;
    
    envPtr->excRangeArrayPtr = envPtr->staticExcRangeArraySpace;
    envPtr->excRangeArrayNext = 0;
    envPtr->excRangeArrayEnd = COMPILEENV_INIT_EXCEPT_RANGES;
    envPtr->mallocedExcRangeArray = 0;
    
    envPtr->cmdMapPtr = envPtr->staticCmdMapSpace;
    envPtr->cmdMapEnd = COMPILEENV_INIT_CMD_MAP_SIZE;
    envPtr->mallocedCmdMap = 0;
    
    envPtr->auxDataArrayPtr = envPtr->staticAuxDataArraySpace;
    envPtr->auxDataArrayNext = 0;
    envPtr->auxDataArrayEnd = COMPILEENV_INIT_AUX_DATA_SIZE;
    envPtr->mallocedAuxDataArray = 0;
#ifdef KANJI
    envPtr->lastScannedKanjiCode = TCL_NOT_SCANNED;
#endif /* KANJI */
}

/*
 *----------------------------------------------------------------------
 *
 * TclFreeCompileEnv --
 *
 *    Free the storage allocated in a CompileEnv compilation environment
 *    structure.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Allocated storage in the CompileEnv structure is freed. Note that
 *    ref counts for Tcl objects in its object table are not decremented.
 *    In addition, any storage referenced by any auxiliary data items
 *    in the CompileEnv structure are not freed either. The expectation
 *    is that when compilation is successful, "ownership" (i.e., the
 *    pointers to) these objects and aux data items will just be handed
 *    over to the corresponding ByteCode structure.
 *
 *----------------------------------------------------------------------
 */

void
TclFreeCompileEnv(envPtr)
    register CompileEnv *envPtr; /* Points to the CompileEnv structure. */
{
    Tcl_DeleteHashTable(&(envPtr->objTable));
    if (envPtr->mallocedCodeArray) {
      ckfree((char *) envPtr->codeStart);
    }
    if (envPtr->mallocedObjArray) {
      ckfree((char *) envPtr->objArrayPtr);
    }
    if (envPtr->mallocedExcRangeArray) {
      ckfree((char *) envPtr->excRangeArrayPtr);
    }
    if (envPtr->mallocedCmdMap) {
      ckfree((char *) envPtr->cmdMapPtr);
    }
    if (envPtr->mallocedAuxDataArray) {
      ckfree((char *) envPtr->auxDataArrayPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitByteCodeObj --
 *
 *    Create a ByteCode structure and initialize it from a CompileEnv
 *    compilation environment structure. The ByteCode structure is
 *    smaller and contains just that information needed to execute
 *    the bytecode instructions resulting from compiling a Tcl script.
 *    The resulting structure is placed in the specified object.
 *
 * Results:
 *    A newly constructed ByteCode object is stored in the internal
 *    representation of the objPtr.
 *
 * Side effects:
 *    A single heap object is allocated to hold the new ByteCode structure
 *    and its code, object, command location, and aux data arrays. Note
 *    that "ownership" (i.e., the pointers to) the Tcl objects and aux
 *    data items will be handed over to the new ByteCode structure from
 *    the CompileEnv structure.
 *
 *----------------------------------------------------------------------
 */

void
TclInitByteCodeObj(objPtr, envPtr)
    Tcl_Obj *objPtr;           /* Points object that should be
                          * initialized, and whose string rep
                          * contains the source code. */
    register CompileEnv *envPtr; /* Points to the CompileEnv structure from
                          * which to create a ByteCode structure. */
{
    register ByteCode *codePtr;
    size_t codeBytes, objArrayBytes, exceptArrayBytes, cmdLocBytes;
    size_t auxDataArrayBytes;
    register size_t size, objBytes, totalSize;
    register unsigned char *p;
    unsigned char *nextPtr;
    int srcLen = envPtr->termOffset;
    int numObjects, i;
    Namespace *namespacePtr;
#ifdef TCL_COMPILE_STATS
    int srcLenLog2, sizeLog2;
#endif /*TCL_COMPILE_STATS*/

    codeBytes = (envPtr->codeNext - envPtr->codeStart);
    numObjects = envPtr->objArrayNext;
    objArrayBytes = (envPtr->objArrayNext * sizeof(Tcl_Obj *));
    exceptArrayBytes = (envPtr->excRangeArrayNext * sizeof(ExceptionRange));
    auxDataArrayBytes = (envPtr->auxDataArrayNext * sizeof(AuxData));
    cmdLocBytes = GetCmdLocEncodingSize(envPtr);
    
    size = sizeof(ByteCode);
    size += TCL_ALIGN(codeBytes);       /* align object array */
    size += TCL_ALIGN(objArrayBytes);   /* align exception range array */
    size += TCL_ALIGN(exceptArrayBytes); /* align AuxData array */
    size += auxDataArrayBytes;
    size += cmdLocBytes;

    /*
     * Compute the total number of bytes needed for this bytecode
     * including the storage for the Tcl objects in its object array.
     */

    objBytes = (numObjects * sizeof(Tcl_Obj));
    for (i = 0;  i < numObjects;  i++) {
      Tcl_Obj *litObjPtr = envPtr->objArrayPtr[i];
      if (litObjPtr->bytes != NULL) {
          objBytes += litObjPtr->length;
      }
    }
    totalSize = (size + objBytes);

#ifdef TCL_COMPILE_STATS
    tclNumCompilations++;
    tclTotalSourceBytes += (double) srcLen;
    tclTotalCodeBytes += (double) totalSize;
    
    tclTotalInstBytes += (double) codeBytes;
    tclTotalObjBytes += (double) objBytes;
    tclTotalExceptBytes += exceptArrayBytes;
    tclTotalAuxBytes += (double) auxDataArrayBytes;
    tclTotalCmdMapBytes += (double) cmdLocBytes;

    tclCurrentSourceBytes += (double) srcLen;
    tclCurrentCodeBytes += (double) totalSize;

    srcLenLog2 = TclLog2(srcLen);
    sizeLog2 = TclLog2((int) totalSize);
    if ((srcLenLog2 > 31) || (sizeLog2 > 31)) {
      panic("TclInitByteCodeObj: bad source or code sizes\n");
    }
    tclSourceCount[srcLenLog2]++;
    tclByteCodeCount[sizeLog2]++;
#endif /* TCL_COMPILE_STATS */    

    if (envPtr->iPtr->varFramePtr != NULL) {
        namespacePtr = envPtr->iPtr->varFramePtr->nsPtr;
    } else {
        namespacePtr = envPtr->iPtr->globalNsPtr;
    }
    
    p = (unsigned char *) ckalloc(size);
    codePtr = (ByteCode *) p;
    codePtr->iPtr = envPtr->iPtr;
    codePtr->compileEpoch = envPtr->iPtr->compileEpoch;
    codePtr->nsPtr = namespacePtr;
    codePtr->nsEpoch = namespacePtr->resolverEpoch;
    codePtr->refCount = 1;
    codePtr->flags = 0;
    codePtr->source = envPtr->source;
    codePtr->procPtr = envPtr->procPtr;
    codePtr->totalSize = totalSize;
    codePtr->numCommands = envPtr->numCommands;
    codePtr->numSrcChars = srcLen;
    codePtr->numCodeBytes = codeBytes;
    codePtr->numObjects = numObjects;
    codePtr->numExcRanges = envPtr->excRangeArrayNext;
    codePtr->numAuxDataItems = envPtr->auxDataArrayNext;
    codePtr->auxDataArrayPtr = NULL;
    codePtr->numCmdLocBytes = cmdLocBytes;
    codePtr->maxExcRangeDepth = envPtr->maxExcRangeDepth;
    codePtr->maxStackDepth = envPtr->maxStackDepth;
    
    p += sizeof(ByteCode);
    codePtr->codeStart = p;
    memcpy((VOID *) p, (VOID *) envPtr->codeStart, codeBytes);
    
    p += TCL_ALIGN(codeBytes);            /* align object array */
    codePtr->objArrayPtr = (Tcl_Obj **) p;
    memcpy((VOID *) p, (VOID *) envPtr->objArrayPtr, objArrayBytes);

    p += TCL_ALIGN(objArrayBytes);    /* align exception range array */
    if (exceptArrayBytes > 0) {
      codePtr->excRangeArrayPtr = (ExceptionRange *) p;
      memcpy((VOID *) p, (VOID *) envPtr->excRangeArrayPtr,
              exceptArrayBytes);
    }
#ifdef BUGFIX
    else {
        codePtr->excRangeArrayPtr = NULL;
    }
#endif /* BUGFIX */
    
    p += TCL_ALIGN(exceptArrayBytes); /* align AuxData array */
    if (auxDataArrayBytes > 0) {
      codePtr->auxDataArrayPtr = (AuxData *) p;
      memcpy((VOID *) p, (VOID *) envPtr->auxDataArrayPtr,
              auxDataArrayBytes);
    }
#ifdef BUGFIX
    else {
        codePtr->auxDataArrayPtr = NULL;
    }
#endif /* BUGFIX */

    p += auxDataArrayBytes;
    nextPtr = EncodeCmdLocMap(envPtr, codePtr, (unsigned char *) p);
    if (((size_t)(nextPtr - p)) != cmdLocBytes) {     
      panic("TclInitByteCodeObj: encoded cmd location bytes %d != expected size %d\n", (nextPtr - p), cmdLocBytes);
    }
    
    /*
     * Free the old internal rep then convert the object to a
     * bytecode object by making its internal rep point to the just
     * compiled ByteCode.
     */
          
    if ((objPtr->typePtr != NULL) &&
          (objPtr->typePtr->freeIntRepProc != NULL)) {
      objPtr->typePtr->freeIntRepProc(objPtr);
    }
    objPtr->internalRep.otherValuePtr = (VOID *) codePtr;
    objPtr->typePtr = &tclByteCodeType;
}

/*
 *----------------------------------------------------------------------
 *
 * GetCmdLocEncodingSize --
 *
 *    Computes the total number of bytes needed to encode the command
 *    location information for some compiled code.
 *
 * Results:
 *    The byte count needed to encode the compiled location information.
 *
 * Side effects:
 *    None.
 *
 *----------------------------------------------------------------------
 */

static int
GetCmdLocEncodingSize(envPtr)
     CompileEnv *envPtr;      /* Points to compilation environment
                         * structure containing the CmdLocation
                         * structure to encode. */
{
    register CmdLocation *mapPtr = envPtr->cmdMapPtr;
    int numCmds = envPtr->numCommands;
    int codeDelta, codeLen, srcDelta, srcLen;
    int codeDeltaNext, codeLengthNext, srcDeltaNext, srcLengthNext;
                        /* The offsets in their respective byte
                         * sequences where the next encoded offset
                         * or length should go. */
    int prevCodeOffset, prevSrcOffset, i;

    codeDeltaNext = codeLengthNext = srcDeltaNext = srcLengthNext = 0;
    prevCodeOffset = prevSrcOffset = 0;
    for (i = 0;  i < numCmds;  i++) {
      codeDelta = (mapPtr[i].codeOffset - prevCodeOffset);
      if (codeDelta < 0) {
          panic("GetCmdLocEncodingSize: bad code offset");
      } else if (codeDelta <= 127) {
          codeDeltaNext++;
      } else {
          codeDeltaNext += 5;  /* 1 byte for 0xFF, 4 for positive delta */
      }
      prevCodeOffset = mapPtr[i].codeOffset;

      codeLen = mapPtr[i].numCodeBytes;
      if (codeLen < 0) {
          panic("GetCmdLocEncodingSize: bad code length");
      } else if (codeLen <= 127) {
          codeLengthNext++;
      } else {
          codeLengthNext += 5; /* 1 byte for 0xFF, 4 for length */
      }

      srcDelta = (mapPtr[i].srcOffset - prevSrcOffset);
      if ((-127 <= srcDelta) && (srcDelta <= 127)) {
          srcDeltaNext++;
      } else {
          srcDeltaNext += 5;   /* 1 byte for 0xFF, 4 for delta */
      }
      prevSrcOffset = mapPtr[i].srcOffset;

      srcLen = mapPtr[i].numSrcChars;
      if (srcLen < 0) {
          panic("GetCmdLocEncodingSize: bad source length");
      } else if (srcLen <= 127) {
          srcLengthNext++;
      } else {
          srcLengthNext += 5;  /* 1 byte for 0xFF, 4 for length */
      }
    }

    return (codeDeltaNext + codeLengthNext + srcDeltaNext + srcLengthNext);
}

/*
 *----------------------------------------------------------------------
 *
 * EncodeCmdLocMap --
 *
 *    Encode the command location information for some compiled code into
 *    a ByteCode structure. The encoded command location map is stored as
 *    three adjacent byte sequences.
 *
 * Results:
 *    Pointer to the first byte after the encoded command location
 *    information.
 *
 * Side effects:
 *    The encoded information is stored into the block of memory headed
 *    by codePtr. Also records pointers to the start of the four byte
 *    sequences in fields in codePtr's ByteCode header structure.
 *
 *----------------------------------------------------------------------
 */

static unsigned char *
EncodeCmdLocMap(envPtr, codePtr, startPtr)
     CompileEnv *envPtr;      /* Points to compilation environment
                         * structure containing the CmdLocation
                         * structure to encode. */
     ByteCode *codePtr;       /* ByteCode in which to encode envPtr's
                         * command location information. */
     unsigned char *startPtr; /* Points to the first byte in codePtr's
                         * memory block where the location
                         * information is to be stored. */
{
    register CmdLocation *mapPtr = envPtr->cmdMapPtr;
    int numCmds = envPtr->numCommands;
    register unsigned char *p = startPtr;
    int codeDelta, codeLen, srcDelta, srcLen, prevOffset;
    register int i;
    
    /*
     * Encode the code offset for each command as a sequence of deltas.
     */

    codePtr->codeDeltaStart = p;
    prevOffset = 0;
    for (i = 0;  i < numCmds;  i++) {
      codeDelta = (mapPtr[i].codeOffset - prevOffset);
      if (codeDelta < 0) {
          panic("EncodeCmdLocMap: bad code offset");
      } else if (codeDelta <= 127) {
          TclStoreInt1AtPtr(codeDelta, p);
          p++;
      } else {
          TclStoreInt1AtPtr(0xFF, p);
          p++;
          TclStoreInt4AtPtr(codeDelta, p);
          p += 4;
      }
      prevOffset = mapPtr[i].codeOffset;
    }

    /*
     * Encode the code length for each command.
     */

    codePtr->codeLengthStart = p;
    for (i = 0;  i < numCmds;  i++) {
      codeLen = mapPtr[i].numCodeBytes;
      if (codeLen < 0) {
          panic("EncodeCmdLocMap: bad code length");
      } else if (codeLen <= 127) {
          TclStoreInt1AtPtr(codeLen, p);
          p++;
      } else {
          TclStoreInt1AtPtr(0xFF, p);
          p++;
          TclStoreInt4AtPtr(codeLen, p);
          p += 4;
      }
    }

    /*
     * Encode the source offset for each command as a sequence of deltas.
     */

    codePtr->srcDeltaStart = p;
    prevOffset = 0;
    for (i = 0;  i < numCmds;  i++) {
      srcDelta = (mapPtr[i].srcOffset - prevOffset);
      if ((-127 <= srcDelta) && (srcDelta <= 127)) {
          TclStoreInt1AtPtr(srcDelta, p);
          p++;
      } else {
          TclStoreInt1AtPtr(0xFF, p);
          p++;
          TclStoreInt4AtPtr(srcDelta, p);
          p += 4;
      }
      prevOffset = mapPtr[i].srcOffset;
    }

    /*
     * Encode the source length for each command.
     */

    codePtr->srcLengthStart = p;
    for (i = 0;  i < numCmds;  i++) {
      srcLen = mapPtr[i].numSrcChars;
      if (srcLen < 0) {
          panic("EncodeCmdLocMap: bad source length");
      } else if (srcLen <= 127) {
          TclStoreInt1AtPtr(srcLen, p);
          p++;
      } else {
          TclStoreInt1AtPtr(0xFF, p);
          p++;
          TclStoreInt4AtPtr(srcLen, p);
          p += 4;
      }
    }
    
    return p;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileString --
 *
 *    Compile a Tcl script in a null-terminated binary string.
 *
 * Results:
 *    The return value is TCL_OK on a successful compilation and TCL_ERROR
 *    on failure. If TCL_ERROR is returned, then the interpreter's result
 *    contains an error message.
 *
 *    envPtr->termOffset and interp->termOffset are filled in with the
 *    offset of the character in the string just after the last one
 *    successfully processed; this might be the offset of the ']' (if
 *    flags & TCL_BRACKET_TERM), or the offset of the '\0' at the end of
 *    the string. Also updates envPtr->maxStackDepth with the maximum
 *    number of stack elements needed to execute the string's commands.
 *
 * Side effects:
 *    Adds instructions to envPtr to evaluate the string at runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileString(interp, string, lastChar, flags, envPtr)
    Tcl_Interp *interp;       /* Used for error reporting. */
    char *string;       /* The source string to compile. */
    char *lastChar;           /* Pointer to terminating character of
                         * string. */
    int flags;                /* Flags to control compilation (same as
                         * passed to Tcl_Eval). */
    CompileEnv *envPtr;       /* Holds resulting instructions. */
{
    Interp *iPtr = (Interp *) interp;
    register char *src = string;/* Points to current source char. */
    register char c = *src;   /* The current char. */
    register int type;        /* Current char's CHAR_TYPE type. */
    char termChar = (char)((flags & TCL_BRACKET_TERM)? ']' : '\0');
                        /* Return when this character is found
                         * (either ']' or '\0'). Zero means newlines
                         * terminate cmds. */
    int isFirstCmd = 1;       /* 1 if compiling the first cmd. */
    char *cmdSrcStart = NULL; /* Points to first non-blank char in each
                         * command. Initialized to avoid compiler
                         * warning. */
    int cmdIndex;       /* The index of the current command in the
                         * compilation environment's command
                         * location table. */
    int lastTopLevelCmdIndex = -1;
                        /* Index of most recent toplevel command in
                         * the command location table. Initialized
                         * to avoid compiler warning. */
    int cmdCodeOffset = -1;   /* Offset of first byte of current command's
                         * code. Initialized to avoid compiler
                         * warning. */
    int cmdWords;       /* Number of words in current command. */
    Tcl_Command cmd;          /* Used to search for commands. */
    Command *cmdPtr;          /* Points to command's Command structure if
                         * first word is simple and command was
                         * found; else NULL. */
    int maxDepth = 0;         /* Maximum number of stack elements needed
                         * to execute all cmds. */
    char *termPtr;            /* Points to char that terminated word. */
    char savedChar;           /* Holds the character from string
                         * termporarily replaced by a null character
                         * during processing of words. */
    int objIndex = -1;        /* The object array index for a pushed
                         * object holding a word or word part
                         * Initialized to avoid compiler warning. */
    unsigned char *entryCodeNext = envPtr->codeNext;
                        /* Value of envPtr's current instruction
                         * pointer at entry. Used to tell if any
                         * instructions generated. */
    char *ellipsis = "";      /* Used to set errorInfo variable; "..."
                         * indicates that not all of offending
                         * command is included in errorInfo. ""
                         * means that the command is all there. */
    Tcl_Obj *objPtr;
    int numChars;
    int result = TCL_OK;
    int savePushSimpleWords = envPtr->pushSimpleWords;

    /*
     * commands: command {(';' | '\n') command}
     */

    while ((src != lastChar) && (c != termChar)) {
      /*
       * Skip white space, semicolons, backslash-newlines (treated as
       * spaces), and comments before command.
       */

      type = CHAR_TYPE(src, lastChar);
      while ((type & (TCL_SPACE | TCL_BACKSLASH))
              || (c == '\n') || (c == ';')) {
          if (type == TCL_BACKSLASH) {
            if (src[1] == '\n') {
                src += 2;
            } else {
                break;
            }
          } else {
            src++;
          }
          c = *src;
          type = CHAR_TYPE(src, lastChar);
      }

      if (c == '#') {
          while (src != lastChar) {
#ifdef KANJI
            if (IS_KANJISTART(UCHAR(c))) {
                src += Tcl_KanjiSkip(src, lastChar, NULL);
            } else
#endif /* KANJI */
            if (c == '\\') {
                int numRead;
                Tcl_Backslash(src, &numRead);
                src += numRead;
            } else if (c == '\n') {
                src++;
                c = *src;
                envPtr->termOffset = (src - string);
                break;
            } else {
                src++;
            }
            c = *src;
          }
          continue;     /* end of comment, restart outer command loop */
      }

      /*
       * Compile one command: zero or more words terminated by a '\n',
       * ';', ']' (if command is terminated by close bracket), or
       * the end of string.
       *
       * command: word*
       */

      type = CHAR_TYPE(src, lastChar);
      if ((type == TCL_COMMAND_END) 
              && ((c != ']') || (flags & TCL_BRACKET_TERM))) {
          continue;  /* empty command; restart outer cmd loop */
      }

      /*
       * If not the first command, discard the previous command's result.
       */
      
      if (!isFirstCmd) {
          TclEmitOpcode(INST_POP, envPtr);
          if (!(flags & TCL_BRACKET_TERM)) {
            /*
             * We are compiling a top level command. Update the number
             * of code bytes for the last command to account for the pop
             * instruction.
             */
            
              (envPtr->cmdMapPtr[lastTopLevelCmdIndex]).numCodeBytes =
                (envPtr->codeNext-envPtr->codeStart) - cmdCodeOffset;
          }
      }

      /*
       * Compile the words of the command. Process the first word
       * specially, since it is the name of a command. If it is a "simple"
       * string (just a sequence of characters), look it up in the table
       * of compilation procedures. If a word other than the first is
       * simple and represents an integer whose formatted representation
       * is the same as the word, just push an integer object. Also record
       * starting source and object information for the command.
       */

      envPtr->numCommands++;
      cmdIndex = (envPtr->numCommands - 1);
      if (!(flags & TCL_BRACKET_TERM)) {
          lastTopLevelCmdIndex = cmdIndex;
      }
      
      cmdSrcStart = src;
      cmdCodeOffset = (envPtr->codeNext - envPtr->codeStart);
      cmdWords = 0;
      EnterCmdStartData(envPtr, cmdIndex, src-envPtr->source,
            cmdCodeOffset);
          
      if ((!(flags & TCL_BRACKET_TERM))
              && (tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) {
          /*
           * Display a line summarizing the top level command we are about
           * to compile.
           */
          
          char *p = cmdSrcStart;
          int numChars, complete;
          
          while ((CHAR_TYPE(p, lastChar) != TCL_COMMAND_END)
               || ((*p == ']') && !(flags & TCL_BRACKET_TERM))) {
            p++;
          }
          numChars = (p - cmdSrcStart);
          complete = 1;
          if (numChars > 60) {
            numChars = 60;
            complete = 0;
          } else if ((numChars >= 2) && (*p == '\n') && (*(p-1) == '{')) {
            complete = 0;
          }
          fprintf(stdout, "Compiling: %.*s%s\n",
                numChars, cmdSrcStart, (complete? "" : " ..."));
      }
      
      while ((type != TCL_COMMAND_END)
              || ((c == ']') && !(flags & TCL_BRACKET_TERM))) {
          /*
           * Skip any leading white space at the start of a word. Note
           * that a backslash-newline is treated as a space.
           */

          while (type & (TCL_SPACE | TCL_BACKSLASH)) {
            if (type == TCL_BACKSLASH) {
                if (src[1] == '\n') {
                  src += 2;
                } else {
                  break;
                }
            } else {
                src++;
            }
            c = *src;
            type = CHAR_TYPE(src, lastChar);
          }
          if ((type == TCL_COMMAND_END) 
                  && ((c != ']') || (flags & TCL_BRACKET_TERM))) {
            break;            /* no words remain for command. */
          }

          /*
           * Compile one word. We use an inline version of CompileWord to
           * avoid an extra procedure call.
           */

          envPtr->pushSimpleWords = 0;
          if (type & (TCL_QUOTE | TCL_OPEN_BRACE)) {
            src++;
            if (type == TCL_QUOTE) {
                result = TclCompileQuotes(interp, src, lastChar,
                      '"', flags, envPtr);
            } else {
                result = CompileBraces(interp, src, lastChar,
                      flags, envPtr);
            }
            termPtr = (src + envPtr->termOffset);
            if (result != TCL_OK) {
                src = termPtr;
                goto done;
            }

            /*
             * Make sure terminating character of the quoted or braced
             * string is the end of word.
             */
            
            c = *termPtr;
            if ((c == '\\') && (*(termPtr+1) == '\n')) {
                /*
                 * Line is continued on next line; the backslash-
                 * newline turns into space, which terminates the word.
                 */
            } else {
                type = CHAR_TYPE(termPtr, lastChar);
                if ((type != TCL_SPACE) && (type != TCL_COMMAND_END)) {
                  Tcl_ResetResult(interp);
                  if (*(src-1) == '"') {
                      Tcl_AppendToObj(Tcl_GetObjResult(interp),
                            "extra characters after close-quote", -1);
                  } else {
                      Tcl_AppendToObj(Tcl_GetObjResult(interp),
                            "extra characters after close-brace", -1);
                  }
                  result = TCL_ERROR;
                }
            }
          } else {
            result = CompileMultipartWord(interp, src, lastChar,
                  flags, envPtr);
            termPtr = (src + envPtr->termOffset);
          }
          if (result != TCL_OK) {
            ellipsis = "...";
            src = termPtr;
            goto done;
          }
          
          if (envPtr->wordIsSimple) {
            /*
             * A simple word. Temporarily replace the terminating
             * character with a null character.
             */
            
            numChars = envPtr->numSimpleWordChars;
            savedChar = src[numChars];
            src[numChars] = '\0';

            if ((cmdWords == 0)
                    && (!(iPtr->flags & DONT_COMPILE_CMDS_INLINE))) {
                /*
                 * The first word of a command and inline command
                 * compilation has not been disabled (e.g., by command
                 * traces). Look up the first word in the interpreter's
                 * hashtable of commands. If a compilation procedure is
                 * found, let it compile the command after resetting
                 * error logging information. Note that if we are
                 * compiling a procedure, we must look up the command
                 * in the procedure's namespace and not the current
                 * namespace.
                 */

                Namespace *cmdNsPtr;

                if (envPtr->procPtr != NULL) {
                  cmdNsPtr = envPtr->procPtr->cmdPtr->nsPtr;
                } else {
                  cmdNsPtr = NULL;
                }

                cmdPtr = NULL;
                cmd = Tcl_FindCommand(interp, src,
                      (Tcl_Namespace *) cmdNsPtr, /*flags*/ 0);
                    if (cmd != (Tcl_Command) NULL) {
                        cmdPtr = (Command *) cmd;
                    }
                if ((cmdPtr != NULL) && (cmdPtr->compileProc != NULL)) {
                  char *firstArg = termPtr;
                  src[numChars] = savedChar;
                  iPtr->flags &= ~(ERR_ALREADY_LOGGED | ERR_IN_PROGRESS
                               | ERROR_CODE_SET);
                  result = (*(cmdPtr->compileProc))(interp,
                        firstArg, lastChar, flags, envPtr);
                  if (result == TCL_OK) {
                      src = (firstArg + envPtr->termOffset);
                      maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
                      goto finishCommand;
                  } else if (result == TCL_OUT_LINE_COMPILE) {
                      result = TCL_OK;
                      src[numChars] = '\0';
                  } else {
                      src = firstArg;
                      goto done;           /* an error */
                  }
                }

                /*
                 * No compile procedure was found for the command: push
                 * the word and continue to compile the remaining
                 * words. If a hashtable entry was found for the
                 * command, push a CmdName object instead to avoid
                 * runtime lookups. If necessary, convert the pushed
                 * object to be a CmdName object. If this is the first
                 * CmdName object in this code unit that refers to the
                 * command, increment the reference count in the
                 * Command structure to reflect the new reference from
                 * the CmdName object and, if the command is deleted
                 * later, to keep the Command structure from being freed
                 * until TclExecuteByteCode has a chance to recognize
                 * that the command was deleted.
                 */

                objIndex = TclObjIndexForString(src, numChars,
                      /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
                if (cmdPtr != NULL) {
                  objPtr = envPtr->objArrayPtr[objIndex];
                  if ((objPtr->typePtr != &tclCmdNameType)
                          && (objPtr->bytes != NULL)) {
                      ResolvedCmdName *resPtr = (ResolvedCmdName *)
                                    ckalloc(sizeof(ResolvedCmdName));
                            Namespace *nsPtr = (Namespace *) 
                            Tcl_GetCurrentNamespace(interp);

                            resPtr->cmdPtr = cmdPtr;
                            resPtr->refNsPtr = nsPtr;
                      resPtr->refNsId = nsPtr->nsId;
                            resPtr->refNsCmdEpoch = nsPtr->cmdRefEpoch;
                            resPtr->cmdEpoch = cmdPtr->cmdEpoch;
                            resPtr->refCount = 1;
                      objPtr->internalRep.twoPtrValue.ptr1 =
                        (VOID *) resPtr;
                      objPtr->internalRep.twoPtrValue.ptr2 = NULL;
                            objPtr->typePtr = &tclCmdNameType;
                      cmdPtr->refCount++;
                  }
                }
            } else {
                /*
                 * See if the word represents an integer whose formatted
                 * representation is the same as the word (e.g., this is
                 * true for 123 and -1 but not for 00005). If so, just
                 * push an integer object.
                 */

                int isCompilableInt = 0;
                long n;
                char buf[40];
                
                if (TclLooksLikeInt(src)) {
                  int code = TclGetLong(interp, src, &n);
                  if (code == TCL_OK) {
                      TclFormatInt(buf, n);
                      if (strcmp(src, buf) == 0) {
                        isCompilableInt = 1;
                        objIndex = TclObjIndexForString(src,
                              numChars, /*allocStrRep*/ 0,
                              /*inHeap*/ 0, envPtr);
                        objPtr = envPtr->objArrayPtr[objIndex];

                        Tcl_InvalidateStringRep(objPtr);
                        objPtr->internalRep.longValue = n;
                        objPtr->typePtr = &tclIntType;
                      }
                  } else {
                      Tcl_ResetResult(interp);
                  }
                }
                if (!isCompilableInt) {
                  objIndex = TclObjIndexForString(src, numChars,
                          /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
                }
            }
            src[numChars] = savedChar;
            TclEmitPush(objIndex, envPtr);
            maxDepth = TclMax((cmdWords + 1), maxDepth);
          } else {            /* not a simple word */
            maxDepth = TclMax((cmdWords + envPtr->maxStackDepth),
                         maxDepth);
          }
          src = termPtr;
          c = *src;
          type = CHAR_TYPE(src, lastChar);
          cmdWords++;
      }
      
      /*
       * Emit an invoke instruction for the command. If a compile command
       * was found for the command we called it and skipped this.
       */

      if (cmdWords > 0) {
          if (cmdWords <= 255) {
              TclEmitInstUInt1(INST_INVOKE_STK1, cmdWords, envPtr);
            } else {
              TclEmitInstUInt4(INST_INVOKE_STK4, cmdWords, envPtr);
            }
      }

      /*
       * Update the compilation environment structure. Record
       * source/object information for the command.
       */

        finishCommand:
      EnterCmdExtentData(envPtr, cmdIndex, src-cmdSrcStart,
              (envPtr->codeNext-envPtr->codeStart) - cmdCodeOffset);
      
      isFirstCmd = 0;
      envPtr->termOffset = (src - string);
      c = *src;
    }

    done:
    if (result == TCL_OK) {
      /*
       * If the source string yielded no instructions (e.g., if it was
       * empty), push an empty string object as the command's result.
       */
    
      if (entryCodeNext == envPtr->codeNext) {
          int objIndex = TclObjIndexForString("", 0, /*allocStrRep*/ 0,
                                                /*inHeap*/ 0, envPtr);
          TclEmitPush(objIndex, envPtr);
          maxDepth = 1;
      }
    } else {
      /*
       * Add additional error information. First compute the line number
       * where the error occurred.
       */

      register char *p;
      int numChars;
      char buf[200];

      iPtr->errorLine = 1;
      for (p = string;  p != cmdSrcStart;  p++) {
          if (*p == '\n') {
            iPtr->errorLine++;
          }
      }
      for (  ; isspace(UCHAR(*p)) || (*p == ';');  p++) {
          if (*p == '\n') {
            iPtr->errorLine++;
          }
      }

      /*
       * Figure out how much of the command to print (up to a certain
       * number of characters, or up to the end of the command).
       */

      p = cmdSrcStart;
      while ((CHAR_TYPE(p, lastChar) != TCL_COMMAND_END)
            || ((*p == ']') && !(flags & TCL_BRACKET_TERM))) {
          p++;
      }
      numChars = (p - cmdSrcStart);
      if (numChars > 150) {
          numChars = 150;
          ellipsis = " ...";
      } else if ((numChars >= 2) && (*p == '\n') && (*(p-1) == '{')) {
          ellipsis = " ...";
      }
      
      sprintf(buf, "\n    while compiling\n\"%.*s%s\"",
            numChars, cmdSrcStart, ellipsis);
      Tcl_AddObjErrorInfo(interp, buf, -1);
    } 
      
    envPtr->termOffset = (src - string);
    iPtr->termOffset = envPtr->termOffset;
    envPtr->maxStackDepth = maxDepth;
    envPtr->pushSimpleWords = savePushSimpleWords;
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * CompileWord --
 *
 *    This procedure compiles one word from a command string. It skips
 *    any leading white space.
 *
 *    Ordinarily, callers set envPtr->pushSimpleWords to 1 and this
 *    procedure emits push and other instructions to compute the
 *    word on the Tcl evaluation stack at execution time. If a caller sets
 *    envPtr->pushSimpleWords to 0, CompileWord will _not_ compile
 *    "simple" words: words that are just a sequence of characters without
 *    backslashes. It will leave their compilation up to the caller.
 *
 *    As an important special case, if the word is simple, this procedure
 *    sets envPtr->wordIsSimple to 1 and envPtr->numSimpleWordChars to the
 *    number of characters in the simple word. This allows the caller to
 *    process these words specially.
 *
 * Results:
 *    The return value is a standard Tcl result. If an error occurs, an
 *    error message is left in the interpreter's result.
 *    
 *    envPtr->termOffset is filled in with the offset of the character in
 *    "string" just after the last one successfully processed in the last
 *    word. This is normally the character just after the last one in a
 *    word (perhaps the command terminator), or the vicinity of an error
 *    (if the result is not TCL_OK).
 *
 *    envPtr->wordIsSimple is set 1 if the word is simple: just a
 *    sequence of characters without backslashes. If so, the word's
 *    characters are the envPtr->numSimpleWordChars characters starting 
 *    at string.
 *
 *    envPtr->maxStackDepth is updated with the maximum number of stack
 *    elements needed to evaluate the word. This is not changed if
 *    the word is simple and envPtr->pushSimpleWords was 0 (false).
 *
 * Side effects:
 *    Instructions are added to envPtr to compute and push the word
 *    at runtime.
 *
 *----------------------------------------------------------------------
 */

static int
CompileWord(interp, string, lastChar, flags, envPtr)
    Tcl_Interp *interp;       /* Interpreter to use for nested command
                         * evaluations and error messages. */
    char *string;       /* First character of word. */
    char *lastChar;            /* Pointer to terminating character of
                          * string. */
    int flags;                /* Flags to control compilation (same values
                         * passed to Tcl_EvalObj). */
    CompileEnv *envPtr;       /* Holds the resulting instructions. */
{
    /*
     * Compile one word: approximately
     *
     * word:             quoted_string | braced_string | multipart_word
     * quoted_string:    '"' char* '"'
     * braced_string:    '{' char* '}'
     * multipart_word    (see CompileMultipartWord below)
     */
    
    register char *src = string; /* Points to current source char. */
    register int type = CHAR_TYPE(src, lastChar);
                         /* Current char's CHAR_TYPE type. */
    int maxDepth = 0;          /* Maximum number of stack elements needed
                          * to compute and push the word. */
    char *termPtr = src;       /* Points to the character that terminated
                          * the word. */
    int result = TCL_OK;

    /*
     * Skip any leading white space at the start of a word. Note that a
     * backslash-newline is treated as a space.
     */

    while (type & (TCL_SPACE | TCL_BACKSLASH)) {
      if (type == TCL_BACKSLASH) {
          if (src[1] == '\n') {
            src += 2;
          } else {
            break;            /* no longer white space */
          }
      } else {
          src++;
      }
      type = CHAR_TYPE(src, lastChar);
    }
    if (type == TCL_COMMAND_END) {
      goto done;
    }

    /*
     * Compile the word. Handle quoted and braced string words here in order
     * to avoid an extra procedure call.
     */

    if (type & (TCL_QUOTE | TCL_OPEN_BRACE)) {
      src++;
      if (type == TCL_QUOTE) {
          result = TclCompileQuotes(interp, src, lastChar, '"', flags,
                envPtr);
      } else {
          result = CompileBraces(interp, src, lastChar, flags, envPtr);
      }
      termPtr = (src + envPtr->termOffset);
      if (result != TCL_OK) {
          goto done;
      }
      
      /*
       * Make sure terminating character of the quoted or braced string is
       * the end of word.
       */
      
      if ((*termPtr == '\\') && (*(termPtr+1) == '\n')) {
          /*
           * Line is continued on next line; the backslash-newline turns
           * into space, which terminates the word.
           */
      } else {
          type = CHAR_TYPE(termPtr, lastChar);
          if (!(type & (TCL_SPACE | TCL_COMMAND_END))) {
            Tcl_ResetResult(interp);
            if (*(src-1) == '"') {
                Tcl_AppendToObj(Tcl_GetObjResult(interp),
                        "extra characters after close-quote", -1);
            } else {
                Tcl_AppendToObj(Tcl_GetObjResult(interp),
                      "extra characters after close-brace", -1);
            }
            result = TCL_ERROR;
            goto done;
          }
      }
      maxDepth = envPtr->maxStackDepth;
    } else {
      result = CompileMultipartWord(interp, src, lastChar, flags, envPtr);
      termPtr = (src + envPtr->termOffset);
      maxDepth = envPtr->maxStackDepth;
    }

    /*
     * Done processing the word. The values of envPtr->wordIsSimple and
     * envPtr->numSimpleWordChars are left at the values returned by
     * TclCompileQuotes/Braces/MultipartWord.
     */
    
    done:
    envPtr->termOffset = (termPtr - string);
    envPtr->maxStackDepth = maxDepth;
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * CompileMultipartWord --
 *
 *    This procedure compiles one multipart word: a word comprised of some
 *    number of nested commands, variable references, or arbitrary
 *    characters. This procedure assumes that quoted string and braced
 *    string words and the end of command have already been handled by its
 *    caller. It also assumes that any leading white space has already
 *    been consumed.
 *
 *    Ordinarily, callers set envPtr->pushSimpleWords to 1 and this
 *    procedure emits push and other instructions to compute the word on
 *    the Tcl evaluation stack at execution time. If a caller sets
 *    envPtr->pushSimpleWords to 0, it will _not_ compile "simple" words:
 *    words that are just a sequence of characters without backslashes.
 *    It will leave their compilation up to the caller. This is done, for
 *    example, to provide special support for the first word of commands,
 *    which are almost always the (simple) name of a command.
 *
 *    As an important special case, if the word is simple, this procedure
 *    sets envPtr->wordIsSimple to 1 and envPtr->numSimpleWordChars to the
 *    number of characters in the simple word. This allows the caller to
 *    process these words specially.
 *
 * Results:
 *    The return value is a standard Tcl result. If an error occurs, an
 *    error message is left in the interpreter's result.
 *    
 *    envPtr->termOffset is filled in with the offset of the character in
 *    "string" just after the last one successfully processed in the last
 *    word. This is normally the character just after the last one in a
 *    word (perhaps the command terminator), or the vicinity of an error
 *    (if the result is not TCL_OK).
 *
 *    envPtr->wordIsSimple is set 1 if the word is simple: just a
 *    sequence of characters without backslashes. If so, the word's
 *    characters are the envPtr->numSimpleWordChars characters starting 
 *    at string.
 *
 *    envPtr->maxStackDepth is updated with the maximum number of stack
 *    elements needed to evaluate the word. This is not changed if
 *    the word is simple and envPtr->pushSimpleWords was 0 (false).
 *
 * Side effects:
 *    Instructions are added to envPtr to compute and push the word
 *    at runtime.
 *
 *----------------------------------------------------------------------
 */

static int
CompileMultipartWord(interp, string, lastChar, flags, envPtr)
    Tcl_Interp *interp;       /* Interpreter to use for nested command
                         * evaluations and error messages. */
    char *string;       /* First character of word. */
    char *lastChar;            /* Pointer to terminating character of
                          * string. */
    int flags;                /* Flags to control compilation (same values
                         * passed to Tcl_EvalObj). */
    CompileEnv *envPtr;       /* Holds the resulting instructions. */
{
    /*
     * Compile one multi_part word:
     *
     * multi_part_word:  word_part+
     * word_part:        nested_cmd | var_reference | char+
     * nested_cmd:       '[' command ']'
     * var_reference:    '$' name | '$' name '(' index_string ')' |
     *                   '$' '{' braced_name '}')
     * name:             (letter | digit | underscore)+
     * braced_name:      (non_close_brace_char)*
     * index_string:     (non_close_paren_char)*
     */
    
    register char *src = string; /* Points to current source char. */
    register char c = *src;   /* The current char. */
    register int type;        /* Current char's CHAR_TYPE type. */
    int bracketNormal = !(flags & TCL_BRACKET_TERM);
    int simpleWord = 0;       /* Set 1 if word is simple. */
    int numParts = 0;         /* Count of word_part objs pushed. */
    int maxDepth = 0;         /* Maximum number of stack elements needed
                         * to compute and push the word. */
    char *start;        /* Starting position of char+ word_part. */
    int hasBackslash;         /* Nonzero if '\' in char+ word_part. */
    int numChars;       /* Number of chars in char+ word_part. */
    char savedChar;           /* Holds the character from string
                         * termporarily replaced by a null character
                         * during word_part processing. */
    int objIndex;       /* The object array index for a pushed
                         * object holding a word_part. */
    int savePushSimpleWords = envPtr->pushSimpleWords;
    int result = TCL_OK;
    int numRead;
#ifdef KANJI
    int kanjiCode = TCL_ANY;

    envPtr->lastScannedKanjiCode = TCL_ANY;
#endif /* KANJI */

    type = CHAR_TYPE(src, lastChar);
    while (1) {
      /*
       * Process a word_part: a sequence of chars, a var reference, or
       * a nested command.
       */

      if ((type & (TCL_NORMAL | TCL_CLOSE_BRACE | TCL_BACKSLASH |
                 TCL_QUOTE | TCL_OPEN_BRACE)) ||
          ((c == ']') && bracketNormal)) {
          /*
           * A char+ word part. Scan first looking for any backslashes.
           * Note that a backslash-newline must be treated as a word
           * separator, as if the backslash-newline had been collapsed
           * before command parsing began.
           */
          
          start = src;
          hasBackslash = 0;
          do {
#ifdef KANJI
              if (IS_KANJISTART(UCHAR(c))) {
                src += Tcl_KanjiSkip(src, lastChar, &kanjiCode);
                if (kanjiCode != TCL_ANY && kanjiCode != TCL_NOT_KANJI) {
                  envPtr->lastScannedKanjiCode = kanjiCode;
                }
            } else
#endif /* KANJI */
            if (type == TCL_BACKSLASH) {
                hasBackslash = 1;
                Tcl_Backslash(src, &numRead);
                if (src[1] == '\n') {
                  src += numRead;
                  type = TCL_SPACE; /* force word end */
                  break;
                }
                src += numRead;
            } else {
                src++;
            }
            c = *src;
            type = CHAR_TYPE(src, lastChar);
          } while (type & (TCL_NORMAL | TCL_BACKSLASH | TCL_QUOTE |
                      TCL_OPEN_BRACE | TCL_CLOSE_BRACE)
                      || ((c == ']') && bracketNormal));

          if ((numParts == 0) && !hasBackslash
                && (type & (TCL_SPACE | TCL_COMMAND_END))) {
            /*
             * The word is "simple": just a sequence of characters
             * without backslashes terminated by a TCL_SPACE or
             * TCL_COMMAND_END. Just return if we are not to compile
             * simple words.
             */

            simpleWord = 1;
            if (!envPtr->pushSimpleWords) {
                envPtr->wordIsSimple = 1;
                envPtr->numSimpleWordChars = (src - string);
                envPtr->termOffset = envPtr->numSimpleWordChars;
                envPtr->pushSimpleWords = savePushSimpleWords;
                return TCL_OK;
            }
          }

          /*
           * Create and push a string object for the char+ word_part,
           * which starts at "start" and ends at the char just before
           * src. If backslashes were found, copy the word_part's
           * characters with substituted backslashes into a heap-allocated
           * buffer and use it to create the string object. Temporarily
           * replace the terminating character with a null character.
           */

          numChars = (src - start);
          savedChar = start[numChars];
          start[numChars] = '\0';
          if ((numChars > 0) && (hasBackslash)) {
            char *buffer = ckalloc((unsigned) numChars + 1);
            register char *dst = buffer;
            register char *p = start;
#ifdef KANJI
            int doConv = envPtr->iPtr->kanjiConvertWhenCompile;
#endif /* KANJI */
            while (p < src) {
                if (*p == '\\') {   
                  *dst = Tcl_Backslash(p, &numRead);
                  if (p[1] == '\n') {
                      break;
                  }
                  p += numRead;
                  dst++;
                } else {
                  *dst++ = *p++;
                }
            }
            *dst = '\0';
#ifdef KANJI
            /* Avoiding re-conversion of backslash sequence to kanji. */
            envPtr->iPtr->kanjiConvertWhenCompile = BS_ASUMP_KANJI;
#endif /* KANJI */
            objIndex = TclObjIndexForString(buffer, dst-buffer,
                  /*allocStrRep*/ 1, /*inHeap*/ 1, envPtr);
#ifdef KANJI
            envPtr->iPtr->kanjiConvertWhenCompile = doConv;
#endif /* KANJI */
          } else {
            objIndex = TclObjIndexForString(start, numChars,
                  /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
          }
          start[numChars] = savedChar;
          TclEmitPush(objIndex, envPtr);
          maxDepth = TclMax((numParts + 1), maxDepth);
      } else if (type == TCL_DOLLAR) {
          result = TclCompileDollarVar(interp, src, lastChar,
                flags, envPtr);
          src += envPtr->termOffset;
          if (result != TCL_OK) {
            goto done;
          }
          maxDepth = TclMax((numParts + envPtr->maxStackDepth), maxDepth);
          c = *src;
          type = CHAR_TYPE(src, lastChar);
      } else if (type == TCL_OPEN_BRACKET) {
          char *termPtr;
          envPtr->pushSimpleWords = 1;
          src++;
          result = TclCompileString(interp, src, lastChar,
                              (flags | TCL_BRACKET_TERM), envPtr);
          termPtr = (src + envPtr->termOffset);
          if (*termPtr == ']') {
            termPtr++;
          } else if (*termPtr == '\0') {
            /*
             * Missing ] at end of nested command.
             */
            
            Tcl_ResetResult(interp);
            Tcl_AppendToObj(Tcl_GetObjResult(interp),
                    "missing close-bracket", -1);
            result = TCL_ERROR;
          }
          src = termPtr;
          if (result != TCL_OK) {
            goto done;
          }
          maxDepth = TclMax((numParts + envPtr->maxStackDepth), maxDepth);
          c = *src;
          type = CHAR_TYPE(src, lastChar);
      } else if (type & (TCL_SPACE | TCL_COMMAND_END)) {
          goto wordEnd;
      }
      numParts++;
    } /* end of infinite loop */

    wordEnd:
    /*
     * End of a non-simple word: TCL_SPACE, TCL_COMMAND_END, or
     * backslash-newline. Concatenate the word_parts if necessary.
     */

    while (numParts > 255) {
      TclEmitInstUInt1(INST_CONCAT1, 255, envPtr);
      numParts -= 254;  /* concat pushes 1 obj, the result */
    }
    if (numParts > 1) {
      TclEmitInstUInt1(INST_CONCAT1, numParts, envPtr);
    }

    done:
    if (simpleWord) {
      envPtr->wordIsSimple = 1;
      envPtr->numSimpleWordChars = (src - string);
    } else {
      envPtr->wordIsSimple = 0;
      envPtr->numSimpleWordChars = 0;
    }
    envPtr->termOffset = (src - string);
    envPtr->maxStackDepth = maxDepth;
    envPtr->pushSimpleWords = savePushSimpleWords;
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileQuotes --
 *
 *    This procedure compiles a double-quoted string such as a quoted Tcl
 *    command argument or a quoted value in a Tcl expression. This
 *    procedure is also used to compile array element names within
 *    parentheses (where the termChar will be ')' instead of '"'), or
 *    anything else that needs the substitutions that happen in quotes.
 *
 *    Ordinarily, callers set envPtr->pushSimpleWords to 1 and
 *    TclCompileQuotes always emits push and other instructions to compute
 *    the word on the Tcl evaluation stack at execution time. If a caller
 *    sets envPtr->pushSimpleWords to 0, TclCompileQuotes will not compile
 *    "simple" words: words that are just a sequence of characters without
 *    backslashes. It will leave their compilation up to the caller. This
 *    is done to provide special support for the first word of commands,
 *    which are almost always the (simple) name of a command.
 *
 *    As an important special case, if the word is simple, this procedure
 *    sets envPtr->wordIsSimple to 1 and envPtr->numSimpleWordChars to the
 *    number of characters in the simple word. This allows the caller to
 *    process these words specially.
 *
 * Results:
 *    The return value is a standard Tcl result, which is TCL_OK unless
 *    there was an error while parsing the quoted string. If an error
 *    occurs then the interpreter's result contains a standard error
 *    message.
 *
 *    envPtr->termOffset is filled in with the offset of the character in
 *    "string" just after the last one successfully processed; this is
 *    usually the character just after the matching close-quote.
 *
 *    envPtr->wordIsSimple is set 1 if the word is simple: just a
 *    sequence of characters without backslashes. If so, the word's
 *    characters are the envPtr->numSimpleWordChars characters starting 
 *    at string.
 *
 *    envPtr->maxStackDepth is updated with the maximum number of stack
 *    elements needed to evaluate the word. This is not changed if
 *    the word is simple and envPtr->pushSimpleWords was 0 (false).
 *
 * Side effects:
 *    Instructions are added to envPtr to push the quoted-string
 *    at runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileQuotes(interp, string, lastChar, termChar, flags, envPtr)
    Tcl_Interp *interp;        /* Interpreter to use for nested command
                          * evaluations and error messages. */
    char *string;        /* Points to the character just after
                          * the opening '"' or '('. */
    char *lastChar;            /* Pointer to terminating character of
                          * string. */
    int termChar;        /* Character that terminates the "quoted"
                          * string (usually double-quote, but might
                          * be right-paren or something else). */
    int flags;                 /* Flags to control compilation (same 
                          * values passed to Tcl_Eval). */
    CompileEnv *envPtr;        /* Holds the resulting instructions. */
{
    register char *src = string; /* Points to current source char. */
    register char c = *src;    /* The current char. */
    int simpleWord = 0;        /* Set 1 if a simple quoted string word. */
    char *start;         /* Start position of char+ string_part. */
    int hasBackslash;            /* 1 if '\' found in char+ string_part. */
    int numRead;         /* Count of chars read by Tcl_Backslash. */
    int numParts = 0;            /* Count of string_part objs pushed. */
    int maxDepth = 0;          /* Maximum number of stack elements needed
                          * to compute and push the string. */
    char savedChar;            /* Holds the character from string
                          * termporarily replaced by a null 
                          * char during string_part processing. */
    int objIndex;        /* The object array index for a pushed
                          * object holding a string_part. */
    int numChars;        /* Number of chars in string_part. */
    int savePushSimpleWords = envPtr->pushSimpleWords;
    int result = TCL_OK;
#ifdef KANJI
    int kanjiCode = TCL_ANY;

    envPtr->lastScannedKanjiCode = TCL_ANY;
#endif /* KANJI */
    
    /*
     * quoted_string: '"' string_part* '"'   (or termChar instead of ")
     * string_part:   var_reference | nested_cmd | char+
     */


    while ((src != lastChar) && (c != termChar)) {
      if (c == '$') {
          result = TclCompileDollarVar(interp, src, lastChar, flags,
                envPtr);
          src += envPtr->termOffset;
          if (result != TCL_OK) {
            goto done;
          }
          maxDepth = TclMax((numParts + envPtr->maxStackDepth), maxDepth);
          c = *src;
        } else if (c == '[') {
          char *termPtr;
          envPtr->pushSimpleWords = 1;
          src++;
          result = TclCompileString(interp, src, lastChar,
                              (flags | TCL_BRACKET_TERM), envPtr);
          termPtr = (src + envPtr->termOffset);
          if (*termPtr == ']') {
            termPtr++;
          }
          src = termPtr;
          if (result != TCL_OK) {
            goto done;
          }
          if (termPtr == lastChar) {
            /*
             * Missing ] at end of nested command.
             */
            
            Tcl_ResetResult(interp);
            Tcl_AppendToObj(Tcl_GetObjResult(interp),
                    "missing close-bracket", -1);
            result = TCL_ERROR;
            goto done;
          }
          maxDepth = TclMax((numParts + envPtr->maxStackDepth), maxDepth);
          c = *src;
        } else {
          /*
           * Start of a char+ string_part. Scan first looking for any
           * backslashes.
           */

          start = src;
          hasBackslash = 0;
          do {
#ifdef KANJI
              if (IS_KANJISTART(UCHAR(c))) {
                src += Tcl_KanjiSkip(src, lastChar, &kanjiCode);
                if (kanjiCode != TCL_ANY && kanjiCode != TCL_NOT_KANJI) {
                  envPtr->lastScannedKanjiCode = kanjiCode;
                    }
            } else
#endif /* KANJI */
            if (c == '\\') {
                hasBackslash = 1;
                Tcl_Backslash(src, &numRead);
                src += numRead;
            } else {
                src++;
            }
            c = *src;
            } while ((src != lastChar) && (c != '$') && (c != '[')
                && (c != termChar));
          
          if ((numParts == 0) && !hasBackslash
                && ((src == lastChar) && (c == termChar))) {
            /*
             * The quoted string is "simple": just a sequence of
             * characters without backslashes terminated by termChar or
             * a null character. Just return if we are not to compile
             * simple words.
             */

            simpleWord = 1;
            if (!envPtr->pushSimpleWords) {
                if ((src == lastChar) && (termChar != '\0')) {
                  char buf[40];
                  sprintf(buf, "missing %c", termChar);
                  Tcl_ResetResult(interp);
                  Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
                  result = TCL_ERROR;
                } else {
                  src++;
                }
                envPtr->wordIsSimple = 1;
                envPtr->numSimpleWordChars = (src - string - 1);
                envPtr->termOffset = (src - string);
                envPtr->pushSimpleWords = savePushSimpleWords;
                return result;
            }
          }

          /*
           * Create and push a string object for the char+ string_part
           * that starts at "start" and ends at the char just before
           * src. If backslashes were found, copy the string_part's
           * characters with substituted backslashes into a heap-allocated
           * buffer and use it to create the string object. Temporarily
           * replace the terminating character with a null character.
           */
          
          numChars = (src - start);
          savedChar = start[numChars];
          start[numChars] = '\0';
          if ((numChars > 0) && (hasBackslash)) {
            char *buffer = ckalloc((unsigned) numChars + 1);
            register char *dst = buffer;
            register char *p = start;
#ifdef KANJI
            int doConv = envPtr->iPtr->kanjiConvertWhenCompile;
#endif /* KANJI */
            while (p < src) {
                if (*p == '\\') {
                  *dst++ = Tcl_Backslash(p, &numRead);
                  p += numRead;
                } else {
                  *dst++ = *p++;
                }
            }
            *dst = '\0';
#ifdef KANJI
                /* Avoiding re-conversion of backslash sequence to kanji. */
            if (envPtr->lastScannedKanjiCode == TCL_ANY) {
                /*
                 * means if kanji is found, convert to internal.
                 */
                envPtr->iPtr->kanjiConvertWhenCompile = BS_ASUMP_KANJI;
            }
#endif /* KANJI */
            objIndex = TclObjIndexForString(buffer, (dst - buffer),
                  /*allocStrRep*/ 1, /*inHeap*/ 1, envPtr);
#ifdef KANJI
            envPtr->iPtr->kanjiConvertWhenCompile = doConv;
#endif /* KANJI */
          } else {
            objIndex = TclObjIndexForString(start, numChars,
                  /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
          }
          start[numChars] = savedChar;
          TclEmitPush(objIndex, envPtr);
          maxDepth = TclMax((numParts + 1), maxDepth);
        }
      numParts++;
    } 
          
    /*
     * End of the quoted string: src points at termChar or '\0'. If
     * necessary, concatenate the string_part objects on the stack.
     */

    if ((src == lastChar) && (termChar != '\0')) {
      char buf[40];
      sprintf(buf, "missing %c", termChar);
      Tcl_ResetResult(interp);
      Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
      result = TCL_ERROR;
      goto done;
    } else {
      src++;
    }

    if (numParts == 0) {
      /*
       * The quoted string was empty. Push an empty string object.
       */

      int objIndex = TclObjIndexForString("", 0, /*allocStrRep*/ 0,
                                            /*inHeap*/ 0, envPtr);
      TclEmitPush(objIndex, envPtr);
    } else {
      /*
       * Emit any needed concat instructions.
       */
      
      while (numParts > 255) {
          TclEmitInstUInt1(INST_CONCAT1, 255, envPtr);
          numParts -= 254;  /* concat pushes 1 obj, the result */
      }
      if (numParts > 1) {
          TclEmitInstUInt1(INST_CONCAT1, numParts, envPtr);
      }
    }

    done:
    if (simpleWord) {
      envPtr->wordIsSimple = 1;
      envPtr->numSimpleWordChars = (src - string - 1);
    } else {
      envPtr->wordIsSimple = 0;
      envPtr->numSimpleWordChars = 0;
    }
    envPtr->termOffset = (src - string);
    envPtr->maxStackDepth = maxDepth;
    envPtr->pushSimpleWords = savePushSimpleWords;
    return result;
}

/*
 *--------------------------------------------------------------
 *
 * CompileBraces --
 *
 *    This procedure compiles characters between matching curly braces.
 *
 *    Ordinarily, callers set envPtr->pushSimpleWords to 1 and
 *    CompileBraces always emits a push instruction to compute the word on
 *    the Tcl evaluation stack at execution time. However, if a caller
 *    sets envPtr->pushSimpleWords to 0, CompileBraces will _not_ compile
 *    "simple" words: words that are just a sequence of characters without
 *    backslash-newlines. It will leave their compilation up to the
 *    caller.
 *
 *    As an important special case, if the word is simple, this procedure
 *    sets envPtr->wordIsSimple to 1 and envPtr->numSimpleWordChars to the
 *    number of characters in the simple word. This allows the caller to
 *    process these words specially.
 *
 * 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->termOffset is filled in with the offset of the character in
 *    "string" just after the last one successfully processed. This is
 *    usually the character just after the matching close-brace.
 *
 *    envPtr->wordIsSimple is set 1 if the word is simple: just a
 *    sequence of characters without backslash-newlines. If so, the word's
 *    characters are the envPtr->numSimpleWordChars characters starting 
 *    at string.
 *
 *    envPtr->maxStackDepth is updated with the maximum number of stack
 *    elements needed to evaluate the word. This is not changed if
 *    the word is simple and envPtr->pushSimpleWords was 0 (false).
 *
 * Side effects:
 *    Instructions are added to envPtr to push the braced string
 *    at runtime.
 *
 *--------------------------------------------------------------
 */

static int
CompileBraces(interp, string, lastChar, flags, envPtr)
    Tcl_Interp *interp;        /* Interpreter to use for nested command
                          * evaluations and error messages. */
    char *string;        /* Character just after opening bracket. */
    char *lastChar;            /* Pointer to terminating character of
                          * string. */
    int flags;                 /* Flags to control compilation (same 
                          * values passed to Tcl_Eval). */
    CompileEnv *envPtr;        /* Holds the resulting instructions. */
{
    register char *src = string; /* Points to current source char. */
    register char c;           /* The current char. */
    int simpleWord = 0;        /* Set 1 if a simple braced string word. */
    int level = 1;             /* {} nesting level. Initially 1 since {
                          * was parsed before we were called. */
    int hasBackslashNewline = 0; /* Nonzero if '\' found. */
    char *last;                /* Points just before terminating '}'. */
    int numChars;        /* Number of chars in braced string. */
    char savedChar;            /* Holds the character from string
                          * termporarily replaced by a null 
                          * char during braced string processing. */
    int objIndex;        /* The object array index for a pushed
                          * object holding a braced string. */
    int numRead;
    int result = TCL_OK;

#ifdef KANJI
    int kanjiCode = TCL_ANY;

    envPtr->lastScannedKanjiCode = TCL_ANY;
#endif /* KANJI */

    /*
     * Check for any backslash-newlines, since we must treat
     * backslash-newlines specially (they must be replaced by spaces).
     */

    while (1) {
      c = *src;
      if (src == lastChar) {
          Tcl_ResetResult(interp);
          Tcl_AppendToObj(Tcl_GetObjResult(interp),
                "missing close-brace", -1);
          result = TCL_ERROR;
          goto done;
      }
#ifdef KANJI
        if (IS_KANJISTART(UCHAR(c))) {
          src += Tcl_KanjiSkip(src, lastChar, &kanjiCode);
          if (kanjiCode != TCL_ANY && kanjiCode != TCL_NOT_KANJI) {
            envPtr->lastScannedKanjiCode = kanjiCode;
          }
          continue;
        } else
#endif /* KANJI */
      if (CHAR_TYPE(src, lastChar) != TCL_NORMAL) {
          if (c == '{') {
            level++;
          } else if (c == '}') {
            --level;
            if (level == 0) {
                src++;
                last = (src - 2); /* point just before terminating } */
                break;
            }
          } else if (c == '\\') {
            if (*(src+1) == '\n') {
                hasBackslashNewline = 1;
            }
            (void) Tcl_Backslash(src, &numRead);
            src += numRead - 1;
          }
      }
      src++;
    }

    if (!hasBackslashNewline) {
      /*
       * The braced word is "simple": just a sequence of characters
       * without backslash-newlines. Just return if we are not to compile
       * simple words.
       */

      simpleWord = 1;
      if (!envPtr->pushSimpleWords) {
          envPtr->wordIsSimple = 1;
          envPtr->numSimpleWordChars = (src - string - 1);
          envPtr->termOffset = (src - string);
          return TCL_OK;
      }
    }

    /*
     * Create and push a string object for the braced string. This starts at
     * "string" and ends just after "last" (which points to the final
     * character before the terminating '}'). If backslash-newlines were
     * found, we copy characters one at a time into a heap-allocated buffer
     * and do backslash-newline substitutions.
     */

    numChars = (last - string + 1);
    savedChar = string[numChars];
    string[numChars] = '\0';
    if ((numChars > 0) && (hasBackslashNewline)) {
      char *buffer = ckalloc((unsigned) numChars + 1);
      register char *dst = buffer;
      register char *p = string;
#ifdef KANJI
      int doConv = envPtr->iPtr->kanjiConvertWhenCompile;
#endif /* KANJI */
      while (p <= last) {
          c = *dst++ = *p++;
          if (c == '\\') {
            if (*p == '\n') {
                dst[-1] = Tcl_Backslash(p-1, &numRead);
                p += numRead - 1;
            } else {
                (void) Tcl_Backslash(p-1, &numRead);
                while (numRead > 1) {
                  *dst++ = *p++;
                  numRead--;
                }
            }
          }
      }
      *dst = '\0';
#ifdef KANJI
      /* Avoiding re-conversion of backslash sequence to kanji. */
      envPtr->iPtr->kanjiConvertWhenCompile = BS_ASUMP_KANJI;
#endif /* KANJI */
      objIndex = TclObjIndexForString(buffer, (dst - buffer),
            /*allocStrRep*/ 1, /*inHeap*/ 1, envPtr);
#ifdef KANJI
      envPtr->iPtr->kanjiConvertWhenCompile = doConv;
#endif /* KANJI */
    } else {
      objIndex = TclObjIndexForString(string, numChars, /*allocStrRep*/ 1,
                                        /*inHeap*/ 0, envPtr);
    }
    string[numChars] = savedChar;
    TclEmitPush(objIndex, envPtr);

    done:
    if (simpleWord) {
      envPtr->wordIsSimple = 1;
      envPtr->numSimpleWordChars = (src - string - 1);
    } else {
      envPtr->wordIsSimple = 0;
      envPtr->numSimpleWordChars = 0;
    }
    envPtr->termOffset = (src - string);
    envPtr->maxStackDepth = 1;
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileDollarVar --
 *
 *    Given a string starting with a $ sign, parse a variable name
 *    and compile instructions to push its value. If the variable
 *    reference is just a '$' (i.e. the '$' isn't followed by anything
 *    that could possibly be a variable name), just push a string object
 *    containing '$'.
 *
 * Results:
 *    The return value is a standard Tcl result. If an error occurs
 *    then an error message is left in the interpreter's result.
 *
 *    envPtr->termOffset is filled in with the offset of the character in
 *    "string" just after the last one in the variable reference.
 *
 *    envPtr->wordIsSimple is set 0 (false) because the word is not
 *    simple: it is not just a sequence of characters without backslashes.
 *    For the same reason, envPtr->numSimpleWordChars is set 0.
 *
 *    envPtr->maxStackDepth is updated with the maximum number of stack
 *    elements needed to execute the string's commands.
 *
 * Side effects:
 *    Instructions are added to envPtr to look up the variable and
 *    push its value at runtime.
 *
 *----------------------------------------------------------------------
 */
    
int
TclCompileDollarVar(interp, string, lastChar, flags, envPtr)
    Tcl_Interp *interp;        /* Interpreter to use for nested command
                          * evaluations and error messages. */
    char *string;        /* First char (i.e. $) of var reference. */
    char *lastChar;            /* Pointer to terminating character of
                          * string. */
    int flags;                 /* Flags to control compilation (same
                          * values passed to Tcl_Eval). */
    CompileEnv *envPtr;        /* Holds the resulting instructions. */
{
    register char *src = string; /* Points to current source char. */
    register char c;           /* The current char. */
    char *name;                /* Start of 1st part of variable name. */
    int nameChars;             /* Count of chars in name. */
    int nameHasNsSeparators = 0; /* Set 1 if name contains "::"s. */
    char savedChar;            /* Holds the character from string
                          * termporarily replaced by a null 
                          * char during name processing. */
    int objIndex;        /* The object array index for a pushed
                          * object holding a name part. */
    int isArrayRef = 0;        /* 1 if reference to array element. */
    int localIndex = -1;       /* Frame index of local if found.  */
    int maxDepth = 0;          /* Maximum number of stack elements needed
                          * to push the variable. */
    int savePushSimpleWords = envPtr->pushSimpleWords;
    int result = TCL_OK;
#ifdef KANJI
    int kanjiCode = TCL_ANY;

    envPtr->lastScannedKanjiCode = TCL_ANY;
#endif /* KANJI */

    /*
     * var_reference: '$' '{' braced_name '}' |
     *                '$' name ['(' index_string ')']
     *
     * There are three cases:
     * 1. The $ sign is followed by an open curly brace. Then the variable
     *    name is everything up to the next close curly brace, and the
     *    variable is a scalar variable.
     * 2. The $ sign is not followed by an open curly brace. Then the
     *    variable name is everything up to the next character that isn't
     *    a letter, digit, underscore, or a "::" namespace separator. If the
     *    following character is an open parenthesis, then the information
     *    between parentheses is the array element name, which can include
     *    any of the substitutions permissible between quotes.
     * 3. The $ sign is followed by something that isn't a letter, digit,
     *    underscore, or a "::" namespace separator: in this case,
     *    there is no variable name, and "$" is pushed.
     */

    src++;              /* advance over the '$'. */

    /*
     * Collect the first part of the variable's name into "name" and
     * determine if it is an array reference and if it contains any
     * namespace separator (::'s).
     */
    
    if (*src == '{') {
        /*
       * A scalar name in braces.
       */

      char *p;

      src++;
        name = src;
        c = *src;
      while (c != '}') {
          if (src == lastChar) {
            Tcl_ResetResult(interp);
            Tcl_AppendToObj(Tcl_GetObjResult(interp),
                  "missing close-brace for variable name", -1);
            result = TCL_ERROR;
            goto done;
          }
#ifdef KANJI
          if (IS_KANJISTART(UCHAR(c))) {
            src += Tcl_KanjiSkip(src, lastChar, &kanjiCode);
            c = *src;
            if (kanjiCode != TCL_ANY && kanjiCode != TCL_NOT_KANJI) {
                envPtr->lastScannedKanjiCode = kanjiCode;
            }
            continue;
          }
#endif /* KANJI */
          src++;
          c = *src;
      }
      nameChars = (src - name);
      for (p = name;  p < src;  p++) {
#ifdef KANJI
          if (IS_KANJISTART(UCHAR(*p))) {
            p += (Tcl_KanjiSkip(p, src, &kanjiCode) - 1);
            if (kanjiCode != TCL_ANY && kanjiCode != TCL_NOT_KANJI) {
                envPtr->lastScannedKanjiCode = kanjiCode;
            }
          } else
#endif /* KANJI */
          if ((*p == ':') && (*(p+1) == ':')) {
            nameHasNsSeparators = 1;
            break;
          }
      }
      src++;                  /* advance over the '}'. */
    } else {
      /*
       * Scalar name or array reference not in braces.
       */
      
        name = src;
        c = *src;
#ifdef KANJI
        while (isalnum(UCHAR(c)) || (c == '_') || (c == ':') ||
             IS_KANJISTART(UCHAR(c))) {
          if (IS_KANJISTART(UCHAR(c))) {
            src += Tcl_KanjiSkip(src, lastChar, &kanjiCode);
            c = *src;
            if (kanjiCode != TCL_ANY && kanjiCode != TCL_NOT_KANJI) {
                envPtr->lastScannedKanjiCode = kanjiCode;
            }           
            continue;
          }
#else
        while (isalnum(UCHAR(c)) || (c == '_') || (c == ':')) {
#endif /* KANJI */
          if (c == ':') {
                if (*(src+1) == ':') {
                nameHasNsSeparators = 1;
                    src += 2;
                while (*src == ':') {
                  src++;
                }
                    c = *src;
                } else {
                    break;    /* : by itself */
                }
            } else {
                src++;
                c = *src;
            }
      }
      if (src == name) {
          /*
           * A '$' by itself, not a name reference. Push a "$" string.
           */

          objIndex = TclObjIndexForString("$", 1, /*allocStrRep*/ 1,
                                            /*inHeap*/ 0, envPtr);
          TclEmitPush(objIndex, envPtr);
          maxDepth = 1;
          goto done;
      }
      nameChars = (src - name);
      isArrayRef = (c == '(');
    }

    /*
     * Now emit instructions to load the variable. First either push the
     * name of the scalar or array, or determine its index in the array of
     * local variables in a procedure frame. Push the name if we are not
     * compiling a procedure body or if the name has namespace
     * qualifiers ("::"s).
     */

    if (!isArrayRef) {        /* scalar reference */
      if ((envPtr->procPtr == NULL) || nameHasNsSeparators) {
          savedChar = name[nameChars];
          name[nameChars] = '\0';
          objIndex = TclObjIndexForString(name, nameChars,
                /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
          name[nameChars] = savedChar;
          TclEmitPush(objIndex, envPtr);
          TclEmitOpcode(INST_LOAD_SCALAR_STK, envPtr);
          maxDepth = 1;
      } else {
          localIndex = LookupCompiledLocal(name, nameChars,
                  /*createIfNew*/ 0, /*flagsIfCreated*/ 0,
                envPtr->procPtr);
          if (localIndex >= 0) {
            if (localIndex <= 255) {
                TclEmitInstUInt1(INST_LOAD_SCALAR1, localIndex, envPtr);
            } else {
                TclEmitInstUInt4(INST_LOAD_SCALAR4, localIndex, envPtr);
            }
            maxDepth = 0;
          } else {
            savedChar = name[nameChars];
            name[nameChars] = '\0';
            objIndex = TclObjIndexForString(name, nameChars,
                  /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
            name[nameChars] = savedChar;
            TclEmitPush(objIndex, envPtr); 
            TclEmitOpcode(INST_LOAD_SCALAR_STK, envPtr);
            maxDepth = 1;
          }
      }
    } else {                  /* array reference */
      if ((envPtr->procPtr == NULL) || nameHasNsSeparators) {
          savedChar = name[nameChars];
          name[nameChars] = '\0';
          objIndex = TclObjIndexForString(name, nameChars,
                /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
          name[nameChars] = savedChar;
          TclEmitPush(objIndex, envPtr);
          maxDepth = 1;
      } else {
          localIndex = LookupCompiledLocal(name, nameChars,
                  /*createIfNew*/ 0, /*flagsIfCreated*/ 0,
                envPtr->procPtr);
          if (localIndex < 0) {
            savedChar = name[nameChars];
            name[nameChars] = '\0';
            objIndex = TclObjIndexForString(name, nameChars,
                  /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
            name[nameChars] = savedChar;
            TclEmitPush(objIndex, envPtr);
            maxDepth = 1;
          }
      }

      /*
       * Parse and push the array element. Perform substitutions on it,
       * just as is done for quoted strings.
       */

      src++;
      envPtr->pushSimpleWords = 1;
      result = TclCompileQuotes(interp, src, lastChar, ')', flags,
            envPtr);
      src += envPtr->termOffset;
      if (result != TCL_OK) {
          char msg[200];
          sprintf(msg, "\n    (parsing index for array \"%.*s\")",
                (nameChars > 100? 100 : nameChars), name);
          Tcl_AddObjErrorInfo(interp, msg, -1);
          goto done;
      }
      maxDepth += envPtr->maxStackDepth;

      /*
       * Now emit the appropriate load instruction for the array element.
       */

      if (localIndex < 0) {   /* a global or an unknown local */
          TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr);
      } else {
          if (localIndex <= 255) {
            TclEmitInstUInt1(INST_LOAD_ARRAY1, localIndex, envPtr);
          } else {
            TclEmitInstUInt4(INST_LOAD_ARRAY4, localIndex, envPtr);
          }
      }
    }

    done:
    envPtr->termOffset = (src - string);
    envPtr->wordIsSimple = 0;
    envPtr->numSimpleWordChars = 0;
    envPtr->maxStackDepth = maxDepth;
    envPtr->pushSimpleWords = savePushSimpleWords;
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * IsLocalScalar --
 *
 *    Checks to see if a variable name refers to a local scalar.
 *
 * Results:
 *    Returns 1 if the variable is a local scalar.
 *
 * Side effects:
 *    None.
 *
 *----------------------------------------------------------------------
 */

static int
IsLocalScalar(varName, length)
    char *varName;            /* The name to check. */
    int length;         /* The number of characters in the string.  */
{
    char *p;
    char *lastChar = varName + (length - 1);

    for (p = varName; p <= lastChar; p++) {
      if ((CHAR_TYPE(p, lastChar) != TCL_NORMAL) &&
          (CHAR_TYPE(p, lastChar) != TCL_COMMAND_END)) {
          /*
           * TCL_COMMAND_END is returned for the last character
           * of the string.  By this point we know it isn't
           * an array or namespace reference.
           */

          return 0;
      }
#ifdef KANJI
      if (IS_KANJISTART(UCHAR(*p))) {
          p += (Tcl_KanjiSkip(p, lastChar, NULL) - 1);
      } else
#endif /* KANJI */
      if  (*p == '(') {
          if (*lastChar == ')') { /* we have an array element */
            return 0;
          }
      } else if (*p == ':') {
          if ((p != lastChar) && *(p+1) == ':') { /* qualified name */
            return 0;
          }
      }
    }
      
    return 1;
}

/*
 *----------------------------------------------------------------------
 *
 * 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 while parsing string. If an error occurs then
 *    the interpreter's result contains a standard error message.
 *
 *    envPtr->termOffset is filled in with the offset of the character in
 *    "string" just after the last one successfully processed.
 *
 *    envPtr->maxStackDepth is updated with the maximum number of stack
 *    elements needed to execute the command.
 *
 * Side effects:
 *    Instructions are added to envPtr to evaluate the "break" command
 *    at runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileBreakCmd(interp, string, lastChar, flags, envPtr)
    Tcl_Interp *interp;       /* Used for error reporting. */
    char *string;       /* The source string to compile. */
    char *lastChar;           /* Pointer to terminating character of
                         * string. */
    int flags;                /* Flags to control compilation (same as
                         * passed to Tcl_Eval). */
    CompileEnv *envPtr;       /* Holds resulting instructions. */
{
    register char *src = string;/* Points to current source char. */
    register int type;        /* Current char's CHAR_TYPE type. */
    int result = TCL_OK;
    
    /*
     * There should be no argument after the "break".
     */

    type = CHAR_TYPE(src, lastChar);
    if (type != TCL_COMMAND_END) {
      AdvanceToNextWord(src, envPtr);
      src += envPtr->termOffset;
      type = CHAR_TYPE(src, lastChar);
      if (type != TCL_COMMAND_END) {
          Tcl_ResetResult(interp);
          Tcl_AppendToObj(Tcl_GetObjResult(interp),
                  "wrong # args: should be \"break\"", -1);
          result = TCL_ERROR;
          goto done;
      }
    }

    /*
     * Emit a break instruction.
     */

    TclEmitOpcode(INST_BREAK, envPtr);

    done:
    envPtr->termOffset = (src - string);
    envPtr->maxStackDepth = 0;
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * 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 compilation failed because 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->termOffset is filled in with the offset of the character in
 *    "string" just after the last one successfully processed.
 *
 *    envPtr->maxStackDepth is updated with the maximum number of stack
 *    elements needed to execute the command.
 *
 * Side effects:
 *    Instructions are added to envPtr to evaluate the "catch" command
 *    at runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileCatchCmd(interp, string, lastChar, flags, envPtr)
    Tcl_Interp *interp;       /* Used for error reporting. */
    char *string;       /* The source string to compile. */
    char *lastChar;           /* Pointer to terminating character of
                         * string. */
    int flags;                /* Flags to control compilation (same as
                         * passed to Tcl_Eval). */
    CompileEnv *envPtr;       /* Holds resulting instructions. */
{
    Proc *procPtr = envPtr->procPtr;
                        /* Points to structure describing procedure
                         * containing the catch cmd, else NULL. */
    int maxDepth = 0;           /* Maximum number of stack elements needed
                         * to execute cmd. */
    ArgInfo argInfo;          /* Structure holding information about the
                         * start and end of each argument word. */
    int range = -1;           /* If we compile the catch command, the
                         * index for its catch range record in the
                         * ExceptionRange array. -1 if we are not
                         * compiling the command. */
    char *name;               /* If a var name appears for a scalar local
                         * to a procedure, this points to the name's
                         * 1st char and nameChars is its length. */
    int nameChars;            /* Length of the variable name, if any. */
    int localIndex = -1;        /* Index of the variable in the current
                         * procedure's array of local variables.
                         * Otherwise -1 if not in a procedure or
                         * the variable wasn't found. */
    char savedChar;           /* Holds the character from string
                         * termporarily replaced by a null character
                         * during processing of words. */
    JumpFixup jumpFixup;      /* Used to emit the jump after the "no
                         * errors" epilogue code. */
    int numWords, objIndex, jumpDist, result;
    char *bodyStart, *bodyEnd;
    Tcl_Obj *objPtr;
    int savePushSimpleWords = envPtr->pushSimpleWords;

    /*
     * Scan the words of the command and record the start and finish of
     * each argument word.
     */

    InitArgInfo(&argInfo);
    result = CollectArgInfo(interp, string, lastChar, flags, &argInfo);
    numWords = argInfo.numArgs;       /* i.e., the # after the command name */
    if (result != TCL_OK) {
      goto done;
    }
    if ((numWords != 1) && (numWords != 2)) {
      Tcl_ResetResult(interp);
      Tcl_AppendToObj(Tcl_GetObjResult(interp),
              "wrong # args: should be \"catch command ?varName?\"", -1);
        result = TCL_ERROR;
      goto done;
    }

    /*
     * 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 ((numWords == 2) && (procPtr == NULL)) {
      result = TCL_OUT_LINE_COMPILE;
        goto done;
    }

    /*
     * Make sure the variable name, if any, has no substitutions and just
     * refers to a local scaler.
     */

    if (numWords == 2) {
      char *firstChar = argInfo.startArray[1];
      char *lastChar  = argInfo.endArray[1];
      
      if (*firstChar == '{') {
          if (*lastChar != '}') {
            Tcl_ResetResult(interp);
            Tcl_AppendToObj(Tcl_GetObjResult(interp),
                    "extra characters after close-brace", -1);
            result = TCL_ERROR;
            goto done;
          }
          firstChar++;
          lastChar--;
      }

      nameChars = (lastChar - firstChar + 1);
      if (!IsLocalScalar(firstChar, nameChars)) {
          result = TCL_OUT_LINE_COMPILE;
          goto done;
      }

      name = firstChar;
      localIndex = LookupCompiledLocal(name, nameChars,
                    /*createIfNew*/ 1, /*flagsIfCreated*/ VAR_SCALAR,
                procPtr);
    }

    /*
     *==== At this point we believe we can compile the catch command ====
     */

    /*
     * Create and initialize a ExceptionRange record to hold information
     * about this catch command.
     */
    
    envPtr->excRangeDepth++;
    envPtr->maxExcRangeDepth =
      TclMax(envPtr->excRangeDepth, envPtr->maxExcRangeDepth);
    range = CreateExceptionRange(CATCH_EXCEPTION_RANGE, envPtr);

    /*
     * Emit the instruction to mark the start of the catch command.
     */
    
    TclEmitInstUInt4(INST_BEGIN_CATCH4, range, envPtr);
    
    /*
     * Inline compile the catch's body word: the command it controls. Also
     * register the body's starting PC offset and byte length in the
     * ExceptionRange record.
     */

    envPtr->excRangeArrayPtr[range].codeOffset = TclCurrCodeOffset();

    bodyStart = argInfo.startArray[0];
    bodyEnd   = argInfo.endArray[0];
    savedChar = *(bodyEnd+1);
    *(bodyEnd+1) = '\0';
    result = CompileCmdWordInline(interp, bodyStart, (bodyEnd+1),
          flags, envPtr);
    *(bodyEnd+1) = savedChar;
    
    if (result != TCL_OK) {
      if (result == TCL_ERROR) {
          char msg[60];
          sprintf(msg, "\n    (\"catch\" body line %d)",
                interp->errorLine);
            Tcl_AddObjErrorInfo(interp, msg, -1);
        }
      goto done;
    }
    maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
    envPtr->excRangeArrayPtr[range].numCodeBytes =
      TclCurrCodeOffset() - envPtr->excRangeArrayPtr[range].codeOffset;

    /*
     * Now emit the "no errors" epilogue code for the catch. First, if a
     * variable was specified, store the body's result into the
     * variable; otherwise, just discard the body's result. Then push
     * a "0" object as the catch command's "no error" TCL_OK result,
     * and jump around the "error case" epilogue code.
     */

    if (localIndex != -1) {
      if (localIndex <= 255) {
          TclEmitInstUInt1(INST_STORE_SCALAR1, localIndex, envPtr);
      } else {
          TclEmitInstUInt4(INST_STORE_SCALAR4, localIndex, envPtr);
      }
    }
    TclEmitOpcode(INST_POP, envPtr);

    objIndex = TclObjIndexForString("0", 1, /*allocStrRep*/ 0, /*inHeap*/ 0,
          envPtr);
    objPtr = envPtr->objArrayPtr[objIndex];
    
    Tcl_InvalidateStringRep(objPtr);
    objPtr->internalRep.longValue = 0;
    objPtr->typePtr = &tclIntType;
    
    TclEmitPush(objIndex, envPtr);
    if (maxDepth == 0) {
      maxDepth = 1;     /* since we just pushed one object */
    }
    
    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);

    /*
     * Now emit the "error case" epilogue code. First, if a variable was
     * specified, emit instructions to push the interpreter's object result
     * and store it into the variable. Then emit an instruction to push the
     * nonzero error result. Note that the initial PC offset here is the
     * catch's error target.
     */

    envPtr->excRangeArrayPtr[range].catchOffset = TclCurrCodeOffset();
    if (localIndex != -1) {
      TclEmitOpcode(INST_PUSH_RESULT, envPtr);
      if (localIndex <= 255) {
          TclEmitInstUInt1(INST_STORE_SCALAR1, localIndex, envPtr);
      } else {
          TclEmitInstUInt4(INST_STORE_SCALAR4, localIndex, envPtr);
      }
      TclEmitOpcode(INST_POP, envPtr);
    }
    TclEmitOpcode(INST_PUSH_RETURN_CODE, envPtr);

    /*
     * Now that we know the target of the jump after the "no errors"
     * epilogue, update it with the correct distance. This is less
     * than 127 bytes.
     */

    jumpDist = (TclCurrCodeOffset() - jumpFixup.codeOffset);
    if (TclFixupForwardJump(envPtr, &jumpFixup, jumpDist, 127)) {
      panic("TclCompileCatchCmd: bad jump distance %d\n", jumpDist);
    }

    /*
     * Emit the instruction to mark the end of the catch command.
     */

    TclEmitOpcode(INST_END_CATCH, envPtr);

    done:
    if (numWords == 0) {
      envPtr->termOffset = 0;
    } else {
      envPtr->termOffset = (argInfo.endArray[numWords-1] + 1 - string);
    }
    if (range != -1) {        /* we compiled the catch command */
      envPtr->excRangeDepth--;
    }
    envPtr->pushSimpleWords = savePushSimpleWords;
    envPtr->maxStackDepth = maxDepth;
    FreeArgInfo(&argInfo);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * 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->termOffset is filled in with the offset of the character in
 *    "string" just after the last one successfully processed.
 *
 *    envPtr->maxStackDepth is updated with the maximum number of stack
 *    elements needed to execute the command.
 *
 * Side effects:
 *    Instructions are added to envPtr to evaluate the "continue" command
 *    at runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileContinueCmd(interp, string, lastChar, flags, envPtr)
    Tcl_Interp *interp;       /* Used for error reporting. */
    char *string;       /* The source string to compile. */
    char *lastChar;           /* Pointer to terminating character of
                         * string. */
    int flags;                /* Flags to control compilation (same as
                         * passed to Tcl_Eval). */
    CompileEnv *envPtr;       /* Holds resulting instructions. */
{
    register char *src = string;/* Points to current source char. */
    register int type;        /* Current char's CHAR_TYPE type. */
    int result = TCL_OK;
    
    /*
     * There should be no argument after the "continue".
     */

    type = CHAR_TYPE(src, lastChar);
    if (type != TCL_COMMAND_END) {
      AdvanceToNextWord(src, envPtr);
      src += envPtr->termOffset;
      type = CHAR_TYPE(src, lastChar);
      if (type != TCL_COMMAND_END) {
          Tcl_ResetResult(interp);
          Tcl_AppendToObj(Tcl_GetObjResult(interp),
                  "wrong # args: should be \"continue\"", -1);
          result = TCL_ERROR;
          goto done;
      }
    }

    /*
     * Emit a continue instruction.
     */

    TclEmitOpcode(INST_CONTINUE, envPtr);

    done:
    envPtr->termOffset = (src - string);
    envPtr->maxStackDepth = 0;
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * 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->termOffset is filled in with the offset of the character in
 *    "string" just after the last one successfully processed.
 *
 *    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 evaluate the "expr" command
 *    at runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileExprCmd(interp, string, lastChar, flags, envPtr)
    Tcl_Interp *interp;       /* Used for error reporting. */
    char *string;       /* The source string to compile. */
    char *lastChar;           /* Pointer to terminating character of
                         * string. */
    int flags;                /* Flags to control compilation (same as
                         * passed to Tcl_Eval). */
    CompileEnv *envPtr;       /* Holds resulting instructions. */
{
    int maxDepth = 0;         /* Maximum number of stack elements needed
                         * to execute cmd. */
    ArgInfo argInfo;          /* Structure holding information about the
                         * start and end of each argument word. */
    Tcl_DString buffer;       /* Holds the concatenated expr command
                         * argument words. */
    int firstWord;            /* 1 if processing the first word; 0 if
                         * processing subsequent words. */
    char *first, *last;       /* Points to the first and last significant
                         * chars of the concatenated expression. */
    int inlineCode;           /* 1 if inline "optimistic" code is
                         * emitted for the expression; else 0. */
    int range = -1;           /* If we inline compile the concatenated
                         * expression, the index for its catch range
                         * record in the ExceptionRange array.
                         * Initialized to avoid compile warning. */
    JumpFixup jumpFixup;      /* Used to emit the "success" jump after
                         * the inline concat. expression's code. */
    char savedChar;           /* Holds the character termporarily replaced
                         * by a null character during compilation
                         * of the concatenated expression. */
    int numWords, objIndex, i, result;
    char *wordStart, *wordEnd, *p;
    char c;
    int savePushSimpleWords = envPtr->pushSimpleWords;
    int saveExprIsJustVarRef = envPtr->exprIsJustVarRef;
    int saveExprIsComparison = envPtr->exprIsComparison;

    /*
     * Scan the words of the command and record the start and finish of
     * each argument word.
     */

    InitArgInfo(&argInfo);
    result = CollectArgInfo(interp, string, lastChar, flags, &argInfo);
    numWords = argInfo.numArgs;       /* i.e., the # after the command name */
    if (result != TCL_OK) {
      goto done;
    }
    if (numWords == 0) {
      Tcl_ResetResult(interp);
      Tcl_AppendToObj(Tcl_GetObjResult(interp),
              "wrong # args: should be \"expr arg ?arg ...?\"", -1);
        result = TCL_ERROR;
      goto done;
    }

    /*
     * If there is a single argument word and it is enclosed in {}s, we may
     * strip them off and safely compile the expr command into an inline
     * sequence of instructions using TclCompileExpr. We know these
     * instructions will have the right Tcl7.x expression semantics.
     *
     * Otherwise, if the word is not enclosed in {}s, or there are multiple
     * words, we may need to call the expr command (Tcl_ExprObjCmd) at
     * runtime. This recompiles the expression each time (typically) and so
     * is slow. However, there are some circumstances where we can still
     * compile inline instructions "optimistically" and check, during their
     * execution, for double substitutions (these appear as nonnumeric
     * operands). We check for any backslash or command substitutions. If
     * none appear, and only variable substitutions are found, we generate
     * inline instructions. If there is a compilation error, we must emit
     * instructions that return the error at runtime, since this is when
     * scripts in Tcl7.x would "see" the error.
     *
     * For now, if there are multiple words, or the single argument word is
     * not in {}s, we concatenate the argument words and strip off any
     * enclosing {}s or ""s. We call the expr command at runtime if
     * either command or backslash substitutions appear (but not if
     * only variable substitutions appear).
     */

    if (numWords == 1) {
      wordStart = argInfo.startArray[0]; /* start of 1st arg word */
      wordEnd   = argInfo.endArray[0];   /* last char of 1st arg word */
      if ((*wordStart == '{') && (*wordEnd == '}')) {
          /*
           * Simple case: a single argument word in {}'s. 
           */

          *wordEnd = '\0';
          result = TclCompileExpr(interp, (wordStart + 1), wordEnd,
                flags, envPtr);
          *wordEnd = '}';
          
          envPtr->termOffset = (wordEnd + 1) - string;
          envPtr->pushSimpleWords = savePushSimpleWords;
          FreeArgInfo(&argInfo);
          return result;
      }
    }
      
    /*
     * There are multiple words or no braces around the single word.
     * Concatenate the expression's argument words while stripping off
     * any enclosing {}s or ""s.
     */
    
    Tcl_DStringInit(&buffer);
    firstWord = 1;
    for (i = 0;  i < numWords;  i++) {
      wordStart = argInfo.startArray[i];
      wordEnd   = argInfo.endArray[i];
      if (((*wordStart == '{') && (*wordEnd == '}'))
              || ((*wordStart == '"') && (*wordEnd == '"'))) {
          wordStart++;
          wordEnd--;
      }
      if (!firstWord) {
          Tcl_DStringAppend(&buffer, " ", 1);
      }
      firstWord = 0;
      if (wordEnd >= wordStart) {
          Tcl_DStringAppend(&buffer, wordStart, (wordEnd-wordStart+1));
      }
    }

    /*
     * Scan the concatenated expression's characters looking for any
     * '['s or (for now) '\'s. If any are found, just call the expr cmd
     * at runtime.
     */
    
    inlineCode = 1;
    first = Tcl_DStringValue(&buffer);
    last = first + (Tcl_DStringLength(&buffer) - 1);
    for (p = first;  p <= last;  p++) {
      c = *p;
      if ((c == '[') || (c == '\\')) {
          inlineCode = 0;
          break;
      }
    }

    if (inlineCode) {
      /*
       * Inline compile the concatenated expression inside a "catch"
       * so that a runtime error will back off to a (slow) call on expr.
       */
      
      int startCodeOffset = (envPtr->codeNext - envPtr->codeStart);
      int startRangeNext = envPtr->excRangeArrayNext;
      
      /*
       * Create a ExceptionRange record to hold information about the
       * "catch" range for the expression's inline code. Also emit the
       * instruction to mark the start of the range.
       */
      
      envPtr->excRangeDepth++;
      envPtr->maxExcRangeDepth =
              TclMax(envPtr->excRangeDepth, envPtr->maxExcRangeDepth);
      range = CreateExceptionRange(CATCH_EXCEPTION_RANGE, envPtr);
      TclEmitInstUInt4(INST_BEGIN_CATCH4, range, envPtr);
      
      /*
       * Inline compile the concatenated expression.
       */
      
      envPtr->excRangeArrayPtr[range].codeOffset = TclCurrCodeOffset();
      savedChar = *(last + 1);
      *(last + 1) = '\0';
      result = TclCompileExpr(interp, first, last + 1, flags, envPtr);
      *(last + 1) = savedChar;
      
      maxDepth = envPtr->maxStackDepth;
      envPtr->excRangeArrayPtr[range].numCodeBytes =
              TclCurrCodeOffset() - envPtr->excRangeArrayPtr[range].codeOffset;
      
      if ((result != TCL_OK) || (envPtr->exprIsJustVarRef)
              || (envPtr->exprIsComparison)) {
          /*
           * We must call the expr command at runtime. Either there was a
           * compilation error or the inline code might fail to give the
           * correct 2 level substitution semantics.
           *
           * The latter can happen if the expression consisted of just a
           * single variable reference or if the top-level operator in the
           * expr is a comparison (which might operate on strings). In the
           * latter case, the expression's code might execute (apparently)
           * successfully but produce the wrong result. We depend on its
           * execution failing if a second level of substitutions is
           * required. This causes the "catch" code we generate around the
           * inline code to back off to a call on the expr command at
           * runtime, and this always gives the right 2 level substitution
           * semantics.
           *
           * We delete the inline code by backing up the code pc and catch
           * index. Note that if there was a compilation error, we can't
           * report the error yet since the expression might be valid
           * after the second round of substitutions.
           */
          
          envPtr->codeNext = (envPtr->codeStart + startCodeOffset);
          envPtr->excRangeArrayNext = startRangeNext;
          inlineCode = 0;
      } else {
          TclEmitOpcode(INST_END_CATCH, envPtr); /* for ok case */
          TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
          envPtr->excRangeArrayPtr[range].catchOffset = TclCurrCodeOffset();
          TclEmitOpcode(INST_END_CATCH, envPtr); /* for error case */
      }
    }
          
    /*
     * Emit code for the (slow) call on the expr command at runtime.
     * Generate code to concatenate the (already substituted once)
     * expression words with a space between each word.
     */
    
    for (i = 0;  i < numWords;  i++) {
      wordStart = argInfo.startArray[i];
      wordEnd   = argInfo.endArray[i];
      savedChar = *(wordEnd + 1);
      *(wordEnd + 1) = '\0';
      envPtr->pushSimpleWords = 1;
      result = CompileWord(interp, wordStart, wordEnd+1, flags, envPtr);
      *(wordEnd + 1) = savedChar;
      if (result != TCL_OK) {
          break;
      }
      if (i != (numWords - 1)) {
          objIndex = TclObjIndexForString(" ", 1, /*allocStrRep*/ 1,
                                  /*inHeap*/ 0, envPtr);
          TclEmitPush(objIndex, envPtr);
          maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
      } else {
          maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
      }
    }
    if (result == TCL_OK) {
      int concatItems = 2*numWords - 1;
      while (concatItems > 255) {
          TclEmitInstUInt1(INST_CONCAT1, 255, envPtr);
          concatItems -= 254;  /* concat pushes 1 obj, the result */
      }
      if (concatItems > 1) {
          TclEmitInstUInt1(INST_CONCAT1, concatItems, envPtr);
      }
      TclEmitOpcode(INST_EXPR_STK, envPtr);
    }
    
    /*
     * If emitting inline code, update the target of the jump after
     * that inline code.
     */
    
    if (inlineCode) {
      int jumpDist = (TclCurrCodeOffset() - jumpFixup.codeOffset);
      if (TclFixupForwardJump(envPtr, &jumpFixup, jumpDist, 127)) {
          /*
           * Update the inline expression code's catch ExceptionRange
           * target since it, being after the jump, also moved down.
           */
          
          envPtr->excRangeArrayPtr[range].catchOffset += 3;
      }
    }
    Tcl_DStringFree(&buffer);
    
    done:
    if (numWords == 0) {
      envPtr->termOffset = 0;
    } else {
      envPtr->termOffset = (argInfo.endArray[numWords-1] + 1 - string);
    }
    if (range != -1) {        /* we inline compiled the expr */
      envPtr->excRangeDepth--;
    }
    envPtr->pushSimpleWords = savePushSimpleWords;
    envPtr->exprIsJustVarRef = saveExprIsJustVarRef;
    envPtr->exprIsComparison = saveExprIsComparison;
    envPtr->maxStackDepth = maxDepth;
    FreeArgInfo(&argInfo);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * 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->termOffset is filled in with the offset of the character in
 *    "string" just after the last one successfully processed.
 *
 *    envPtr->maxStackDepth is updated with the maximum number of stack
 *    elements needed to execute the command.
 *
 * Side effects:
 *    Instructions are added to envPtr to evaluate the "for" command
 *    at runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileForCmd(interp, string, lastChar, flags, envPtr)
    Tcl_Interp *interp;       /* Used for error reporting. */
    char *string;       /* The source string to compile. */
    char *lastChar;           /* Pointer to terminating character of
                         * string. */
    int flags;                /* Flags to control compilation (same as
                         * passed to Tcl_Eval). */
    CompileEnv *envPtr;       /* Holds resulting instructions. */
{
    int maxDepth = 0;         /* Maximum number of stack elements needed
                         * to execute cmd. */
    ArgInfo argInfo;          /* Structure holding information about the
                         * start and end of each argument word. */
    int range1 = -1, range2;  /* Indexes in the ExceptionRange array of
                         * the loop ranges for this loop: one for
                         * its body and one for its "next" cmd. */
    JumpFixup jumpFalseFixup; /* Used to update or replace the ifFalse
                         * jump after the "for" test when its target
                         * PC is determined. */
    int jumpBackDist, jumpBackOffset, testCodeOffset, jumpDist, objIndex;
    unsigned char *jumpPc;
    int savePushSimpleWords = envPtr->pushSimpleWords;
    int numWords, result;

    /*
     * Scan the words of the command and record the start and finish of
     * each argument word.
     */

    InitArgInfo(&argInfo);
    result = CollectArgInfo(interp, string, lastChar, flags, &argInfo);
    numWords = argInfo.numArgs;       /* i.e., the # after the command name */
    if (result != TCL_OK) {
      goto done;
    }
    if (numWords != 4) {
      Tcl_ResetResult(interp);
      Tcl_AppendToObj(Tcl_GetObjResult(interp),
              "wrong # args: should be \"for start test next command\"", -1);
      result = TCL_ERROR;
      goto done;
    }

    /*
     * If the test expression is not enclosed in braces, don't compile
     * the for inline. As a result of Tcl's two level substitution
     * semantics for expressions, the expression might have a constant
     * value that results in the loop never executing, or executing forever.
     * Consider "set x 0; for {} "$x > 5" {incr x} {}": the loop body 
     * should never be executed.
     * NOTE: This is an overly aggressive test, since there are legitimate
     * literals that could be compiled but aren't in braces.  However, until
     * the parser is integrated in 8.1, this is the simplest implementation.
     */

    if (*(argInfo.startArray[1]) != '{') {
      result = TCL_OUT_LINE_COMPILE;
      goto done;
    }

    /*
     * Create a ExceptionRange record for the for loop's body. This is used
     * to implement break and continue commands inside the body.
     * Then create a second ExceptionRange record for the "next" command in 
     * order to implement break (but not continue) inside it. The second,
     * "next" ExceptionRange will always have a -1 continueOffset.
     */

    envPtr->excRangeDepth++;
    envPtr->maxExcRangeDepth =
      TclMax(envPtr->excRangeDepth, envPtr->maxExcRangeDepth);
    range1 = CreateExceptionRange(LOOP_EXCEPTION_RANGE, envPtr);
    range2 = CreateExceptionRange(LOOP_EXCEPTION_RANGE, envPtr);

    /*
     * Compile inline the next word: the initial command.
     */

    result = CompileCmdWordInline(interp, argInfo.startArray[0],
          (argInfo.endArray[0] + 1), flags, envPtr);
    if (result != TCL_OK) {
      if (result == TCL_ERROR) {
            Tcl_AddObjErrorInfo(interp, "\n    (\"for\" initial command)", -1);
        }
      goto done;
    }
    maxDepth = envPtr->maxStackDepth;

    /*
     * Discard the start command's result.
     */

    TclEmitOpcode(INST_POP, envPtr);

    /*
     * Compile the next word: the test expression.
     */

    testCodeOffset = TclCurrCodeOffset();
    envPtr->pushSimpleWords = 1;    /* process words normally */
    result = CompileExprWord(interp, argInfo.startArray[1],
          (argInfo.endArray[1] + 1), flags, envPtr);
    if (result != TCL_OK) {
      if (result == TCL_ERROR) {
            Tcl_AddObjErrorInfo(interp, "\n    (\"for\" test expression)", -1);
        }
      goto done;
    }
    maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);

    /*
     * Emit the jump that terminates the for command if the test was
     * false. We emit a one byte (relative) jump here, and replace it later
     * with a four byte jump if the jump target is > 127 bytes away.
     */

    TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);

    /*
     * Compile the loop body word inline. Also register the loop body's
     * starting PC offset and byte length in the its ExceptionRange record.
     */

    envPtr->excRangeArrayPtr[range1].codeOffset = TclCurrCodeOffset();
    result = CompileCmdWordInline(interp, argInfo.startArray[3],
          (argInfo.endArray[3] + 1), flags, envPtr);
    if (result != TCL_OK) {
      if (result == TCL_ERROR) {
          char msg[60];
          sprintf(msg, "\n    (\"for\" body line %d)", interp->errorLine);
            Tcl_AddObjErrorInfo(interp, msg, -1);
        }
      goto done;
    }
    maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
    envPtr->excRangeArrayPtr[range1].numCodeBytes =
      (TclCurrCodeOffset() - envPtr->excRangeArrayPtr[range1].codeOffset);

    /*
     * Discard the loop body's result.
     */

    TclEmitOpcode(INST_POP, envPtr);

    /*
     * Finally, compile the "next" subcommand word inline.
     */

    envPtr->excRangeArrayPtr[range1].continueOffset = TclCurrCodeOffset();
    envPtr->excRangeArrayPtr[range2].codeOffset = TclCurrCodeOffset();
    result = CompileCmdWordInline(interp, argInfo.startArray[2],
          (argInfo.endArray[2] + 1), flags, envPtr);
    if (result != TCL_OK) {
      if (result == TCL_ERROR) {
          Tcl_AddObjErrorInfo(interp, "\n    (\"for\" loop-end command)", -1);
      }
      goto done;
    }
    maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
    envPtr->excRangeArrayPtr[range2].numCodeBytes =
      TclCurrCodeOffset() - envPtr->excRangeArrayPtr[range2].codeOffset;

    /*
     * Discard the "next" subcommand's result.
     */

    TclEmitOpcode(INST_POP, envPtr);
      
    /*
     * Emit the unconditional jump back to the test at the top of the for
     * loop. We generate a four byte jump if the distance to the test is
     * greater than 120 bytes. This is conservative, and ensures that we
     * won't have to replace this unconditional jump if we later need to
     * replace the ifFalse jump with a four-byte jump.
     */

    jumpBackOffset = TclCurrCodeOffset();
    jumpBackDist = (jumpBackOffset - testCodeOffset);
    if (jumpBackDist > 120) {
      TclEmitInstInt4(INST_JUMP4, /*offset*/ -jumpBackDist, envPtr);
    } else {
      TclEmitInstInt1(INST_JUMP1, /*offset*/ -jumpBackDist, envPtr);
    }

    /*
     * Now that we know the target of the jumpFalse after the test, update
     * it with the correct distance. If the distance is too great (more
     * than 127 bytes), replace that jump with a four byte instruction and
     * move the instructions after the jump down.
     */

    jumpDist = (TclCurrCodeOffset() - jumpFalseFixup.codeOffset);
    if (TclFixupForwardJump(envPtr, &jumpFalseFixup, jumpDist, 127)) {
      /*
       * Update the loop body's ExceptionRange record since it moved down:
       * i.e., increment both its start and continue PC offsets. Also,
       * update the "next" command's start PC offset in its ExceptionRange
       * record since it also moved down.
       */

      envPtr->excRangeArrayPtr[range1].codeOffset += 3;
      envPtr->excRangeArrayPtr[range1].continueOffset += 3;
      envPtr->excRangeArrayPtr[range2].codeOffset += 3;

      /*
       * Update the distance for the unconditional jump back to the test
       * at the top of the loop since it moved down 3 bytes too.
       */

      jumpBackOffset += 3;
      jumpPc = (envPtr->codeStart + jumpBackOffset);
      if (jumpBackDist > 120) {
          jumpBackDist += 3;
          TclUpdateInstInt4AtPc(INST_JUMP4, /*offset*/ -jumpBackDist,
                           jumpPc);
      } else {
          jumpBackDist += 3;
          TclUpdateInstInt1AtPc(INST_JUMP1, /*offset*/ -jumpBackDist,
                           jumpPc);
      }
    }
    
    /*
     * The current PC offset (after the loop's body and "next" subcommand)
     * is the loop's break target.
     */

    envPtr->excRangeArrayPtr[range1].breakOffset =
      envPtr->excRangeArrayPtr[range2].breakOffset = TclCurrCodeOffset();
    
    /*
     * Push an empty string object as the for command's result.
     */

    objIndex = TclObjIndexForString("", 0, /*allocStrRep*/ 0, /*inHeap*/ 0,
                            envPtr);
    TclEmitPush(objIndex, envPtr);
    if (maxDepth == 0) {
      maxDepth = 1;
    }

    done:
    if (numWords == 0) {
      envPtr->termOffset = 0;
    } else {
      envPtr->termOffset = (argInfo.endArray[numWords-1] + 1 - string);
    }
    envPtr->pushSimpleWords = savePushSimpleWords;
    envPtr->maxStackDepth = maxDepth;
    if (range1 != -1) {
      envPtr->excRangeDepth--;
    }
    FreeArgInfo(&argInfo);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * 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 complation failed because 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->termOffset is filled in with the offset of the character in
 *    "string" just after the last one successfully processed.
 *
 *    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 evaluate the "foreach" command
 *    at runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileForeachCmd(interp, string, lastChar, flags, envPtr)
    Tcl_Interp *interp;       /* Used for error reporting. */
    char *string;       /* The source string to compile. */
    char *lastChar;           /* Pointer to terminating character of
                         * string. */
    int flags;                /* Flags to control compilation (same as
                         * passed to Tcl_Eval). */
    CompileEnv *envPtr;       /* Holds resulting instructions. */
{
    Proc *procPtr = envPtr->procPtr;
                        /* Points to structure describing procedure
                         * containing foreach command, else NULL. */
    int maxDepth = 0;         /* Maximum number of stack elements needed
                         * to execute cmd. */
    ArgInfo argInfo;          /* Structure holding information about the
                         * start and end of each argument word. */
    int numLists = 0;         /* Count of variable (and value) lists. */
    int range = -1;           /* Index in the ExceptionRange array of the
                         * ExceptionRange record for this loop. */
    ForeachInfo *infoPtr;     /* Points to the structure describing this
                         * foreach command. Stored in a AuxData
                         * record in the ByteCode. */
    JumpFixup jumpFalseFixup; /* Used to update or replace the ifFalse
                         * jump after test when its target PC is
                         * determined. */
    char savedChar;           /* Holds the char from string termporarily
                         * replaced by a null character during
                         * processing of argument words. */
    int firstListTmp = -1;    /* If we decide to compile this foreach
                         * command, this is the index or "slot
                         * number" for the first temp var allocated
                         * in the proc frame that holds a pointer to
                         * a value list. Initialized to avoid a
                         * compiler warning. */
    int loopIterNumTmp;       /* If we decide to compile this foreach
                         * command, the index for the temp var that
                         * holds the current iteration count.  */
    char *varListStart, *varListEnd, *valueListStart, *bodyStart, *bodyEnd;
    unsigned char *jumpPc;
    int jumpDist, jumpBackDist, jumpBackOffset;
    int numWords, numVars, infoIndex, tmpIndex, objIndex, i, j, result;
    int savePushSimpleWords = envPtr->pushSimpleWords;

    /*
     * We parse the variable list argument words and create two arrays:
     *    varcList[i] gives the number of variables in the i-th var list
     *    varvList[i] points to an array of the names in the i-th var list
     * These are initially allocated on the stack, and are allocated on
     * the heap if necessary.
     */

#define STATIC_VAR_LIST_SIZE 4
    int varcListStaticSpace[STATIC_VAR_LIST_SIZE];
    char **varvListStaticSpace[STATIC_VAR_LIST_SIZE];

    int *varcList = varcListStaticSpace;
    char ***varvList = varvListStaticSpace;

    /*
     * If the foreach command is at global level (not in a procedure),
     * don't compile it inline: the payoff is too small.
     */

    if (procPtr == NULL) {
      return TCL_OUT_LINE_COMPILE;
    }

    /*
     * Scan the words of the command and record the start and finish of
     * each argument word.
     */

    InitArgInfo(&argInfo);
    result = CollectArgInfo(interp, string, lastChar, flags, &argInfo);
    numWords = argInfo.numArgs;
    if (result != TCL_OK) {
      goto done;
    }
    if ((numWords < 3) || (numWords%2 != 1)) {
      Tcl_ResetResult(interp);
      Tcl_AppendToObj(Tcl_GetObjResult(interp),
              "wrong # args: should be \"foreach varList list ?varList list ...? command\"", -1);
        result = TCL_ERROR;
      goto done;
    }

    /*
     * Initialize the varcList and varvList arrays; allocate heap storage,
     * if necessary, for them. Also make sure the variable names
     * have no substitutions: that they're just "var" or "var(elem)"
     */

    numLists = (numWords - 1)/2;
    if (numLists > STATIC_VAR_LIST_SIZE) {
        varcList = (int *) ckalloc(numLists * sizeof(int));
        varvList = (char ***) ckalloc(numLists * sizeof(char **));
    }
    for (i = 0;  i < numLists;  i++) {
        varcList[i] = 0;
        varvList[i] = (char **) NULL;
    }
    for (i = 0;  i < numLists;  i++) {
      /*
       * Break each variable list into its component variables. If the
       * lists is enclosed in {}s or ""s, strip them off first.
       */

      varListStart = argInfo.startArray[i*2];
      varListEnd   = argInfo.endArray[i*2];
      if ((*varListStart == '{') || (*varListStart == '"')) {
          if ((*varListEnd != '}') && (*varListEnd != '"')) {
            Tcl_ResetResult(interp);
            if (*varListStart == '"') {
                Tcl_AppendToObj(Tcl_GetObjResult(interp),
                      "extra characters after close-quote", -1);
            } else {
                Tcl_AppendToObj(Tcl_GetObjResult(interp),
                        "extra characters after close-brace", -1);
            }
            result = TCL_ERROR;
            goto done;
          }
          varListStart++;
          varListEnd--;
      }
          
      /*
       * NOTE: THIS NEEDS TO BE CONVERTED TO AN OBJECT LIST.
       */

      savedChar = *(varListEnd+1);
      *(varListEnd+1) = '\0';
      result = Tcl_SplitList(interp, varListStart,
                         &varcList[i], &varvList[i]);
      *(varListEnd+1) = savedChar;
        if (result != TCL_OK) {
            goto done;
        }

      /*
       * Check that each variable name has no substitutions and that
       * it is a local scalar name.
       */

      numVars = varcList[i];
      for (j = 0;  j < numVars;  j++) {
          char *varName = varvList[i][j];
          if (!IsLocalScalar(varName, (int) strlen(varName))) {
            result = TCL_OUT_LINE_COMPILE;
            goto done;
          }
      }
    }

    /*
     *==== At this point we believe we can compile the foreach command ====
     */

    /*
     * Create and initialize a ExceptionRange record to hold information
     * about this loop. This is used to implement break and continue.
     */
    
    envPtr->excRangeDepth++;
    envPtr->maxExcRangeDepth =
      TclMax(envPtr->excRangeDepth, envPtr->maxExcRangeDepth);
    range = CreateExceptionRange(LOOP_EXCEPTION_RANGE, envPtr);
    
    /*
     * Reserve (numLists + 1) temporary variables:
     *    - numLists temps for each value list
     *    - a temp for the "next value" index into each value list
     * At this time we don't try to reuse temporaries; if there are two
     * nonoverlapping foreach loops, they don't share any temps.
     */

    for (i = 0;  i < numLists;  i++) {
      tmpIndex = LookupCompiledLocal(NULL, /*nameChars*/ 0,
            /*createIfNew*/ 1, /*flagsIfCreated*/ VAR_SCALAR, procPtr);
      if (i == 0) {
          firstListTmp = tmpIndex;
      }
    }
    loopIterNumTmp = LookupCompiledLocal(NULL, /*nameChars*/ 0,
          /*createIfNew*/ 1, /*flagsIfCreated*/ 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 in the compilation environment.
     */

    infoPtr = (ForeachInfo *) ckalloc((unsigned)
          (sizeof(ForeachInfo) + (numLists * sizeof(ForeachVarList *))));
    infoPtr->numLists = numLists;
    infoPtr->firstListTmp = firstListTmp;
    infoPtr->loopIterNumTmp = loopIterNumTmp;
    for (i = 0;  i < numLists;  i++) {
      ForeachVarList *varListPtr;
      numVars = varcList[i];
      varListPtr = (ForeachVarList *) ckalloc((unsigned)
              sizeof(ForeachVarList) + numVars*sizeof(int));
      varListPtr->numVars = numVars;
      for (j = 0;  j < numVars;  j++) {
          char *varName = varvList[i][j];
          int nameChars = strlen(varName);
          varListPtr->varIndexes[j] = LookupCompiledLocal(varName,
                nameChars, /*createIfNew*/ 1,
                    /*flagsIfCreated*/ VAR_SCALAR, procPtr);
      }
      infoPtr->varLists[i] = varListPtr;
    }
    infoIndex = TclCreateAuxData((ClientData) infoPtr,
            &tclForeachInfoType, envPtr);

    /*
     * Emit code to store each value list into the associated temporary.
     */

    for (i = 0;  i < numLists;  i++) {
      valueListStart = argInfo.startArray[2*i + 1];
      envPtr->pushSimpleWords = 1;
      result = CompileWord(interp, valueListStart, lastChar, flags,
            envPtr);
      if (result != TCL_OK) {
          goto done;
      }
      maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);

      tmpIndex = (firstListTmp + i);
      if (tmpIndex <= 255) {
          TclEmitInstUInt1(INST_STORE_SCALAR1, tmpIndex, envPtr);
      } else {
          TclEmitInstUInt4(INST_STORE_SCALAR4, tmpIndex, envPtr);
      }
      TclEmitOpcode(INST_POP, envPtr);
    }

    /*
     * Emit the instruction to initialize the foreach loop's index temp var.
     */

    TclEmitInstUInt4(INST_FOREACH_START4, infoIndex, envPtr);
    
    /*
     * Emit the top of loop code that assigns each loop variable and checks
     * whether to terminate the loop.
     */

    envPtr->excRangeArrayPtr[range].continueOffset = TclCurrCodeOffset();
    TclEmitInstUInt4(INST_FOREACH_STEP4, infoIndex, envPtr);

    /*
     * Emit the ifFalse jump that terminates the foreach if all value lists
     * are exhausted. We emit a one byte (relative) jump here, and replace
     * it later with a four byte jump if the jump target is more than
     * 127 bytes away.
     */

    TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);
    
    /*
     * Compile the loop body word inline. Also register the loop body's
     * starting PC offset and byte length in the ExceptionRange record.
     */

    bodyStart = argInfo.startArray[numWords - 1];
    bodyEnd   = argInfo.endArray[numWords - 1];
    savedChar = *(bodyEnd+1);
    *(bodyEnd+1) = '\0';
    envPtr->excRangeArrayPtr[range].codeOffset = TclCurrCodeOffset();
    result = CompileCmdWordInline(interp, bodyStart, bodyEnd+1, flags,
          envPtr);
    *(bodyEnd+1) = savedChar;
    if (result != TCL_OK) {
      if (result == TCL_ERROR) {
          char msg[60];
          sprintf(msg, "\n    (\"foreach\" body line %d)",
                interp->errorLine);
            Tcl_AddObjErrorInfo(interp, msg, -1);
        }
      goto done;
    }
    maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
    envPtr->excRangeArrayPtr[range].numCodeBytes =
      TclCurrCodeOffset() - envPtr->excRangeArrayPtr[range].codeOffset;

    /*
     * Discard the loop body's result.
     */

    TclEmitOpcode(INST_POP, envPtr);
      
    /*
     * Emit the unconditional jump back to the test at the top of the
     * loop. We generate a four byte jump if the distance to the to of
     * the foreach is greater than 120 bytes. This is conservative and
     * ensures that we won't have to replace this unconditional jump if
     * we later need to replace the ifFalse jump with a four-byte jump.
     */

    jumpBackOffset = TclCurrCodeOffset();
    jumpBackDist =
      (jumpBackOffset - envPtr->excRangeArrayPtr[range].continueOffset);
    if (jumpBackDist > 120) {
      TclEmitInstInt4(INST_JUMP4, /*offset*/ -jumpBackDist, envPtr);
    } else {
      TclEmitInstInt1(INST_JUMP1, /*offset*/ -jumpBackDist, envPtr);
    }

    /*
     * Now that we know the target of the jumpFalse after the foreach_step
     * test, update it with the correct distance. If the distance is too
     * great (more than 127 bytes), replace that jump with a four byte
     * instruction and move the instructions after the jump down.
     */

    jumpDist = (TclCurrCodeOffset() - jumpFalseFixup.codeOffset);
    if (TclFixupForwardJump(envPtr, &jumpFalseFixup, jumpDist, 127)) {
      /*
       * Update the loop body's starting PC offset since it moved down.
       */

      envPtr->excRangeArrayPtr[range].codeOffset += 3;

      /*
       * Update the distance for the unconditional jump back to the test
       * at the top of the loop since it moved down 3 bytes too.
       */

      jumpBackOffset += 3;
      jumpPc = (envPtr->codeStart + jumpBackOffset);
      if (jumpBackDist > 120) {
          jumpBackDist += 3;
          TclUpdateInstInt4AtPc(INST_JUMP4, /*offset*/ -jumpBackDist,
                           jumpPc);
      } else {
          jumpBackDist += 3;
          TclUpdateInstInt1AtPc(INST_JUMP1, /*offset*/ -jumpBackDist,
                           jumpPc);
      }
    }

    /*
     * The current PC offset (after the loop's body) is the loop's
     * break target.
     */

    envPtr->excRangeArrayPtr[range].breakOffset = TclCurrCodeOffset();
    
    /*
     * Push an empty string object as the foreach command's result.
     */

    objIndex = TclObjIndexForString("", 0, /*allocStrRep*/ 0, /*inHeap*/ 0,
                            envPtr);
    TclEmitPush(objIndex, envPtr);
    if (maxDepth == 0) {
      maxDepth = 1;
    }

    done:
    for (i = 0;  i < numLists;  i++) {
        if (varvList[i] != (char **) NULL) {
            ckfree((char *) varvList[i]);
        }
    }
    if (varcList != varcListStaticSpace) {
      ckfree((char *) varcList);
        ckfree((char *) varvList);
    }
    envPtr->termOffset = (argInfo.endArray[numWords-1] + 1 - string);
    envPtr->pushSimpleWords = savePushSimpleWords;
    envPtr->maxStackDepth = maxDepth;
    if (range != -1) {
      envPtr->excRangeDepth--;
    }
    FreeArgInfo(&argInfo);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * 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->firstListTmp = srcPtr->firstListTmp;
    dupPtr->loopIterNumTmp = srcPtr->loopIterNumTmp;
    
    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 unless
 *    there was an error while parsing string. If an error occurs then
 *    the interpreter's result contains a standard error message.
 *
 *    envPtr->termOffset is filled in with the offset of the character in
 *    "string" just after the last one successfully processed.
 *
 *    envPtr->maxStackDepth is updated with the maximum number of stack
 *    elements needed to execute the command.
 *
 * Side effects:
 *    Instructions are added to envPtr to evaluate the "if" command
 *    at runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileIfCmd(interp, string, lastChar, flags, envPtr)
    Tcl_Interp *interp;       /* Used for error reporting. */
    char *string;       /* The source string to compile. */
    char *lastChar;           /* Pointer to terminating character of
                         * string. */
    int flags;                /* Flags to control compilation (same as
                         * passed to Tcl_Eval). */
    CompileEnv *envPtr;       /* Holds resulting instructions. */
{
    register char *src = string;/* Points to current source char. */
    register int type;        /* Current char's CHAR_TYPE type. */
    int maxDepth = 0;         /* Maximum number of stack elements needed
                         * to execute cmd. */
    JumpFixupArray jumpFalseFixupArray;
                        /* Used to fix up the ifFalse jump after
                         * each "if"/"elseif" test when its target
                         * PC is determined. */
    JumpFixupArray jumpEndFixupArray;
                        /* Used to fix up the unconditional jump
                         * after each "then" command to the end of
                         * the "if" when that PC is determined. */
    char *testSrcStart;
    int jumpDist, jumpFalseDist, jumpIndex, objIndex, j, result;
    unsigned char *ifFalsePc;
    unsigned char opCode;
    int savePushSimpleWords = envPtr->pushSimpleWords;

    /*
     * Loop compiling "expr then body" clauses after an "if" or "elseif".
     */

    TclInitJumpFixupArray(&jumpFalseFixupArray);
    TclInitJumpFixupArray(&jumpEndFixupArray);
    while (1) {   
      /*
       * At this point in the loop, we have an expression to test, either
       * the main expression or an expression following an "elseif".
       * The arguments after the expression must be "then" (optional) and
       * a script to execute if the expression is true.
       */

      AdvanceToNextWord(src, envPtr);
      src += envPtr->termOffset;
      type = CHAR_TYPE(src, lastChar);
      if (type == TCL_COMMAND_END) {
          Tcl_ResetResult(interp);
          Tcl_AppendToObj(Tcl_GetObjResult(interp),
                "wrong # args: no expression after \"if\" argument", -1);
          result = TCL_ERROR;
          goto done;
      }

      /*
       * Compile the "if"/"elseif" test expression.
       */
      
      testSrcStart = src;
      envPtr->pushSimpleWords = 1;
      result = CompileExprWord(interp, src, lastChar, flags, envPtr);
      if (result != TCL_OK) {
          if (result == TCL_ERROR) {
            Tcl_AddObjErrorInfo(interp,
                    "\n    (\"if\" test expression)", -1);
          }
          goto done;
      }
      maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
      src += envPtr->termOffset;

      /*
       * Emit the ifFalse jump around the "then" part if the test was
       * false. We emit a one byte (relative) jump here, and replace it
       * later with a four byte jump if the jump target is more than 127
       * bytes away. 
       */

      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.
       */

      AdvanceToNextWord(src, envPtr);
      src += envPtr->termOffset;
      type = CHAR_TYPE(src, lastChar);
      if (type == TCL_COMMAND_END) {
          char buf[100];
          sprintf(buf, "wrong # args: no script following \"%.20s\" argument", testSrcStart);
          Tcl_ResetResult(interp);
          Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
          result = TCL_ERROR;
          goto done;
      }
      if ((*src == 't') && (strncmp(src, "then", 4) == 0)) {
          type = CHAR_TYPE(src+4, lastChar);
          if ((type == TCL_SPACE) || (type == TCL_COMMAND_END)) {
            src += 4;
            AdvanceToNextWord(src, envPtr); 
            src += envPtr->termOffset;
            type = CHAR_TYPE(src, lastChar);
            if (type == TCL_COMMAND_END) {
                Tcl_ResetResult(interp);
                Tcl_AppendToObj(Tcl_GetObjResult(interp),
                        "wrong # args: no script following \"then\" argument", -1);
                result = TCL_ERROR;
                goto done;
            }
          }
      }

      /*
       * Compile the "then" command word inline.
       */

      result = CompileCmdWordInline(interp, src, lastChar, flags, envPtr);
      if (result != TCL_OK) {
          if (result == TCL_ERROR) {
            char msg[60];
            sprintf(msg, "\n    (\"if\" then script line %d)",
                    interp->errorLine);
            Tcl_AddObjErrorInfo(interp, msg, -1);
          }
          goto done;
      }
      maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
      src += envPtr->termOffset;

      /*
       * Emit an unconditional jump to the end of the "if" command. We
       * emit a one byte jump here, and replace it later with a four byte
       * jump if the jump target is more than 127 bytes away. Note that
       * both the jumpFalseFixupArray and the jumpEndFixupArray are
       * indexed by the same index, "jumpIndex".
       */

      if (jumpEndFixupArray.next >= jumpEndFixupArray.end) {
          TclExpandJumpFixupArray(&jumpEndFixupArray);
      }
      jumpEndFixupArray.next++;
      TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
            &(jumpEndFixupArray.fixup[jumpIndex]));

      /*
       * Now that we know the target of the jumpFalse after the if test,
         * update it with the correct distance. We generate a four byte
       * jump if the distance is greater than 120 bytes. This is
       * conservative, and ensures that we won't have to replace this
       * jump if we later also need to replace the preceeding
       * unconditional jump to the end of the "if" with a four-byte jump.
         */

      jumpDist = (TclCurrCodeOffset() - jumpFalseFixupArray.fixup[jumpIndex].codeOffset);
      if (TclFixupForwardJump(envPtr,
              &(jumpFalseFixupArray.fixup[jumpIndex]), jumpDist, 120)) {
          /*
           * Adjust the code offset for the unconditional jump at the end
           * of the last "then" clause.
           */

          jumpEndFixupArray.fixup[jumpIndex].codeOffset += 3;
      }

      /*
       * Check now for a "elseif" word. If we find one, keep looping.
       */

      AdvanceToNextWord(src, envPtr);
      src += envPtr->termOffset;
      type = CHAR_TYPE(src, lastChar);
      if ((type != TCL_COMMAND_END)
              && ((*src == 'e') && (strncmp(src, "elseif", 6) == 0))) {
          type = CHAR_TYPE(src+6, lastChar);
          if ((type == TCL_SPACE) || (type == TCL_COMMAND_END)) {
            src += 6;
            AdvanceToNextWord(src, envPtr); 
            src += envPtr->termOffset;
            type = CHAR_TYPE(src, lastChar);
            if (type == TCL_COMMAND_END) {
                Tcl_ResetResult(interp);
                Tcl_AppendToObj(Tcl_GetObjResult(interp),
                        "wrong # args: no expression after \"elseif\" argument", -1);
                result = TCL_ERROR;
                goto done;
            }
            continue;     /* continue the "expr then body" loop */
          }
      }
      break;
    } /* end of the "expr then body" loop */

    /*
     * No more "elseif expr then body" clauses. Check now for an "else"
     * clause. If there is another word, we are at its start.
     */

    if (type != TCL_COMMAND_END) {
      if ((*src == 'e') && (strncmp(src, "else", 4) == 0)) {
          type = CHAR_TYPE(src+4, lastChar);
          if ((type == TCL_SPACE) || (type == TCL_COMMAND_END)) {
            src += 4;
            AdvanceToNextWord(src, envPtr); 
            src += envPtr->termOffset;
            type = CHAR_TYPE(src, lastChar);
            if (type == TCL_COMMAND_END) {
                Tcl_ResetResult(interp);
                Tcl_AppendToObj(Tcl_GetObjResult(interp),
                        "wrong # args: no script following \"else\" argument", -1);
                result = TCL_ERROR;
                goto done;
            }
          }
      }

      /*
       * Compile the "else" command word inline.
       */

      result = CompileCmdWordInline(interp, src, lastChar, flags, envPtr);
      if (result != TCL_OK) {
          if (result == TCL_ERROR) {
            char msg[60];
            sprintf(msg, "\n    (\"if\" else script line %d)",
                    interp->errorLine);
            Tcl_AddObjErrorInfo(interp, msg, -1);
          }
          goto done;
      }
      maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
      src += envPtr->termOffset;
    
      /*
       * Skip over white space until the end of the command.
       */
      
      type = CHAR_TYPE(src, lastChar);
      if (type != TCL_COMMAND_END) {
          AdvanceToNextWord(src, envPtr);
          src += envPtr->termOffset;
          type = CHAR_TYPE(src, lastChar);
          if (type != TCL_COMMAND_END) {
            Tcl_ResetResult(interp);
            Tcl_AppendToObj(Tcl_GetObjResult(interp),
                    "wrong # args: extra words after \"else\" clause in \"if\" command", -1);
            result = TCL_ERROR;
            goto done;
          }
      }
    } else {
      /*
       * The "if" command has no "else" clause: push an empty string
       * object as its result.
       */

      objIndex = TclObjIndexForString("", 0, /*allocStrRep*/ 0,
            /*inHeap*/ 0, envPtr);
      TclEmitPush(objIndex, envPtr);
      maxDepth = TclMax(1, maxDepth);
    }

    /*
     * Now that we know the target of the unconditional jumps to the end of
     * the "if" command, update them with the correct distance. If the
     * distance is too great (> 127 bytes), replace the jump with a four
     * byte instruction and move instructions after the jump down.
     */
    
    for (j = jumpEndFixupArray.next;  j > 0;  j--) {
      jumpIndex = (j - 1);    /* i.e. process the closest jump first */
      jumpDist = (TclCurrCodeOffset() - jumpEndFixupArray.fixup[jumpIndex].codeOffset);
      if (TclFixupForwardJump(envPtr,
              &(jumpEndFixupArray.fixup[jumpIndex]), jumpDist, 127)) {
          /*
           * Adjust the jump distance for the "ifFalse" jump that
           * immediately preceeds this jump. We've moved it's target
           * (just after this unconditional jump) three bytes down.
           */

          ifFalsePc = (envPtr->codeStart + jumpFalseFixupArray.fixup[jumpIndex].codeOffset);
          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->termOffset = (src - string);
    envPtr->maxStackDepth = maxDepth;
    envPtr->pushSimpleWords = savePushSimpleWords;
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileIncrCmd --
 *
 *    Procedure called to compile the "incr" 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->termOffset is filled in with the offset of the character in
 *    "string" just after the last one successfully processed.
 *
 *    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 evaluate the "incr" command
 *    at runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileIncrCmd(interp, string, lastChar, flags, envPtr)
    Tcl_Interp *interp;       /* Used for error reporting. */
    char *string;       /* The source string to compile. */
    char *lastChar;           /* Pointer to terminating character of
                         * string. */
    int flags;                /* Flags to control compilation (same as
                         * passed to Tcl_Eval). */
    CompileEnv *envPtr;       /* Holds resulting instructions. */
{
    Proc *procPtr = envPtr->procPtr;
                        /* Points to structure describing procedure
                         * containing incr command, else NULL. */
    register char *src = string;
                        /* Points to current source char. */
    register int type;        /* Current char's CHAR_TYPE type. */
    int simpleVarName;        /* 1 if name is just sequence of chars with
                                 * an optional element name in parens. */
    char *name = NULL;        /* If simpleVarName, points to first char of
                         * variable name and nameChars is length.
                         * Otherwise NULL. */
    char *elName = NULL;      /* If simpleVarName, points to first char of
                         * element name and elNameChars is length.
                         * Otherwise NULL. */
    int nameChars = 0;        /* Length of the var name. Initialized to
                         * avoid a compiler warning. */
    int elNameChars = 0;      /* Length of array's element name, if any.
                         * Initialized to avoid a compiler
                         * warning. */
    int incrementGiven;       /* 1 if an increment amount was given. */
    int isImmIncrValue = 0;   /* 1 if increment amount is a literal
                         * integer in [-127..127]. */
    int immIncrValue = 0;     /* if isImmIncrValue is 1, the immediate
                         * integer value. */
    int maxDepth = 0;         /* Maximum number of stack elements needed
                         * to execute cmd. */
    int localIndex = -1;      /* Index of the variable in the current
                         * procedure's array of local variables.
                         * Otherwise -1 if not in a procedure or
                         * the variable wasn't found. */
    char savedChar;           /* Holds the character from string
                         * termporarily replaced by a null char
                         * during name processing. */
    int objIndex;       /* The object array index for a pushed
                         * object holding a name part. */
    int savePushSimpleWords = envPtr->pushSimpleWords;
#ifdef KANJI
    int result;
#else
    char *p;
    int i, result;
#endif /* KANJI */

    /*
     * Parse the next word: the variable name. If it is "simple" (requires
     * no substitutions at runtime), divide it up into a simple "name" plus
     * an optional "elName". Otherwise, if not simple, just push the name.
     */

    AdvanceToNextWord(src, envPtr);
    src += envPtr->termOffset;
    type = CHAR_TYPE(src, lastChar);
    if (type == TCL_COMMAND_END) {
      badArgs:
      Tcl_ResetResult(interp);
      Tcl_AppendToObj(Tcl_GetObjResult(interp),
              "wrong # args: should be \"incr varName ?increment?\"", -1);
      result = TCL_ERROR;
      goto done;
    }
    
    envPtr->pushSimpleWords = 0;
    result = CompileWord(interp, src, lastChar, flags, envPtr);
    if (result != TCL_OK) {
      goto done;
    }
    simpleVarName = envPtr->wordIsSimple;
    if (simpleVarName) {
      name = src;
      nameChars = envPtr->numSimpleWordChars;
      if (type & (TCL_QUOTE | TCL_OPEN_BRACE)) {
          name++;
      }
      elName = NULL;
      elNameChars = 0;
#ifdef KANJI
      (void) GetKanjiVarAndEl(name, nameChars,
                        &name, &elName, &nameChars, &elNameChars, envPtr);
#else
      p = name;
      for (i = 0;  i < nameChars;  i++) {
          if (*p == '(') {
            char *openParen = p;
            p = (src + nameChars-1);      
            if (*p == ')') { /* last char is ')' => array reference */
                nameChars = (openParen - name);
                elName = openParen+1;
                elNameChars = (p - elName);
            }
            break;
          }
          p++;
      }
#endif /* KANJI */
    } else {
        maxDepth = envPtr->maxStackDepth;
    }
    src += envPtr->termOffset;

    /*
     * See if there is a next word. If so, we are incrementing the variable
     * by that value (which must be an integer).
     */

    incrementGiven = 0;
    type = CHAR_TYPE(src, lastChar);
    if (type != TCL_COMMAND_END) {
      AdvanceToNextWord(src, envPtr);
      src += envPtr->termOffset;
      type = CHAR_TYPE(src, lastChar);
      incrementGiven = (type != TCL_COMMAND_END);
    }

    /*
     * Non-simple names have already been pushed. If this is a simple
     * variable, either push its name (if a global or an unknown local
     * variable) or look up the variable's local frame index. If a local is
     * not found, push its name and do the lookup at runtime. If this is an
     * array reference, also push the array element.
     */

    if (simpleVarName) {
      if (procPtr == NULL) {
          savedChar = name[nameChars];
          name[nameChars] = '\0';
          objIndex = TclObjIndexForString(name, nameChars,
                /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
          name[nameChars] = savedChar;
          TclEmitPush(objIndex, envPtr);
          maxDepth = 1;
      } else {
          localIndex = LookupCompiledLocal(name, nameChars,
                  /*createIfNew*/ 0, /*flagsIfCreated*/ 0,
                envPtr->procPtr);
          if ((localIndex < 0) || (localIndex > 255)) {
            if (localIndex > 255) {       /* we'll push the name */
                localIndex = -1;
            }
            savedChar = name[nameChars];
            name[nameChars] = '\0';
            objIndex = TclObjIndexForString(name, nameChars,
                  /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
            name[nameChars] = savedChar;
            TclEmitPush(objIndex, envPtr);
            maxDepth = 1;
          } else {
            maxDepth = 0;
          }
      }
      
      if (elName != NULL) {
          /*
           * Parse and push the array element's name. Perform
           * substitutions on it, just as is done for quoted strings.
           */

          savedChar = elName[elNameChars];
          elName[elNameChars] = '\0';
          envPtr->pushSimpleWords = 1;
          result = TclCompileQuotes(interp, elName, elName+elNameChars,
                0, flags, envPtr);
          elName[elNameChars] = savedChar;
          if (result != TCL_OK) {
            char msg[200];
            sprintf(msg, "\n    (parsing index for array \"%.*s\")",
                  TclMin(nameChars, 100), name);
            Tcl_AddObjErrorInfo(interp, msg, -1);
            goto done;
          }
          maxDepth += envPtr->maxStackDepth;
      }
    }

    /*
     * If an increment was given, push the new value.
     */
    
    if (incrementGiven) {
      type = CHAR_TYPE(src, lastChar);
      envPtr->pushSimpleWords = 0;
      result = CompileWord(interp, src, lastChar, flags, envPtr);
      if (result != TCL_OK) {
          if (result == TCL_ERROR) {
            Tcl_AddObjErrorInfo(interp,
                    "\n    (increment expression)", -1);
          }
          goto done;
      }
      if (type & (TCL_QUOTE | TCL_OPEN_BRACE)) {
          src++;
      }
      if (envPtr->wordIsSimple) {
          /*
           * See if the word represents an integer whose formatted
           * representation is the same as the word (e.g., this is
           * true for 123 and -1 but not for 00005). If so, just
           * push an integer object.
           */
          
          int isCompilableInt = 0;
          int numChars = envPtr->numSimpleWordChars;
          char savedChar = src[numChars];
          char buf[40];
          Tcl_Obj *objPtr;
          long n;

          src[numChars] = '\0';
          if (TclLooksLikeInt(src)) {
            int code = TclGetLong(interp, src, &n);
            if (code == TCL_OK) {
                if ((-127 <= n) && (n <= 127)) {
                  isCompilableInt = 1;
                  isImmIncrValue = 1;
                  immIncrValue = n;
                } else {
                  TclFormatInt(buf, n);
                  if (strcmp(src, buf) == 0) {
                      isCompilableInt = 1;
                      isImmIncrValue = 0;
                      objIndex = TclObjIndexForString(src, numChars,
                                /*allocStrRep*/ 0, /*inHeap*/ 0, envPtr);
                      objPtr = envPtr->objArrayPtr[objIndex];

                      Tcl_InvalidateStringRep(objPtr);
                      objPtr->internalRep.longValue = n;
                      objPtr->typePtr = &tclIntType;
                      
                      TclEmitPush(objIndex, envPtr);
                      maxDepth += 1;
                  }
                }
            } else {
                Tcl_ResetResult(interp);
            }
          }
          if (!isCompilableInt) {
            objIndex = TclObjIndexForString(src, numChars,
                  /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
            TclEmitPush(objIndex, envPtr);
            maxDepth += 1;
          }
          src[numChars] = savedChar;
      } else {
          maxDepth += envPtr->maxStackDepth;
      }
      if (type & (TCL_QUOTE | TCL_OPEN_BRACE)) {
          src += (envPtr->termOffset - 1); /* already advanced 1 above */
      } else {
          src += envPtr->termOffset;
      }
    } else {                  /* no incr amount given so use 1 */
      isImmIncrValue = 1;
      immIncrValue = 1;
    }
    
    /*
     * Now emit instructions to increment the variable.
     */

    if (simpleVarName) {
      if (elName == NULL) {  /* scalar */
          if (localIndex >= 0) {
            if (isImmIncrValue) {
                TclEmitInstUInt1(INST_INCR_SCALAR1_IMM, localIndex,
                            envPtr);
                TclEmitInt1(immIncrValue, envPtr);
            } else {
                TclEmitInstUInt1(INST_INCR_SCALAR1, localIndex, envPtr);
            }
          } else {
            if (isImmIncrValue) {
                TclEmitInstInt1(INST_INCR_SCALAR_STK_IMM, immIncrValue,
                           envPtr);
            } else {
                TclEmitOpcode(INST_INCR_SCALAR_STK, envPtr);
            }
          }
      } else {          /* array */
          if (localIndex >= 0) {
            if (isImmIncrValue) {
                TclEmitInstUInt1(INST_INCR_ARRAY1_IMM, localIndex,
                            envPtr);
                TclEmitInt1(immIncrValue, envPtr);
            } else {
                TclEmitInstUInt1(INST_INCR_ARRAY1, localIndex, envPtr);
            }
          } else {
            if (isImmIncrValue) {
                TclEmitInstInt1(INST_INCR_ARRAY_STK_IMM, immIncrValue,
                           envPtr);
            } else {
                TclEmitOpcode(INST_INCR_ARRAY_STK, envPtr);
            }
          }
      }
    } else {                  /* non-simple variable name */
      if (isImmIncrValue) {
          TclEmitInstInt1(INST_INCR_STK_IMM, immIncrValue, envPtr);
      } else {
          TclEmitOpcode(INST_INCR_STK, envPtr);
      }
    }
      
    /*
     * Skip over white space until the end of the command.
     */

    type = CHAR_TYPE(src, lastChar);
    if (type != TCL_COMMAND_END) {
      AdvanceToNextWord(src, envPtr);
      src += envPtr->termOffset;
      type = CHAR_TYPE(src, lastChar);
      if (type != TCL_COMMAND_END) {
          goto badArgs;
      }
    }

    done:
    envPtr->termOffset = (src - string);
    envPtr->maxStackDepth = maxDepth;
    envPtr->pushSimpleWords = savePushSimpleWords;
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * 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->termOffset is filled in with the offset of the character in
 *    "string" just after the last one successfully processed.
 *
 *    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 evaluate the "set" command
 *    at runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileSetCmd(interp, string, lastChar, flags, envPtr)
    Tcl_Interp *interp;       /* Used for error reporting. */
    char *string;       /* The source string to compile. */
    char *lastChar;           /* Pointer to terminating character of
                         * string. */
    int flags;                /* Flags to control compilation (same as
                         * passed to Tcl_Eval). */
    CompileEnv *envPtr;       /* Holds resulting instructions. */
{
    Proc *procPtr = envPtr->procPtr;
                        /* Points to structure describing procedure
                         * containing the set command, else NULL. */
    ArgInfo argInfo;          /* Structure holding information about the
                         * start and end of each argument word. */
    int simpleVarName;        /* 1 if name is just sequence of chars with
                                 * an optional element name in parens. */
    char *elName = NULL;      /* If simpleVarName, points to first char of
                         * element name and elNameChars is length.
                         * Otherwise NULL. */
    int isAssignment;         /* 1 if assigning value to var, else 0. */
    int maxDepth = 0;         /* Maximum number of stack elements needed
                         * to execute cmd. */
    int localIndex = -1;      /* Index of the variable in the current
                         * procedure's array of local variables.
                         * Otherwise -1 if not in a procedure, the
                         * name contains "::"s, or the variable
                         * wasn't found. */
    char savedChar;           /* Holds the character from string
                         * termporarily replaced by a null char
                         * during name processing. */
    int objIndex = -1;        /* The object array index for a pushed
                         * object holding a name part. Initialized
                         * to avoid a compiler warning. */
    char *wordStart, *p;
    int numWords, isCompilableInt, i, result;
    Tcl_Obj *objPtr;
    int savePushSimpleWords = envPtr->pushSimpleWords;

    /*
     * Scan the words of the command and record the start and finish of
     * each argument word.
     */

    InitArgInfo(&argInfo);
    result = CollectArgInfo(interp, string, lastChar, flags, &argInfo);
    numWords = argInfo.numArgs;       /* i.e., the # after the command name */
    if (result != TCL_OK) {
      goto done;
    }
    if ((numWords < 1) || (numWords > 2)) {
      Tcl_ResetResult(interp);
      Tcl_AppendToObj(Tcl_GetObjResult(interp),
              "wrong # args: should be \"set varName ?newValue?\"", -1);
        result = TCL_ERROR;
      goto done;
    }
    isAssignment = (numWords == 2);

    /*
     * Parse the next word: the variable name. If the name is enclosed in
     * quotes or braces, we return TCL_OUT_LINE_COMPILE and call the set
     * command procedure at runtime since this makes sure that a second
     * round of substitutions is done properly. 
     */

    wordStart = argInfo.startArray[0]; /* start of 1st arg word: varname */
    if ((*wordStart == '{') || (*wordStart == '"')) {
      result = TCL_OUT_LINE_COMPILE;
      goto done;
    }

    /*
     * Check whether the name is "simple": requires no substitutions at
     * runtime.
     */
    
    envPtr->pushSimpleWords = 0;
    result = CompileWord(interp, wordStart, argInfo.endArray[0] + 1,
          flags, envPtr);
    if (result != TCL_OK) {
      goto done;
    }
    simpleVarName = envPtr->wordIsSimple;
    
    if (!simpleVarName) {
      /*
       * The name isn't simple. CompileWord already pushed it.
       */
      
      maxDepth = envPtr->maxStackDepth;
    } else {
      char *name;       /* If simpleVarName, points to first char of
                         * variable name and nameChars is length.
                         * Otherwise NULL. */
      int nameChars;          /* Length of the var name. */
      int nameHasNsSeparators = 0;
                        /* Set 1 if name contains "::"s. */
      int elNameChars;  /* Length of array's element name if any. */
#ifdef KANJI
      char *lastChar;
#endif /* KANJI */

      /*
       * A simple name. First divide it up into "name" plus "elName"
       * for an array element name, if any.
       */
      
      name = wordStart;
      nameChars = envPtr->numSimpleWordChars;
      elName = NULL;
      elNameChars = 0;
#ifdef KANJI
      (void) GetKanjiVarAndEl(name, nameChars,
                        &name, &elName, &nameChars, &elNameChars, envPtr);
      lastChar = name + nameChars;
#else
      p = name;
      for (i = 0;  i < nameChars;  i++) {
          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;
          }
          p++;
      }
#endif /* KANJI */

      /*
       * Determine if name has any namespace separators (::'s).
       */

      p = name;
      for (i = 0;  i < nameChars;  i++) {
#ifdef KANJI
          if (IS_KANJISTART(UCHAR(*p))) {
            i += (Tcl_KanjiSkip(p, lastChar, NULL) - 1);
            p = &(name[i]);
          } else
#endif /* KANJI */
          if ((*p == ':') && ((i+1) < nameChars) && (*(p+1) == ':')) {
            nameHasNsSeparators = 1;
            break;
          }
          p++;
      }

      /*
       * Now either push the name or determine its index in the array of
       * local variables in a procedure frame. Note that if we are
       * compiling a procedure the variable must be local unless its
       * name has namespace separators ("::"s). Note also that global
       * variables are implemented by a local variable that "points" to
       * the real global. There are two cases:
       *   1) We are not compiling a procedure body. Push the global
       *      variable's name and do the lookup at runtime.
       *   2) We are compiling a procedure and the name has "::"s.
       *    Push the namespace variable's name and do the lookup at
       *    runtime.
       *   3) We are compiling a procedure and the name has no "::"s.
       *    If the variable has already been allocated an local index,
       *    just look it up. If the variable is unknown and we are
       *    doing an assignment, allocate a new index. Otherwise,
       *    push the name and try to do the lookup at runtime.
       */

      if ((procPtr == NULL) || nameHasNsSeparators) {
          savedChar = name[nameChars];
          name[nameChars] = '\0';
          objIndex = TclObjIndexForString(name, nameChars,
                /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
          name[nameChars] = savedChar;
          TclEmitPush(objIndex, envPtr);
          maxDepth = 1;
      } else {
          localIndex = LookupCompiledLocal(name, nameChars,
                  /*createIfNew*/ isAssignment,
                    /*flagsIfCreated*/
                  ((elName == NULL)? VAR_SCALAR : VAR_ARRAY),
                envPtr->procPtr);
          if (localIndex >= 0) {
            maxDepth = 0;
          } else {
            savedChar = name[nameChars];
            name[nameChars] = '\0';
            objIndex = TclObjIndexForString(name, nameChars,
                  /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
            name[nameChars] = savedChar;
            TclEmitPush(objIndex, envPtr);
            maxDepth = 1;
          }
      }

      /*
       * If we are dealing with a reference to an array element, push the
       * array element. Perform substitutions on it, just as is done
       * for quoted strings.
       */
      
      if (elName != NULL) {
          savedChar = elName[elNameChars];
          elName[elNameChars] = '\0';
          envPtr->pushSimpleWords = 1;
          result = TclCompileQuotes(interp, elName, elName+elNameChars,
                0, flags, envPtr);
          elName[elNameChars] = savedChar;
          if (result != TCL_OK) {
            char msg[200];
            sprintf(msg, "\n    (parsing index for array \"%.*s\")",
                  TclMin(nameChars, 100), name);
            Tcl_AddObjErrorInfo(interp, msg, -1);
            goto done;
          }
          maxDepth += envPtr->maxStackDepth;
      }
    }

    /*
     * If we are doing an assignment, push the new value.
     */
    
    if (isAssignment) {
      wordStart = argInfo.startArray[1]; /* start of 2nd arg word */
      envPtr->pushSimpleWords = 0;       /* we will handle simple words */
      result = CompileWord(interp, wordStart,   argInfo.endArray[1] + 1,
            flags, envPtr);
      if (result != TCL_OK) {
          goto done;
      }
      if (!envPtr->wordIsSimple) {
          /*
           * The value isn't simple. CompileWord already pushed it.
           */

          maxDepth += envPtr->maxStackDepth;
      } else {
          /*
           * The value is simple. See if the word represents an integer
           * whose formatted representation is the same as the word (e.g.,
           * this is true for 123 and -1 but not for 00005). If so, just
           * push an integer object.
           */
          
          char buf[40];
          long n;

          p = wordStart;
          if ((*wordStart == '"') || (*wordStart == '{')) {
            p++;
          }
          savedChar = p[envPtr->numSimpleWordChars];
          p[envPtr->numSimpleWordChars] = '\0';
          isCompilableInt = 0;
          if (TclLooksLikeInt(p)) {
            int code = TclGetLong(interp, p, &n);
            if (code == TCL_OK) {
                TclFormatInt(buf, n);
                if (strcmp(p, buf) == 0) {
                  isCompilableInt = 1;
                  objIndex = TclObjIndexForString(p,
                        envPtr->numSimpleWordChars,
                                /*allocStrRep*/ 0, /*inHeap*/ 0, envPtr);
                  objPtr = envPtr->objArrayPtr[objIndex];

                  Tcl_InvalidateStringRep(objPtr);
                  objPtr->internalRep.longValue = n;
                  objPtr->typePtr = &tclIntType;
                }
            } else {
                Tcl_ResetResult(interp);
            }
          }
          if (!isCompilableInt) {
            objIndex = TclObjIndexForString(p,
                  envPtr->numSimpleWordChars, /*allocStrRep*/ 1,
                  /*inHeap*/ 0, envPtr);
          }
          p[envPtr->numSimpleWordChars] = savedChar;
          TclEmitPush(objIndex, envPtr);
          maxDepth += 1;
      }
    }
    
    /*
     * Now emit instructions to set/retrieve the variable.
     */

    if (simpleVarName) {
      if (elName == NULL) {  /* scalar */
          if (localIndex >= 0) {
            if (localIndex <= 255) {
                TclEmitInstUInt1((isAssignment?
                       INST_STORE_SCALAR1 : INST_LOAD_SCALAR1),
                  localIndex, envPtr);
            } else {
                TclEmitInstUInt4((isAssignment?
                       INST_STORE_SCALAR4 : INST_LOAD_SCALAR4),
                  localIndex, envPtr);
            }
          } else {
            TclEmitOpcode((isAssignment?
                       INST_STORE_SCALAR_STK : INST_LOAD_SCALAR_STK),
                      envPtr);
          }
      } else {          /* array */
          if (localIndex >= 0) {
            if (localIndex <= 255) {
                TclEmitInstUInt1((isAssignment?
                       INST_STORE_ARRAY1 : INST_LOAD_ARRAY1),
                  localIndex, envPtr);
            } else {
                TclEmitInstUInt4((isAssignment?
                       INST_STORE_ARRAY4 : INST_LOAD_ARRAY4),
                  localIndex, envPtr);
            }
          } else {
            TclEmitOpcode((isAssignment?
                       INST_STORE_ARRAY_STK : INST_LOAD_ARRAY_STK),
                      envPtr);
          }
      }
    } else {                  /* non-simple variable name */
      TclEmitOpcode((isAssignment? INST_STORE_STK : INST_LOAD_STK), envPtr);
    }
      
    done:
    if (numWords == 0) {
      envPtr->termOffset = 0;
    } else {
      envPtr->termOffset = (argInfo.endArray[numWords-1] + 1 - string);
    }
    envPtr->pushSimpleWords = savePushSimpleWords;
    envPtr->maxStackDepth = maxDepth;
    FreeArgInfo(&argInfo);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * 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->termOffset is filled in with the offset of the character in
 *    "string" just after the last one successfully processed.
 *
 *    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 evaluate the "while" command
 *    at runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileWhileCmd(interp, string, lastChar, flags, envPtr)
    Tcl_Interp *interp;       /* Used for error reporting. */
    char *string;       /* The source string to compile. */
    char *lastChar;            /* Pointer to terminating character of
                          * string. */
    int flags;                /* Flags to control compilation (same as
                         * passed to Tcl_Eval). */
    CompileEnv *envPtr;       /* Holds resulting instructions. */
{
    register char *src = string;/* Points to current source char. */
    register int type;        /* Current char's CHAR_TYPE type. */
    int maxDepth = 0;         /* Maximum number of stack elements needed
                         * to execute cmd. */
    int range = -1;           /* Index in the ExceptionRange array of the
                         * ExceptionRange record for this loop. */
    JumpFixup jumpFalseFixup; /* Used to update or replace the ifFalse
                         * jump after test when its target PC is
                         * determined. */
    unsigned char *jumpPc;
    int jumpDist, jumpBackDist, jumpBackOffset, objIndex, result;
    int savePushSimpleWords = envPtr->pushSimpleWords;

    AdvanceToNextWord(src, envPtr);
    src += envPtr->termOffset;
    type = CHAR_TYPE(src, lastChar);
    if (type == TCL_COMMAND_END) {
      badArgs:
      Tcl_ResetResult(interp);
      Tcl_AppendToObj(Tcl_GetObjResult(interp),
              "wrong # args: should be \"while test command\"", -1);
      result = TCL_ERROR;
      goto done;
    }

    /*
     * If the test expression is not enclosed in braces, don't compile
     * the while inline. As a result of Tcl's two level substitution
     * semantics for expressions, the expression might have a constant
     * value that results in the loop never executing, or executing forever.
     * Consider "set x 0; whie "$x > 5" {incr x}": the loop body 
     * should never be executed.
     * NOTE: This is an overly aggressive test, since there are legitimate
     * literals that could be compiled but aren't in braces.  However, until
     * the parser is integrated in 8.1, this is the simplest implementation.
     */

    if (*src != '{') {
      result = TCL_OUT_LINE_COMPILE;
      goto done;
    }

    /*
     * Create and initialize a ExceptionRange record to hold information
     * about this loop. This is used to implement break and continue.
     */

    envPtr->excRangeDepth++;
    envPtr->maxExcRangeDepth =
      TclMax(envPtr->excRangeDepth, envPtr->maxExcRangeDepth);

    range = CreateExceptionRange(LOOP_EXCEPTION_RANGE, envPtr);
    envPtr->excRangeArrayPtr[range].continueOffset = TclCurrCodeOffset();

    /*
     * Compile the next word: the test expression.
     */

    envPtr->pushSimpleWords = 1;
    result = CompileExprWord(interp, src, lastChar, flags, envPtr);
    if (result != TCL_OK) {
      if (result == TCL_ERROR) {
            Tcl_AddObjErrorInfo(interp,
                "\n    (\"while\" test expression)", -1);
        }
      goto done;
    }
    maxDepth = envPtr->maxStackDepth;
    src += envPtr->termOffset;

    /*
     * Emit the ifFalse jump that terminates the while if the test was
     * false. We emit a one byte (relative) jump here, and replace it
     * later with a four byte jump if the jump target is more than
     * 127 bytes away.
     */

    TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);
    
    /*
     * Compile the loop body word inline. Also register the loop body's
     * starting PC offset and byte length in the its ExceptionRange record.
     */

    AdvanceToNextWord(src, envPtr);
    src += envPtr->termOffset;
    type = CHAR_TYPE(src, lastChar);
    if (type == TCL_COMMAND_END) {
      goto badArgs;
    }

    envPtr->excRangeArrayPtr[range].codeOffset = TclCurrCodeOffset();
    result = CompileCmdWordInline(interp, src, lastChar,
          flags, envPtr);
    if (result != TCL_OK) {
      if (result == TCL_ERROR) {
          char msg[60];
          sprintf(msg, "\n    (\"while\" body line %d)", interp->errorLine);
            Tcl_AddObjErrorInfo(interp, msg, -1);
        }
      goto done;
    }
    maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
    src += envPtr->termOffset;
    envPtr->excRangeArrayPtr[range].numCodeBytes =
      (TclCurrCodeOffset() - envPtr->excRangeArrayPtr[range].codeOffset);

    /*
     * Discard the loop body's result.
     */

    TclEmitOpcode(INST_POP, envPtr);
      
    /*
     * Emit the unconditional jump back to the test at the top of the
     * loop. We generate a four byte jump if the distance to the while's
     * test is greater than 120 bytes. This is conservative, and ensures
     * that we won't have to replace this unconditional jump if we later
     * need to replace the ifFalse jump with a four-byte jump.
     */

    jumpBackOffset = TclCurrCodeOffset();
    jumpBackDist =
      (jumpBackOffset - envPtr->excRangeArrayPtr[range].continueOffset);
    if (jumpBackDist > 120) {
      TclEmitInstInt4(INST_JUMP4, /*offset*/ -jumpBackDist, envPtr);
    } else {
      TclEmitInstInt1(INST_JUMP1, /*offset*/ -jumpBackDist, envPtr);
    }

    /*
     * Now that we know the target of the jumpFalse after the test, update
     * it with the correct distance. If the distance is too great (more
     * than 127 bytes), replace that jump with a four byte instruction and
     * move the instructions after the jump down. 
     */

    jumpDist = (TclCurrCodeOffset() - jumpFalseFixup.codeOffset);
    if (TclFixupForwardJump(envPtr, &jumpFalseFixup, jumpDist, 127)) {
      /*
       * Update the loop body's starting PC offset since it moved down.
       */

      envPtr->excRangeArrayPtr[range].codeOffset += 3;

      /*
       * Update the distance for the unconditional jump back to the test
       * at the top of the loop since it moved down 3 bytes too.
       */

      jumpBackOffset += 3;
      jumpPc = (envPtr->codeStart + jumpBackOffset);
      if (jumpBackDist > 120) {
          jumpBackDist += 3;
          TclUpdateInstInt4AtPc(INST_JUMP4, /*offset*/ -jumpBackDist,
                           jumpPc);
      } else {
          jumpBackDist += 3;
          TclUpdateInstInt1AtPc(INST_JUMP1, /*offset*/ -jumpBackDist,
                           jumpPc);
      }
    }

    /*
     * The current PC offset (after the loop's body) is the loop's
     * break target.
     */

    envPtr->excRangeArrayPtr[range].breakOffset = TclCurrCodeOffset();
    
    /*
     * Push an empty string object as the while command's result.
     */

    objIndex = TclObjIndexForString("", 0, /*allocStrRep*/ 0, /*inHeap*/ 0,
                            envPtr);
    TclEmitPush(objIndex, envPtr);
    if (maxDepth == 0) {
      maxDepth = 1;
    }

    /*
     * Skip over white space until the end of the command.
     */

    type = CHAR_TYPE(src, lastChar);
    if (type != TCL_COMMAND_END) {
      AdvanceToNextWord(src, envPtr);
      src += envPtr->termOffset;
      type = CHAR_TYPE(src, lastChar);
      if (type != TCL_COMMAND_END) {
          goto badArgs;
      }
    }

    done:
    envPtr->termOffset = (src - string);
    envPtr->pushSimpleWords = savePushSimpleWords;
    envPtr->maxStackDepth = maxDepth;
    if (range != -1) {
      envPtr->excRangeDepth--;
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * CompileExprWord --
 *
 *    Procedure that compiles a Tcl expression in a command word.
 *
 * Results:
 *    The return value is a standard Tcl result, which is TCL_OK unless
 *    there was an error while compiling string. If an error occurs then
 *    the interpreter's result contains a standard error message.
 *
 *    envPtr->termOffset is filled in with the offset of the character in
 *    "string" just after the last one successfully processed.
 *
 *    envPtr->maxStackDepth is updated with the maximum number of stack
 *    elements needed to execute the "expr" word.
 *
 * Side effects:
 *    Instructions are added to envPtr to evaluate the expression word
 *    at runtime.
 *
 *----------------------------------------------------------------------
 */

static int
CompileExprWord(interp, string, lastChar, flags, envPtr)
    Tcl_Interp *interp;       /* Used for error reporting. */
    char *string;       /* The source string to compile. */
    char *lastChar;            /* Pointer to terminating character of
                          * string. */
    int flags;                /* Flags to control compilation (same as
                         * passed to Tcl_Eval). */
    CompileEnv *envPtr;       /* Holds resulting instructions. */
{
    register char *src = string;/* Points to current source char. */
    register int type;          /* Current char's CHAR_TYPE type. */
    int maxDepth = 0;         /* Maximum number of stack elements needed
                         * to execute the expression. */
    int nestedCmd = (flags & TCL_BRACKET_TERM);
                        /* 1 if script being compiled is a nested
                         * command and is terminated by a ']';
                         * otherwise 0. */
    char *first, *last;       /* Points to the first and last significant
                         * characters of the word. */
    char savedChar;           /* Holds the character termporarily replaced
                         * by a null character during compilation
                         * of the expression. */
    int inlineCode;           /* 1 if inline "optimistic" code is
                         * emitted for the expression; else 0. */
    int range = -1;           /* If we inline compile an un-{}'d
                         * expression, the index for its catch range
                         * record in the ExceptionRange array.
                         * Initialized to enable proper cleanup. */
    JumpFixup jumpFixup;      /* Used to emit the "success" jump after
                         * the inline expression code. */
    char *p;
    char c;
    int savePushSimpleWords = envPtr->pushSimpleWords;
    int saveExprIsJustVarRef = envPtr->exprIsJustVarRef;
    int saveExprIsComparison = envPtr->exprIsComparison;
    int numChars, result;

    /*
     * Skip over leading white space.
     */

    AdvanceToNextWord(src, envPtr);
    src += envPtr->termOffset;
    type = CHAR_TYPE(src, lastChar);
    if (type == TCL_COMMAND_END) {
      badArgs:
      Tcl_ResetResult(interp);
          Tcl_AppendToObj(Tcl_GetObjResult(interp),
                "malformed expression word", -1);
      result = TCL_ERROR;
      goto done;
    }

    /*
     * If the word is enclosed in {}s, we may strip them off and safely
     * compile the expression into an inline sequence of instructions using
     * TclCompileExpr. We know these instructions will have the right Tcl7.x
     * expression semantics.
     *
     * Otherwise, if the word is not enclosed in {}s, we may need to call
     * the expr command (Tcl_ExprObjCmd) at runtime. This recompiles the
     * expression each time (typically) and so is slow. However, there are
     * some circumstances where we can still compile inline instructions
     * "optimistically" and check, during their execution, for double
     * substitutions (these appear as nonnumeric operands). We check for any
     * backslash or command substitutions. If none appear, and only variable
     * substitutions are found, we generate inline instructions.
     *
     * For now, if the expression is not enclosed in {}s, we call the expr
     * command at runtime if either command or backslash substitutions
     * appear (but not if only variable substitutions appear).
     */

    if (*src == '{') {
      /*
       * Inline compile the expression inside {}s.
       */
      
      first = src+1;
      src = TclWordEnd(src, lastChar, nestedCmd, NULL);
      if (*src == 0) {
          goto badArgs;
      }
      if (*src != '}') {
          goto badArgs;
      }
      last = (src-1);

      numChars = (last - first + 1);
      savedChar = first[numChars];
      first[numChars] = '\0';
      result = TclCompileExpr(interp, first, first+numChars,
            flags, envPtr);
      first[numChars] = savedChar;

      src++;
      maxDepth = envPtr->maxStackDepth;
    } else {
      /*
       * No braces. If the expression is enclosed in '"'s, call the expr
       * cmd at runtime. Otherwise, scan the word's characters looking for
       * any '['s or (for now) '\'s. If any are found, just call expr cmd
       * at runtime.
       */

      first = src;
      last = TclWordEnd(first, lastChar, nestedCmd, NULL);
      if (*last == 0) { /* word doesn't end properly. */
          src = last;
          goto badArgs;
      }

      inlineCode = 1;
      if ((*first == '"') && (*last == '"')) {
          inlineCode = 0;
      } else {
          for (p = first;  p <= last;  p++) {
            c = *p;
            if ((c == '[') || (c == '\\')) {
                inlineCode = 0;
                break;
            }
          }
      }
      
      if (inlineCode) {
          /*
           * Inline compile the expression inside a "catch" so that a
           * runtime error will back off to make a (slow) call on expr.
           */

          int startCodeOffset = (envPtr->codeNext - envPtr->codeStart);
          int startRangeNext = envPtr->excRangeArrayNext;

          /*
           * Create a ExceptionRange record to hold information about
           * the "catch" range for the expression's inline code. Also
           * emit the instruction to mark the start of the range.
           */

          envPtr->excRangeDepth++;
          envPtr->maxExcRangeDepth =
            TclMax(envPtr->excRangeDepth, envPtr->maxExcRangeDepth);
          range = CreateExceptionRange(CATCH_EXCEPTION_RANGE, envPtr);
          TclEmitInstUInt4(INST_BEGIN_CATCH4, range, envPtr);

          /*
           * Inline compile the expression.
           */

          envPtr->excRangeArrayPtr[range].codeOffset = TclCurrCodeOffset();
          numChars = (last - first + 1);
          savedChar = first[numChars];
          first[numChars] = '\0';
          result = TclCompileExpr(interp, first, first + numChars,
                flags, envPtr);
          first[numChars] = savedChar;
          
          envPtr->excRangeArrayPtr[range].numCodeBytes =
            TclCurrCodeOffset() - envPtr->excRangeArrayPtr[range].codeOffset;

          if ((result != TCL_OK) || (envPtr->exprIsJustVarRef)
                  || (envPtr->exprIsComparison)) {
            /*
             * We must call the expr command at runtime. Either there
             * was a compilation error or the inline code might fail to
             * give the correct 2 level substitution semantics.
             *
             * The latter can happen if the expression consisted of just
             * a single variable reference or if the top-level operator
             * in the expr is a comparison (which might operate on
             * strings). In the latter case, the expression's code might
             * execute (apparently) successfully but produce the wrong
             * result. We depend on its execution failing if a second
             * level of substitutions is required. This causes the
             * "catch" code we generate around the inline code to back
             * off to a call on the expr command at runtime, and this
             * always gives the right 2 level substitution semantics.
             *
             * We delete the inline code by backing up the code pc and
             * catch index. Note that if there was a compilation error,
             * we can't report the error yet since the expression might
             * be valid after the second round of substitutions.
             */
            
            envPtr->codeNext = (envPtr->codeStart + startCodeOffset);
            envPtr->excRangeArrayNext = startRangeNext;
            inlineCode = 0;
          } else {
            TclEmitOpcode(INST_END_CATCH, envPtr);
            TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
            envPtr->excRangeArrayPtr[range].catchOffset = TclCurrCodeOffset();
          }
      }
          
      /*
       * Arrange to call expr at runtime with the (already substituted
       * once) expression word on the stack.
       */

      envPtr->pushSimpleWords = 1;
      result = CompileWord(interp, first, lastChar, flags, envPtr);
      src += envPtr->termOffset;
      maxDepth = envPtr->maxStackDepth;
      if (result == TCL_OK) {
          TclEmitOpcode(INST_EXPR_STK, envPtr);
      }

      /*
       * If emitting inline code for this non-{}'d expression, update
       * the target of the jump after that inline code.
       */

      if (inlineCode) {
          int jumpDist = (TclCurrCodeOffset() - jumpFixup.codeOffset);
          if (TclFixupForwardJump(envPtr, &jumpFixup, jumpDist, 127)) {
            /*
             * Update the inline expression code's catch ExceptionRange
             * target since it, being after the jump, also moved down.
             */

            envPtr->excRangeArrayPtr[range].catchOffset += 3;
          }
      }
    } /* if expression isn't in {}s */
    
    done:
    if (range != -1) {
      envPtr->excRangeDepth--;
    }
    envPtr->termOffset = (src - string);
    envPtr->maxStackDepth = maxDepth;
    envPtr->pushSimpleWords = savePushSimpleWords;
    envPtr->exprIsJustVarRef = saveExprIsJustVarRef;
    envPtr->exprIsComparison = saveExprIsComparison;
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * CompileCmdWordInline --
 *
 *    Procedure that compiles a Tcl command word inline. If the word is
 *    enclosed in quotes or braces, we call TclCompileString to compile it
 *    after stripping them off. Otherwise, we normally push the word's
 *    value and call eval at runtime, but if the word is just a sequence
 *    of alphanumeric characters, we emit an invoke instruction
 *    directly. This procedure assumes that string points to the start of
 *    the word to compile.
 *
 * Results:
 *    The return value is a standard Tcl result, which is TCL_OK unless
 *    there was an error while compiling string. If an error occurs then
 *    the interpreter's result contains a standard error message.
 *
 *    envPtr->termOffset is filled in with the offset of the character in
 *    "string" just after the last one successfully processed.
 *
 *    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 command word
 *    at runtime.
 *
 *----------------------------------------------------------------------
 */

static int
CompileCmdWordInline(interp, string, lastChar, flags, envPtr)
    Tcl_Interp *interp;       /* Used for error reporting. */
    char *string;       /* The source string to compile. */
    char *lastChar;           /* Pointer to terminating character of
                         * string. */
    int flags;                /* Flags to control compilation (same as
                         * passed to Tcl_Eval). */
    CompileEnv *envPtr;       /* Holds resulting instructions. */
{
    Interp *iPtr = (Interp *) interp;
    register char *src = string;/* Points to current source char. */
    register int type;          /* Current char's CHAR_TYPE type. */
    int maxDepth = 0;         /* Maximum number of stack elements needed
                         * to execute cmd. */
    char *termPtr;            /* Points to char that terminated braced
                         * string. */
    char savedChar;           /* Holds the character termporarily replaced
                         * by a null character during compilation
                         * of the command. */
    int savePushSimpleWords = envPtr->pushSimpleWords;
    int objIndex;
    int result = TCL_OK;
    register char c;

    type = CHAR_TYPE(src, lastChar);
    if (type & (TCL_QUOTE | TCL_OPEN_BRACE)) {
      src++;
      envPtr->pushSimpleWords = 0;
      if (type == TCL_QUOTE) {
          result = TclCompileQuotes(interp, src, lastChar,
                '"', flags, envPtr);
      } else {
          result = CompileBraces(interp, src, lastChar, flags, envPtr);
      }
      if (result != TCL_OK) {
          goto done;
      }
      
      /*
       * Make sure the terminating character is the end of word.
       */
      
      termPtr = (src + envPtr->termOffset);
      c = *termPtr;
      if ((c == '\\') && (*(termPtr+1) == '\n')) {
          /*
           * Line is continued on next line; the backslash-newline turns
           * into space, which terminates the word.
           */
      } else {
          type = CHAR_TYPE(termPtr, lastChar);
          if ((type != TCL_SPACE) && (type != TCL_COMMAND_END)) {
            Tcl_ResetResult(interp);
            if (*(src-1) == '"') {
                Tcl_AppendToObj(Tcl_GetObjResult(interp),
                      "extra characters after close-quote", -1);
            } else {
                Tcl_AppendToObj(Tcl_GetObjResult(interp),
                        "extra characters after close-brace", -1);
            }
            result = TCL_ERROR;
            goto done;
          }
      }
      
      if (envPtr->wordIsSimple) {
          /*
           * A simple word enclosed in "" or {}s. Call TclCompileString to
           * compile it inline. Add a null character after the end of the
           * quoted or braced string: i.e., at the " or }. Turn the
           * flag bit TCL_BRACKET_TERM off since the recursively
           * compiled subcommand is now terminated by a null character.
           */
          char *closeCharPos = (termPtr - 1);
          
          savedChar = *closeCharPos;
          *closeCharPos = '\0';
          result = TclCompileString(interp, src, closeCharPos,
                (flags & ~TCL_BRACKET_TERM), envPtr);
          *closeCharPos = savedChar;
          if (result != TCL_OK) {
            goto done;
          }
      } else {
            /*
           * The braced string contained a backslash-newline. Call eval
           * at runtime.
           */
          TclEmitOpcode(INST_EVAL_STK, envPtr);
      }
      src = termPtr;
      maxDepth = envPtr->maxStackDepth;
    } else {
      /*
       * Not a braced or quoted string. We normally push the word's
       * value and call eval at runtime. However, if the word is just
       * a sequence of alphanumeric characters, we call its compile
       * procedure, if any, or otherwise just emit an invoke instruction.
       */

      char *p = src;
      c = *p;
      while (isalnum(UCHAR(c)) || (c == '_')) {
            p++;
            c = *p;
        }
      type = CHAR_TYPE(p, lastChar);
        if ((p > src) && (type == TCL_COMMAND_END)) {
            /*
           * Look for a compile procedure and call it. Otherwise emit an
           * invoke instruction to call the command at runtime.
           */

          Tcl_Command cmd;
          Command *cmdPtr = NULL;
          int wasCompiled = 0;

          savedChar = *p;
          *p = '\0';

          cmd = Tcl_FindCommand(interp, src, (Tcl_Namespace *) NULL,
                /*flags*/ 0);
          if (cmd != (Tcl_Command) NULL) {
                cmdPtr = (Command *) cmd;
            }
          if (cmdPtr != NULL && cmdPtr->compileProc != NULL) {
            *p = savedChar;
            src = p;
            iPtr->flags &= ~(ERR_ALREADY_LOGGED | ERR_IN_PROGRESS
                         | ERROR_CODE_SET);
            result = (*(cmdPtr->compileProc))(interp, src, lastChar, flags, envPtr);
            if (result != TCL_OK) {
                goto done;
            }
            wasCompiled = 1;
            src += envPtr->termOffset;
            maxDepth = envPtr->maxStackDepth;
          }
          if (!wasCompiled) {
            objIndex = TclObjIndexForString(src, p-src,
                  /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
            *p = savedChar;
            TclEmitPush(objIndex, envPtr);
            TclEmitInstUInt1(INST_INVOKE_STK1, 1, envPtr);
            src = p;
            maxDepth = 1;
          }
        } else {
          /*
           * Push the word and call eval at runtime.
           */

          envPtr->pushSimpleWords = 1;
          result = CompileWord(interp, src, lastChar, flags, envPtr);
          if (result != TCL_OK) {
            goto done;
          }
          TclEmitOpcode(INST_EVAL_STK, envPtr);
          src += envPtr->termOffset;
          maxDepth = envPtr->maxStackDepth;
      }
    }

    done:
    envPtr->termOffset = (src - string);
    envPtr->maxStackDepth = maxDepth;
    envPtr->pushSimpleWords = savePushSimpleWords;
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * LookupCompiledLocal --
 *
 *    This procedure is called at compile time to look up and optionally
 *    allocate an entry ("slot") for a variable in a procedure's array of
 *    local variables. If the variable's name is NULL, a new temporary
 *    variable is always created. (Such temporary variables can only be
 *    referenced using their slot index.)
 *
 * Results:
 *    If createIfNew is 0 (false) and the name is non-NULL, then if the
 *    variable is found, the index of its entry in the procedure's array
 *    of local variables is returned; otherwise -1 is returned.
 *    If name is NULL, the index of a new temporary variable is returned.
 *    Finally, if createIfNew is 1 and name is non-NULL, the index of a
 *    new entry is returned.
 *
 * Side effects:
 *    Creates and registers a new local variable if createIfNew is 1 and
 *    the variable is unknown, or if the name is NULL.
 *
 *----------------------------------------------------------------------
 */

static int
LookupCompiledLocal(name, nameChars, createIfNew, flagsIfCreated, procPtr)
    register char *name;      /* Points to first character of the name of
                         * a scalar or array variable. If NULL, a
                         * temporary var should be created. */
    int nameChars;            /* The length of the name excluding the
                         * terminating null character. */
    int createIfNew;          /* 1 to allocate a local frame entry for the
                         * variable if it is new. */
    int flagsIfCreated;       /* Flag bits for the compiled local if
                         * created. Only VAR_SCALAR, VAR_ARRAY, and
                         * VAR_LINK make sense. */
    register Proc *procPtr;   /* Points to structure describing procedure
                         * containing the variable reference. */
{
    register CompiledLocal *localPtr;
    int localIndex = -1;
    register int i;
    int localCt;

    /*
     * If not creating a temporary, does a local variable of the specified
     * name already exist?
     */

    if (name != NULL) { 
      localCt = procPtr->numCompiledLocals;
      localPtr = procPtr->firstLocalPtr;
      for (i = 0;  i < localCt;  i++) {
          if (!TclIsVarTemporary(localPtr)) {
            char *localName = localPtr->name;
            if ((name[0] == localName[0])
                      && (nameChars == localPtr->nameLength)
                      && (strncmp(name, localName, (unsigned) nameChars) == 0)) {
                return i;
            }
          }
          localPtr = localPtr->nextPtr;
      }
    }

    /*
     * Create a new variable if appropriate.
     */
    
    if (createIfNew || (name == NULL)) {
      localIndex = procPtr->numCompiledLocals;
      localPtr = (CompiledLocal *) ckalloc((unsigned) 
              (sizeof(CompiledLocal) - sizeof(localPtr->name)
            + nameChars+1));
      if (procPtr->firstLocalPtr == NULL) {
          procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
      } else {
          procPtr->lastLocalPtr->nextPtr = localPtr;
          procPtr->lastLocalPtr = localPtr;
      }
      localPtr->nextPtr = NULL;
      localPtr->nameLength = nameChars;
      localPtr->frameIndex = localIndex;
      localPtr->flags = flagsIfCreated;
      if (name == NULL) {
          localPtr->flags |= VAR_TEMPORARY;
      }
      localPtr->defValuePtr = NULL;
      localPtr->resolveInfo = NULL;
      
      if (name != NULL) {
          memcpy((VOID *) localPtr->name, (VOID *) name, (size_t) nameChars);
      }
      localPtr->name[nameChars] = '\0';
      procPtr->numCompiledLocals++;
    }
    return localIndex;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitCompiledLocals --
 *
 *    This routine is invoked in order to initialize the compiled
 *    locals table for a new call frame.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    May invoke various name resolvers in order to determine which
 *    variables are being referenced at runtime.
 *
 *----------------------------------------------------------------------
 */

void
TclInitCompiledLocals(interp, framePtr, nsPtr)
    Tcl_Interp *interp;       /* Current interpreter. */
    CallFrame *framePtr;      /* Call frame to initialize. */
    Namespace *nsPtr;         /* Pointer to current namespace. */
{
    register CompiledLocal *localPtr;
    Interp *iPtr = (Interp*) interp;
    Tcl_ResolvedVarInfo *vinfo, *resVarInfo;
    Var *varPtr = framePtr->compiledLocals;
    Var *resolvedVarPtr;
    ResolverScheme *resPtr;
    int result;

    /*
     * Initialize the array of local variables stored in the call frame.
     * Some variables may have special resolution rules.  In that case,
     * we call their "resolver" procs to get our hands on the variable,
     * and we make the compiled local a link to the real variable.
     */

    for (localPtr = framePtr->procPtr->firstLocalPtr;
       localPtr != NULL;
       localPtr = localPtr->nextPtr) {

      /*
       * Check to see if this local is affected by namespace or
       * interp resolvers.  The resolver to use is cached for the
       * next invocation of the procedure.
       */

      if (!(localPtr->flags & (VAR_ARGUMENT|VAR_TEMPORARY|VAR_RESOLVED))
            && (nsPtr->compiledVarResProc || iPtr->resolverPtr)) {
          resPtr = iPtr->resolverPtr;

          if (nsPtr->compiledVarResProc) {
            result = (*nsPtr->compiledVarResProc)(nsPtr->interp,
                  localPtr->name, localPtr->nameLength,
                  (Tcl_Namespace *) nsPtr, &vinfo);
          } else {
            result = TCL_CONTINUE;
          }

          while ((result == TCL_CONTINUE) && resPtr) {
            if (resPtr->compiledVarResProc) {
                result = (*resPtr->compiledVarResProc)(nsPtr->interp,
                      localPtr->name, localPtr->nameLength,
                      (Tcl_Namespace *) nsPtr, &vinfo);
            }
            resPtr = resPtr->nextPtr;
          }
          if (result == TCL_OK) {
            localPtr->resolveInfo = vinfo;
            localPtr->flags |= VAR_RESOLVED;
          }
      }

      /*
       * Now invoke the resolvers to determine the exact variables that
       * should be used.
       */

        resVarInfo = localPtr->resolveInfo;
        resolvedVarPtr = NULL;

        if (resVarInfo && resVarInfo->fetchProc) {
            resolvedVarPtr = (Var*) (*resVarInfo->fetchProc)(interp,
                resVarInfo);
        }

        if (resolvedVarPtr) {
          varPtr->name = localPtr->name; /* will be just '\0' if temp var */
          varPtr->nsPtr = NULL;
          varPtr->hPtr = NULL;
          varPtr->refCount = 0;
          varPtr->tracePtr = NULL;
          varPtr->searchPtr = NULL;
          varPtr->flags = 0;
            TclSetVarLink(varPtr);
            varPtr->value.linkPtr = resolvedVarPtr;
            resolvedVarPtr->refCount++;
        } else {
          varPtr->value.objPtr = NULL;
          varPtr->name = localPtr->name; /* will be just '\0' if temp var */
          varPtr->nsPtr = NULL;
          varPtr->hPtr = NULL;
          varPtr->refCount = 0;
          varPtr->tracePtr = NULL;
          varPtr->searchPtr = NULL;
          varPtr->flags = (localPtr->flags | VAR_UNDEFINED);
        }
      varPtr++;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * AdvanceToNextWord --
 *
 *    This procedure is called to skip over any leading white space at the
 *    start of a word. Note that a backslash-newline is treated as a
 *    space.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Updates envPtr->termOffset with the offset of the first
 *    character in "string" that was not white space or a
 *    backslash-newline. This might be the offset of the character that
 *    ends the command: a newline, null, semicolon, or close-bracket.
 *
 *----------------------------------------------------------------------
 */

static void
AdvanceToNextWord(string, envPtr)
    char *string;       /* The source string to compile. */
    CompileEnv *envPtr;       /* Holds resulting instructions. */
{
    register char *src;       /* Points to current source char. */
    register int type;        /* Current char's CHAR_TYPE type. */
    
    src = string;
    type = CHAR_TYPE(src, src+1);
    while (type & (TCL_SPACE | TCL_BACKSLASH)) {
      if (type == TCL_BACKSLASH) {
          if (src[1] == '\n') {
            src += 2;
          } else {
            break;            /* exit loop; no longer white space */
          }
      } else {
          src++;
      }
      type = CHAR_TYPE(src, src+1);
    }
    envPtr->termOffset = (src - string);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Backslash --
 *
 *    Figure out how to handle a backslash sequence.
 *
 * Results:
 *    The return value is the character that should be substituted
 *    in place of the backslash sequence that starts at src.  If
 *    readPtr isn't NULL then it is filled in with a count of the
 *    number of characters in the backslash sequence.
 *
 * Side effects:
 *    None.
 *
 *----------------------------------------------------------------------
 */

char
Tcl_Backslash(src, readPtr)
    CONST char *src;          /* Points to the backslash character of
                         * a backslash sequence. */
    int *readPtr;       /* Fill in with number of characters read
                         * from src, unless NULL. */
{
    CONST char *p = src + 1;
    char result;
    int count;

    count = 2;

    switch (*p) {
      /*
         * Note: in the conversions below, use absolute values (e.g.,
         * 0xa) rather than symbolic values (e.g. \n) that get converted
         * by the compiler.  It's possible that compilers on some
         * platforms will do the symbolic conversions differently, which
         * could result in non-portable Tcl scripts.
         */

        case 'a':
            result = 0x7;
            break;
        case 'b':
            result = 0x8;
            break;
        case 'f':
            result = 0xc;
            break;
        case 'n':
            result = 0xa;
            break;
        case 'r':
            result = 0xd;
            break;
        case 't':
            result = 0x9;
            break;
        case 'v':
            result = 0xb;
            break;
        case 'x':
            if (isxdigit(UCHAR(p[1]))) {
                char *end;

                result = (char) strtoul(p+1, &end, 16);
                count = end - src;
            } else {
                count = 2;
                result = 'x';
            }
            break;
        case '\n':
            do {
                p++;
            } while ((*p == ' ') || (*p == '\t'));
            result = ' ';
            count = p - src;
            break;
        case 0:
            result = '\\';
            count = 1;
            break;
      default:
          if (isdigit(UCHAR(*p))) {
            result = (char)(*p - '0');
            p++;
            if (!isdigit(UCHAR(*p))) {
                break;
            }
            count = 3;
            result = (char)((result << 3) + (*p - '0'));
            p++;
            if (!isdigit(UCHAR(*p))) {
                break;
            }
            count = 4;
            result = (char)((result << 3) + (*p - '0'));
            break;
          }
          result = *p;
          count = 2;
          break;
    }

    if (readPtr != NULL) {
      *readPtr = count;
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclObjIndexForString --
 *
 *    Procedure to find, or if necessary create, an object in a
 *    CompileEnv's object array that has a string representation
 *    matching the argument string.
 *
 * Results:
 *    The index in the CompileEnv's object array of an object with a
 *    string representation matching the argument "string". The object is
 *    created if necessary. If inHeap is 1, then string is heap allocated
 *    and ownership of the string is passed to TclObjIndexForString;
 *    otherwise, the string is owned by the caller and must not be
 *    modified or freed by TclObjIndexForString. Typically, a caller sets
 *    inHeap 1 if string is an already heap-allocated buffer holding the
 *    result of backslash substitutions.
 *
 * Side effects:
 *    A new Tcl object will be created if no existing object matches the
 *    input string. If allocStrRep is 1 then if a new object is created,
 *    its string representation is allocated in the heap, else it is left
 *    NULL. If inHeap is 1, this procedure is given ownership of the
 *    string: if an object is created and allocStrRep is 1 then its
 *    string representation is set directly from string, otherwise
 *    the string is freed.
#ifdef KANJI
 *    And, envPtr->lastScannedKanjiCode is initialized to TCL_NOT_SCANNED 
 *    for next calling of this function.
#endif
 *
 *----------------------------------------------------------------------
 */

int
TclObjIndexForString(string, length, allocStrRep, inHeap, envPtr)
    register char *string;    /* Points to string for which an object is
                         * found or created in CompileEnv's object
                         * array. */
    int length;               /* Length of string. */
    int allocStrRep;          /* If 1 then the object's string rep should
                         * be allocated in the heap. */
    int inHeap;               /* If 1 then string is heap allocated and
                         * its ownership is passed to
                         * TclObjIndexForString. */
    CompileEnv *envPtr;       /* Points to the CompileEnv in whose object
                         * array an object is found or created. */
{
    register Tcl_Obj *objPtr; /* Points to the object created for
                         * the string, if one was created. */
    int objIndex;       /* Index of matching object. */
    Tcl_HashEntry *hPtr;
    int strLength, new;
#ifdef KANJI
    int lastScannedKanjiCode = envPtr->lastScannedKanjiCode;
    
    /*
     * First, reset last scanned kanji code for further source scanning.
     */
    envPtr->lastScannedKanjiCode = TCL_NOT_SCANNED;
#endif /* KANJI */
    /*
     * Look up the string in the code's object hashtable. If found, just
     * return the associated object array index.  Note that if the string
     * has embedded nulls, we don't create a hash table entry.  This
     * should be fixed, but we need to update hash tables, first.
     */

    strLength = strlen(string);
    if (length == -1) {
      length = strLength;
    }
    if (strLength != length) {
      hPtr = NULL;
    } else {
      hPtr = Tcl_CreateHashEntry(&envPtr->objTable, string, &new);
      if (!new) {       /* already in object table and array */
          objIndex = (int) Tcl_GetHashValue(hPtr);
          if (inHeap) {
            ckfree(string);
          }
          return objIndex;
      }
    }    

    /*
     * Create a new object holding the string, add it to the object array,
     * and register its index in the object hashtable.
     */

    objPtr = Tcl_NewObj();
    if (allocStrRep) {
#ifdef KANJI
        if ((length > 1) && 
            (envPtr->iPtr->kanjiConvertWhenCompile != 0) &&
          (envPtr->iPtr->kanjiCode != TCL_ANY) &&
          (lastScannedKanjiCode != TCL_ANY) &&
          (lastScannedKanjiCode != envPtr->iPtr->kanjiCode)) {
          char *newStr;
          int nLen;
          wchar *wTmp;
          
          if (lastScannedKanjiCode == TCL_NOT_SCANNED) {
            (void) Tcl_KanjiString(NULL, string, NULL, &lastScannedKanjiCode);
            if (lastScannedKanjiCode == TCL_ANY ||
                lastScannedKanjiCode == TCL_NOT_KANJI ||
                lastScannedKanjiCode == envPtr->iPtr->kanjiCode) {
                goto noConv;
            }
          }

          nLen = Tcl_KanjiEncode(lastScannedKanjiCode, string, NULL);
          wTmp = (wchar *)ckalloc(sizeof(wchar) * (nLen + 1));
          (void) Tcl_KanjiEncode(lastScannedKanjiCode, string, wTmp);
          nLen = Tcl_KanjiDecode(envPtr->iPtr->kanjiCode, wTmp, NULL);
          newStr = (char *)ckalloc(sizeof(char) * (nLen + 1));
          (void) Tcl_KanjiDecode(envPtr->iPtr->kanjiCode, wTmp, newStr);
          ckfree((char *)wTmp);

          if (inHeap) {
            ckfree(string);
          }
          objPtr->bytes = newStr;
          objPtr->length = nLen;
        } else {
          noConv:
          if (inHeap) { /* use input string for obj's string rep */
            objPtr->bytes = string;
          } else {            /* must allocate string rep */
            if (length > 0) {
                objPtr->bytes = ckalloc((unsigned) length + 1);
                memcpy(objPtr->bytes, string, (size_t) length);
                objPtr->bytes[length] = '\0';
            }
          }
          objPtr->length = length;
        }
#else
      if (inHeap) {           /* use input string for obj's string rep */
          objPtr->bytes = string;
      } else {
          if (length > 0) {
            objPtr->bytes = ckalloc((unsigned) length + 1);
            memcpy((VOID *) objPtr->bytes, (VOID *) string,
                  (size_t) length);
            objPtr->bytes[length] = '\0';
          }
      }
      objPtr->length = length;
#endif /* KANJI */
    } else {                  /* leave the string rep NULL */
      if (inHeap) {
          ckfree(string);
      }
    }

    if (envPtr->objArrayNext >= envPtr->objArrayEnd) {
        ExpandObjectArray(envPtr);
    }
    objIndex = envPtr->objArrayNext;
    envPtr->objArrayPtr[objIndex] = objPtr;
    Tcl_IncrRefCount(objPtr);
    envPtr->objArrayNext++;

    if (hPtr) {
      Tcl_SetHashValue(hPtr, objIndex);
    }
    return objIndex;
}

/*
 *----------------------------------------------------------------------
 *
 * TclExpandCodeArray --
 *
 *    Procedure that uses malloc to allocate more storage for a
 *    CompileEnv's code array.
 *
 * Results:
 *    None. 
 *
 * Side effects:
 *    The byte code array in *envPtr is reallocated to a new array of
 *    double the size, and if envPtr->mallocedCodeArray is non-zero the
 *    old array is freed. Byte codes are copied from the old array to the
 *    new one.
 *
 *----------------------------------------------------------------------
 */

void
TclExpandCodeArray(envPtr)
    CompileEnv *envPtr;       /* Points to the CompileEnv whose code array
                         * must be enlarged. */
{
    /*
     * envPtr->codeNext is equal to envPtr->codeEnd. The currently defined
     * code bytes are stored between envPtr->codeStart and
     * (envPtr->codeNext - 1) [inclusive].
     */
    
    size_t currBytes = TclCurrCodeOffset();
    size_t newBytes  = 2*(envPtr->codeEnd  - envPtr->codeStart);
    unsigned char *newPtr = (unsigned char *) ckalloc((unsigned) newBytes);

    /*
     * Copy from old code array to new, free old code array if needed, and
     * mark new code array as malloced.
     */
 
    memcpy((VOID *) newPtr, (VOID *) envPtr->codeStart, currBytes);
    if (envPtr->mallocedCodeArray) {
        ckfree((char *) envPtr->codeStart);
    }
    envPtr->codeStart = newPtr;
    envPtr->codeNext = (newPtr + currBytes);
    envPtr->codeEnd  = (newPtr + newBytes);
    envPtr->mallocedCodeArray = 1;
}

/*
 *----------------------------------------------------------------------
 *
 * ExpandObjectArray --
 *
 *    Procedure that uses malloc to allocate more storage for a
 *    CompileEnv's object array.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    The object array in *envPtr is reallocated to a new array of
 *    double the size, and if envPtr->mallocedObjArray is non-zero the
 *    old array is freed. Tcl_Obj pointers are copied from the old array
 *    to the new one.
 *
 *----------------------------------------------------------------------
 */

static void
ExpandObjectArray(envPtr)
    CompileEnv *envPtr;       /* Points to the CompileEnv whose object
                         * array must be enlarged. */
{
    /*
     * envPtr->objArrayNext is equal to envPtr->objArrayEnd. The currently
     * allocated Tcl_Obj pointers are stored between elements
     * 0 and (envPtr->objArrayNext - 1) [inclusive] in the object array
     * pointed to by objArrayPtr.
     */

    size_t currBytes = envPtr->objArrayNext * sizeof(Tcl_Obj *);
    int newElems = 2*envPtr->objArrayEnd;
    size_t newBytes = newElems * sizeof(Tcl_Obj *);
    Tcl_Obj **newPtr = (Tcl_Obj **) ckalloc((unsigned) newBytes);

    /*
     * Copy from old object array to new, free old object array if needed,
     * and mark new object array as malloced.
     */
 
    memcpy((VOID *) newPtr, (VOID *) envPtr->objArrayPtr, currBytes);
    if (envPtr->mallocedObjArray) {
      ckfree((char *) envPtr->objArrayPtr);
    }
    envPtr->objArrayPtr = (Tcl_Obj **) newPtr;
    envPtr->objArrayEnd = newElems;
    envPtr->mallocedObjArray = 1;
}

/*
 *----------------------------------------------------------------------
 *
 * EnterCmdStartData --
 *
 *    Registers the starting source and bytecode location of a
 *    command. This information is used at runtime to map between
 *    instruction pc and source locations.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Inserts source and code location information into the compilation
 *    environment envPtr for the command at index cmdIndex. The
 *    compilation environment's CmdLocation array is grown if necessary.
 *
 *----------------------------------------------------------------------
 */

static void
EnterCmdStartData(envPtr, cmdIndex, srcOffset, codeOffset)
    CompileEnv *envPtr;       /* Points to the compilation environment
                         * structure in which to enter command
                         * location information. */
    int cmdIndex;       /* Index of the command whose start data
                         * is being set. */
    int srcOffset;            /* Offset of first char of the command. */
    int codeOffset;           /* Offset of first byte of command code. */
{
    CmdLocation *cmdLocPtr;
    
    if ((cmdIndex < 0) || (cmdIndex >= envPtr->numCommands)) {
      panic("EnterCmdStartData: bad command index %d\n", cmdIndex);
    }
    
    if (cmdIndex >= envPtr->cmdMapEnd) {
      /*
       * Expand the command location array by allocating more storage from
       * the heap. The currently allocated CmdLocation entries are stored
       * from cmdMapPtr[0] up to cmdMapPtr[envPtr->cmdMapEnd] (inclusive).
       */

      size_t currElems = envPtr->cmdMapEnd;
      size_t newElems  = 2*currElems;
      size_t currBytes = currElems * sizeof(CmdLocation);
      size_t newBytes  = newElems  * sizeof(CmdLocation);
      CmdLocation *newPtr = (CmdLocation *) ckalloc((unsigned) newBytes);
      
      /*
       * Copy from old command location array to new, free old command
       * location array if needed, and mark new array as malloced.
       */
      
      memcpy((VOID *) newPtr, (VOID *) envPtr->cmdMapPtr, currBytes);
      if (envPtr->mallocedCmdMap) {
          ckfree((char *) envPtr->cmdMapPtr);
      }
      envPtr->cmdMapPtr = (CmdLocation *) newPtr;
      envPtr->cmdMapEnd = newElems;
      envPtr->mallocedCmdMap = 1;
    }

    if (cmdIndex > 0) {
      if (codeOffset < envPtr->cmdMapPtr[cmdIndex-1].codeOffset) {
          panic("EnterCmdStartData: cmd map table not sorted by code offset");
      }
    }

    cmdLocPtr = &(envPtr->cmdMapPtr[cmdIndex]);
    cmdLocPtr->codeOffset = codeOffset;
    cmdLocPtr->srcOffset = srcOffset;
    cmdLocPtr->numSrcChars = -1;
    cmdLocPtr->numCodeBytes = -1;
}

/*
 *----------------------------------------------------------------------
 *
 * EnterCmdExtentData --
 *
 *    Registers the source and bytecode length for a command. This
 *    information is used at runtime to map between instruction pc and
 *    source locations.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Inserts source and code length information into the compilation
 *    environment envPtr for the command at index cmdIndex. Starting
 *    source and bytecode information for the command must already
 *    have been registered.
 *
 *----------------------------------------------------------------------
 */

static void
EnterCmdExtentData(envPtr, cmdIndex, numSrcChars, numCodeBytes)
    CompileEnv *envPtr;       /* Points to the compilation environment
                         * structure in which to enter command
                         * location information. */
    int cmdIndex;       /* Index of the command whose source and
                         * code length data is being set. */
    int numSrcChars;          /* Number of command source chars. */
    int numCodeBytes;         /* Offset of last byte of command code. */
{
    CmdLocation *cmdLocPtr;

    if ((cmdIndex < 0) || (cmdIndex >= envPtr->numCommands)) {
      panic("EnterCmdStartData: bad command index %d\n", cmdIndex);
    }
    
    if (cmdIndex > envPtr->cmdMapEnd) {
      panic("EnterCmdStartData: no start data registered for command with index %d\n", cmdIndex);
    }

    cmdLocPtr = &(envPtr->cmdMapPtr[cmdIndex]);
    cmdLocPtr->numSrcChars = numSrcChars;
    cmdLocPtr->numCodeBytes = numCodeBytes;
}

/*
 *----------------------------------------------------------------------
 *
 * InitArgInfo --
 *
 *    Initializes a ArgInfo structure to hold information about
 *    some number of argument words in a command.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    The ArgInfo structure is initialized.
 *
 *----------------------------------------------------------------------
 */

static void
InitArgInfo(argInfoPtr)
    register ArgInfo *argInfoPtr; /* Points to the ArgInfo structure
                           * to initialize. */
{
    argInfoPtr->numArgs = 0;
    argInfoPtr->startArray = argInfoPtr->staticStartSpace;
    argInfoPtr->endArray   = argInfoPtr->staticEndSpace;
    argInfoPtr->allocArgs = ARGINFO_INIT_ENTRIES;
    argInfoPtr->mallocedArrays = 0;
}

/*
 *----------------------------------------------------------------------
 *
 * CollectArgInfo --
 *
 *    Procedure to scan the argument words of a command and record the
 *    start and finish of each argument word in a ArgInfo structure.
 *
 * Results:
 *    The return value is a standard Tcl result, which is TCL_OK unless
 *    there was an error while scanning string. If an error occurs then
 *    the interpreter's result contains a standard error message.
 *
 * Side effects:
 *    If necessary, the argument start and end arrays in *argInfoPtr
 *    are grown and reallocated to a new arrays of double the size, and
 *    if argInfoPtr->mallocedArray is non-zero the old arrays are freed.
 *
 *----------------------------------------------------------------------
 */

static int
CollectArgInfo(interp, string, lastChar, flags, argInfoPtr)
    Tcl_Interp *interp;         /* Used for error reporting. */
    char *string;               /* The source command string to scan. */
    char *lastChar;            /* Pointer to terminating character of
                          * string. */
    int flags;                  /* Flags to control compilation (same as
                                 * passed to Tcl_Eval). */
    register ArgInfo *argInfoPtr;
                        /* Points to the ArgInfo structure in which
                         * to record the arg word information. */
{
    register char *src = string;/* Points to current source char. */
    register int type;        /* Current char's CHAR_TYPE type. */
    int nestedCmd = (flags & TCL_BRACKET_TERM);
                                /* 1 if string being scanned is a nested
                         * command and is terminated by a ']';
                         * otherwise 0. */
    int scanningArgs;           /* 1 if still scanning argument words to
                         * determine their start and end. */
    char *wordStart, *wordEnd;  /* Points to the first and last significant
                         * characters of each word. */
    CompileEnv tempCompEnv;   /* Only used to hold the termOffset field
                         * updated by AdvanceToNextWord. */
    char *prev;

    argInfoPtr->numArgs = 0;
    scanningArgs = 1;
    while (scanningArgs) {
      AdvanceToNextWord(src, &tempCompEnv);
      src += tempCompEnv.termOffset;
      type = CHAR_TYPE(src, lastChar);

      if ((type == TCL_COMMAND_END) && ((*src != ']') || nestedCmd)) {
          break;            /* done collecting argument words */
      } else if (*src == '"') {
          wordStart = src;
          src = TclWordEnd(src, lastChar, nestedCmd, NULL);
          if (src == lastChar) {
              badStringTermination:
            Tcl_ResetResult(interp);
            Tcl_AppendToObj(Tcl_GetObjResult(interp),
                      "quoted string doesn't terminate properly", -1);
            return TCL_ERROR;
          }
          prev = (src-1);
          if (*src == '"') {
            wordEnd = src;
            src++;
          } else if ((*src == ';') && (*prev == '"')) {
            scanningArgs = 0;
            wordEnd = prev;
          } else {
            goto badStringTermination;
          }
      } else if (*src == '{') {
          wordStart = src;
          src = TclWordEnd(src, lastChar, nestedCmd, NULL);
          if (src == lastChar) {
            Tcl_ResetResult(interp);
            Tcl_AppendToObj(Tcl_GetObjResult(interp),
                    "missing close-brace", -1);
            return TCL_ERROR;
          }
          prev = (src-1);
          if (*src == '}') {
            wordEnd = src;
            src++;
          } else if ((*src == ';') && (*prev == '}')) {
            scanningArgs = 0;
            wordEnd = prev;
          } else {
            Tcl_ResetResult(interp);
            Tcl_AppendToObj(Tcl_GetObjResult(interp),
                      "argument word in braces doesn't terminate properly", -1);
            return TCL_ERROR;
          }
      } else {
          wordStart = src;
          src = TclWordEnd(src, lastChar, nestedCmd, NULL);
          prev = (src-1);
          if (src == lastChar) {
            Tcl_ResetResult(interp);
            Tcl_AppendToObj(Tcl_GetObjResult(interp),
                    "missing close-bracket or close-brace", -1);
            return TCL_ERROR;
          } else if (*src == ';') {
            scanningArgs = 0;
            wordEnd = prev;
          } else {
            wordEnd = src;
            src++;
            if ((src == lastChar) || (*src == '\n')
                      || ((*src == ']') && nestedCmd)) {
                scanningArgs = 0;
            }
          }
      } /* end of test on each kind of word */

      if (argInfoPtr->numArgs == argInfoPtr->allocArgs) {
          int newArgs = 2*argInfoPtr->numArgs;
          size_t currBytes = argInfoPtr->numArgs * sizeof(char *);
          size_t newBytes  = newArgs * sizeof(char *);
          char **newStartArrayPtr =
                (char **) ckalloc((unsigned) newBytes);
          char **newEndArrayPtr =
                (char **) ckalloc((unsigned) newBytes);
          
          /*
           * Copy from the old arrays to the new, free the old arrays if
           * needed, and mark the new arrays as malloc'ed.
           */
          
          memcpy((VOID *) newStartArrayPtr,
                  (VOID *) argInfoPtr->startArray, currBytes);
          memcpy((VOID *) newEndArrayPtr,
                (VOID *) argInfoPtr->endArray, currBytes);
          if (argInfoPtr->mallocedArrays) {
            ckfree((char *) argInfoPtr->startArray);
            ckfree((char *) argInfoPtr->endArray);
          }
          argInfoPtr->startArray = newStartArrayPtr;
          argInfoPtr->endArray   = newEndArrayPtr;
          argInfoPtr->allocArgs = newArgs;
          argInfoPtr->mallocedArrays = 1;
      }
      argInfoPtr->startArray[argInfoPtr->numArgs] = wordStart;
      argInfoPtr->endArray[argInfoPtr->numArgs]   = wordEnd;
      argInfoPtr->numArgs++;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * FreeArgInfo --
 *
 *    Free any storage allocated in a ArgInfo structure.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Allocated storage in the ArgInfo structure is freed.
 *
 *----------------------------------------------------------------------
 */

static void
FreeArgInfo(argInfoPtr)
    register ArgInfo *argInfoPtr; /* Points to the ArgInfo structure
                           * to free. */
{
    if (argInfoPtr->mallocedArrays) {
      ckfree((char *) argInfoPtr->startArray);
      ckfree((char *) argInfoPtr->endArray);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * CreateExceptionRange --
 *
 *    Procedure that allocates and initializes a new ExceptionRange
 *    structure of the specified kind in a CompileEnv's ExceptionRange
 *    array.
 *
 * Results:
 *    Returns the index for the newly created ExceptionRange.
 *
 * Side effects:
 *    If there is not enough room in the CompileEnv's ExceptionRange
 *    array, the array in expanded: a new array of double the size is
 *    allocated, if envPtr->mallocedExcRangeArray is non-zero the old
 *    array is freed, and ExceptionRange entries are copied from the old
 *    array to the new one.
 *
 *----------------------------------------------------------------------
 */

static int
CreateExceptionRange(type, envPtr)
    ExceptionRangeType type;  /* The kind of ExceptionRange desired. */
    register CompileEnv *envPtr;/* Points to the CompileEnv for which a new
                         * loop ExceptionRange structure is to be
                         * allocated. */
{
    int index;                /* Index for the newly-allocated
                         * ExceptionRange structure. */
    register ExceptionRange *rangePtr;
                        /* Points to the new ExceptionRange
                         * structure */
    
    index = envPtr->excRangeArrayNext;
    if (index >= envPtr->excRangeArrayEnd) {
        /*
       * Expand the ExceptionRange array. The currently allocated entries
       * are stored between elements 0 and (envPtr->excRangeArrayNext - 1)
       * [inclusive].
       */
      
      size_t currBytes =
              envPtr->excRangeArrayNext * sizeof(ExceptionRange);
      int newElems = 2*envPtr->excRangeArrayEnd;
      size_t newBytes = newElems * sizeof(ExceptionRange);
      ExceptionRange *newPtr = (ExceptionRange *)
              ckalloc((unsigned) newBytes);
      
      /*
       * Copy from old ExceptionRange array to new, free old
       * ExceptionRange array if needed, and mark the new ExceptionRange
       * array as malloced.
       */
      
      memcpy((VOID *) newPtr, (VOID *) envPtr->excRangeArrayPtr,
              currBytes);
      if (envPtr->mallocedExcRangeArray) {
          ckfree((char *) envPtr->excRangeArrayPtr);
      }
      envPtr->excRangeArrayPtr = (ExceptionRange *) newPtr;
      envPtr->excRangeArrayEnd = newElems;
      envPtr->mallocedExcRangeArray = 1;
    }
    envPtr->excRangeArrayNext++;
    
    rangePtr = &(envPtr->excRangeArrayPtr[index]);
    rangePtr->type = type;
    rangePtr->nestingLevel = envPtr->excRangeDepth;
    rangePtr->codeOffset = -1;
    rangePtr->numCodeBytes = -1;
    rangePtr->breakOffset = -1;
    rangePtr->continueOffset = -1;
    rangePtr->catchOffset = -1;
    return index;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCreateAuxData --
 *
 *    Procedure that allocates and initializes a new AuxData structure in
 *    a CompileEnv's array of compilation auxiliary data records. These
 *    AuxData records hold information created during compilation by
 *    CompileProcs and used by instructions during execution.
 *
 * Results:
 *    Returns the index for the newly created AuxData structure.
 *
 * Side effects:
 *    If there is not enough room in the CompileEnv's AuxData array,
 *    the AuxData array in expanded: a new array of double the size
 *    is allocated, if envPtr->mallocedAuxDataArray is non-zero
 *    the old array is freed, and AuxData entries are copied from
 *    the old array to the new one.
 *
 *----------------------------------------------------------------------
 */

int
TclCreateAuxData(clientData, typePtr, envPtr)
    ClientData clientData;    /* The compilation auxiliary data to store
                             * in the new aux data record. */
    AuxDataType *typePtr;     /* Pointer to the type to attach to this AuxData */
    register CompileEnv *envPtr;/* Points to the CompileEnv for which a new
                                 * aux data structure is to be allocated. */
{
    int index;                /* Index for the new AuxData structure. */
    register AuxData *auxDataPtr;
                        /* Points to the new AuxData structure */
    
    index = envPtr->auxDataArrayNext;
    if (index >= envPtr->auxDataArrayEnd) {
        /*
       * Expand the AuxData array. The currently allocated entries are
       * stored between elements 0 and (envPtr->auxDataArrayNext - 1)
       * [inclusive].
       */
      
      size_t currBytes = envPtr->auxDataArrayNext * sizeof(AuxData);
      int newElems = 2*envPtr->auxDataArrayEnd;
      size_t newBytes = newElems * sizeof(AuxData);
      AuxData *newPtr = (AuxData *) ckalloc((unsigned) newBytes);
      
      /*
       * Copy from old AuxData array to new, free old AuxData array if
       * needed, and mark the new AuxData array as malloced.
       */
      
      memcpy((VOID *) newPtr, (VOID *) envPtr->auxDataArrayPtr,
              currBytes);
      if (envPtr->mallocedAuxDataArray) {
          ckfree((char *) envPtr->auxDataArrayPtr);
      }
      envPtr->auxDataArrayPtr = newPtr;
      envPtr->auxDataArrayEnd = newElems;
      envPtr->mallocedAuxDataArray = 1;
    }
    envPtr->auxDataArrayNext++;
    
    auxDataPtr = &(envPtr->auxDataArrayPtr[index]);
    auxDataPtr->type = typePtr;
    auxDataPtr->clientData = clientData;
    return index;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitJumpFixupArray --
 *
 *    Initializes a JumpFixupArray structure to hold some number of
 *    jump fixup entries.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    The JumpFixupArray structure is initialized.
 *
 *----------------------------------------------------------------------
 */

void
TclInitJumpFixupArray(fixupArrayPtr)
    register JumpFixupArray *fixupArrayPtr;
                         /* Points to the JumpFixupArray structure
                          * to initialize. */
{
    fixupArrayPtr->fixup = fixupArrayPtr->staticFixupSpace;
    fixupArrayPtr->next = 0;
    fixupArrayPtr->end = (JUMPFIXUP_INIT_ENTRIES - 1);
    fixupArrayPtr->mallocedArray = 0;
}

/*
 *----------------------------------------------------------------------
 *
 * TclExpandJumpFixupArray --
 *
 *    Procedure that uses malloc to allocate more storage for a
 *      jump fixup array.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    The jump fixup array in *fixupArrayPtr is reallocated to a new array
 *    of double the size, and if fixupArrayPtr->mallocedArray is non-zero
 *    the old array is freed. Jump fixup structures are copied from the
 *    old array to the new one.
 *
 *----------------------------------------------------------------------
 */

void
TclExpandJumpFixupArray(fixupArrayPtr)
    register JumpFixupArray *fixupArrayPtr;
                         /* Points to the JumpFixupArray structure
                          * to enlarge. */
{
    /*
     * The currently allocated jump fixup entries are stored from fixup[0]
     * up to fixup[fixupArrayPtr->fixupNext] (*not* inclusive). We assume
     * fixupArrayPtr->fixupNext is equal to fixupArrayPtr->fixupEnd.
     */

    size_t currBytes = fixupArrayPtr->next * sizeof(JumpFixup);
    int newElems = 2*(fixupArrayPtr->end + 1);
    size_t newBytes = newElems * sizeof(JumpFixup);
    JumpFixup *newPtr = (JumpFixup *) ckalloc((unsigned) newBytes);

    /*
     * Copy from the old array to new, free the old array if needed,
     * and mark the new array as malloced.
     */
 
    memcpy((VOID *) newPtr, (VOID *) fixupArrayPtr->fixup, currBytes);
    if (fixupArrayPtr->mallocedArray) {
      ckfree((char *) fixupArrayPtr->fixup);
    }
    fixupArrayPtr->fixup = (JumpFixup *) newPtr;
    fixupArrayPtr->end = newElems;
    fixupArrayPtr->mallocedArray = 1;
}

/*
 *----------------------------------------------------------------------
 *
 * TclFreeJumpFixupArray --
 *
 *    Free any storage allocated in a jump fixup array structure.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Allocated storage in the JumpFixupArray structure is freed.
 *
 *----------------------------------------------------------------------
 */

void
TclFreeJumpFixupArray(fixupArrayPtr)
    register JumpFixupArray *fixupArrayPtr;
                         /* Points to the JumpFixupArray structure
                          * to free. */
{
    if (fixupArrayPtr->mallocedArray) {
      ckfree((char *) fixupArrayPtr->fixup);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclEmitForwardJump --
 *
 *    Procedure to emit a two-byte forward jump of kind "jumpType". Since
 *    the jump may later have to be grown to five bytes if the jump target
 *    is more than, say, 127 bytes away, this procedure also initializes a
 *    JumpFixup record with information about the jump. 
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    The JumpFixup record pointed to by "jumpFixupPtr" is initialized
 *    with information needed later if the jump is to be grown. Also,
 *    a two byte jump of the designated type is emitted at the current
 *    point in the bytecode stream.
 *
 *----------------------------------------------------------------------
 */

void
TclEmitForwardJump(envPtr, jumpType, jumpFixupPtr)
    CompileEnv *envPtr;       /* Points to the CompileEnv structure that
                         * holds the resulting instruction. */
    TclJumpType jumpType;     /* Indicates the kind of jump: if true or
                         * false or unconditional. */
    JumpFixup *jumpFixupPtr;  /* Points to the JumpFixup structure to
                         * initialize with information about this
                         * forward jump. */
{
    /*
     * Initialize the JumpFixup structure:
     *    - codeOffset is offset of first byte of jump below
     *    - cmdIndex is index of the command after the current one
     *    - excRangeIndex is the index of the first ExceptionRange after
     *      the current one.
     */
    
    jumpFixupPtr->jumpType = jumpType;
    jumpFixupPtr->codeOffset = TclCurrCodeOffset();
    jumpFixupPtr->cmdIndex = envPtr->numCommands;
    jumpFixupPtr->excRangeIndex = envPtr->excRangeArrayNext;
    
    switch (jumpType) {
    case TCL_UNCONDITIONAL_JUMP:
      TclEmitInstInt1(INST_JUMP1, /*offset*/ 0, envPtr);
      break;
    case TCL_TRUE_JUMP:
      TclEmitInstInt1(INST_JUMP_TRUE1, /*offset*/ 0, envPtr);
      break;
    default:
      TclEmitInstInt1(INST_JUMP_FALSE1, /*offset*/ 0, envPtr);
      break;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclFixupForwardJump --
 *
 *    Procedure that updates a previously-emitted forward jump to jump
 *    a specified number of bytes, "jumpDist". If necessary, the jump is
 *      grown from two to five bytes; this is done if the jump distance is
 *    greater than "distThreshold" (normally 127 bytes). The jump is
 *    described by a JumpFixup record previously initialized by
 *    TclEmitForwardJump.
 *
 * Results:
 *    1 if the jump was grown and subsequent instructions had to be moved;
 *    otherwise 0. This result is returned to allow callers to update
 *    any additional code offsets they may hold.
 *
 * Side effects:
 *    The jump may be grown and subsequent instructions moved. If this
 *    happens, the code offsets for any commands and any ExceptionRange
 *    records     between the jump and the current code address will be
 *    updated to reflect the moved code. Also, the bytecode instruction
 *    array in the CompileEnv structure may be grown and reallocated.
 *
 *----------------------------------------------------------------------
 */

int
TclFixupForwardJump(envPtr, jumpFixupPtr, jumpDist, distThreshold)
    CompileEnv *envPtr;       /* Points to the CompileEnv structure that
                         * holds the resulting instruction. */
    JumpFixup *jumpFixupPtr;    /* Points to the JumpFixup structure that
                         * describes the forward jump. */
    int jumpDist;       /* Jump distance to set in jump
                         * instruction. */
    int distThreshold;        /* Maximum distance before the two byte
                         * jump is grown to five bytes. */
{
    unsigned char *jumpPc, *p;
    int firstCmd, lastCmd, firstRange, lastRange, k;
    unsigned int numBytes;
    
    if (jumpDist <= distThreshold) {
      jumpPc = (envPtr->codeStart + jumpFixupPtr->codeOffset);
      switch (jumpFixupPtr->jumpType) {
      case TCL_UNCONDITIONAL_JUMP:
          TclUpdateInstInt1AtPc(INST_JUMP1, jumpDist, jumpPc);
          break;
      case TCL_TRUE_JUMP:
          TclUpdateInstInt1AtPc(INST_JUMP_TRUE1, jumpDist, jumpPc);
          break;
      default:
          TclUpdateInstInt1AtPc(INST_JUMP_FALSE1, jumpDist, jumpPc);
          break;
      }
      return 0;
    }

    /*
     * We must grow the jump then move subsequent instructions down.
     */
    
    TclEnsureCodeSpace(3, envPtr);  /* NB: might change code addresses! */
    jumpPc = (envPtr->codeStart + jumpFixupPtr->codeOffset);
    for (numBytes = envPtr->codeNext-jumpPc-2, p = jumpPc+2+numBytes-1;
          numBytes > 0;  numBytes--, p--) {
      p[3] = p[0];
    }
    envPtr->codeNext += 3;
    jumpDist += 3;
    switch (jumpFixupPtr->jumpType) {
    case TCL_UNCONDITIONAL_JUMP:
      TclUpdateInstInt4AtPc(INST_JUMP4, jumpDist, jumpPc);
      break;
    case TCL_TRUE_JUMP:
      TclUpdateInstInt4AtPc(INST_JUMP_TRUE4, jumpDist, jumpPc);
      break;
    default:
      TclUpdateInstInt4AtPc(INST_JUMP_FALSE4, jumpDist, jumpPc);
      break;
    }
    
    /*
     * Adjust the code offsets for any commands and any ExceptionRange
     * records between the jump and the current code address.
     */
    
    firstCmd = jumpFixupPtr->cmdIndex;
    lastCmd  = (envPtr->numCommands - 1);
    if (firstCmd < lastCmd) {
      for (k = firstCmd;  k <= lastCmd;  k++) {
          (envPtr->cmdMapPtr[k]).codeOffset += 3;
      }
    }
    
    firstRange = jumpFixupPtr->excRangeIndex;
    lastRange  = (envPtr->excRangeArrayNext - 1);
    for (k = firstRange;  k <= lastRange;  k++) {
      ExceptionRange *rangePtr = &(envPtr->excRangeArrayPtr[k]);
      rangePtr->codeOffset += 3;
      
      switch (rangePtr->type) {
      case LOOP_EXCEPTION_RANGE:
          rangePtr->breakOffset += 3;
          if (rangePtr->continueOffset != -1) {
            rangePtr->continueOffset += 3;
          }
          break;
      case CATCH_EXCEPTION_RANGE:
          rangePtr->catchOffset += 3;
          break;
      default:
          panic("TclFixupForwardJump: unrecognized ExceptionRange type %d\n", rangePtr->type);
      }
    }
    return 1;                 /* the jump was grown */
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetInstructionTable --
 *
 *  Returns a pointer to the table describing Tcl bytecode instructions.
 *  This procedure is defined so that clients can access the pointer from
 *  outside the TCL DLLs.
 *
 * Results:
 *    Returns a pointer to the global instruction table, same as the expression
 *  (&instructionTable[0]).
 *
 * Side effects:
 *    None.
 *
 *----------------------------------------------------------------------
 */

InstructionDesc *
TclGetInstructionTable()
{
    return &instructionTable[0];
}

/*
 *--------------------------------------------------------------
 *
 * TclRegisterAuxDataType --
 *
 *    This procedure is called to register a new AuxData type
 *    in the table of all AuxData types supported by Tcl.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    The type is registered in the AuxData type table. If there was already
 *    a type with the same name as in typePtr, it is replaced with the
 *    new type.
 *
 *--------------------------------------------------------------
 */

void
TclRegisterAuxDataType(typePtr)
    AuxDataType *typePtr;     /* Information about object type;
                             * storage must be statically
                             * allocated (must live forever). */
{
    register Tcl_HashEntry *hPtr;
    int new;

    if (!auxDataTypeTableInitialized) {
        TclInitAuxDataTypeTable();
    }

    /*
     * If there's already a type with the given name, remove it.
     */

    hPtr = Tcl_FindHashEntry(&auxDataTypeTable, typePtr->name);
    if (hPtr != (Tcl_HashEntry *) NULL) {
        Tcl_DeleteHashEntry(hPtr);
    }

    /*
     * Now insert the new object type.
     */

    hPtr = Tcl_CreateHashEntry(&auxDataTypeTable, typePtr->name, &new);
    if (new) {
        Tcl_SetHashValue(hPtr, typePtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetAuxDataType --
 *
 *    This procedure looks up an Auxdata type by name.
 *
 * Results:
 *    If an AuxData type with name matching "typeName" is found, a pointer
 *    to its AuxDataType structure is returned; otherwise, NULL is returned.
 *
 * Side effects:
 *    None.
 *
 *----------------------------------------------------------------------
 */

AuxDataType *
TclGetAuxDataType(typeName)
    char *typeName;           /* Name of AuxData type to look up. */
{
    register Tcl_HashEntry *hPtr;
    AuxDataType *typePtr = NULL;

    if (!auxDataTypeTableInitialized) {
        TclInitAuxDataTypeTable();
    }

    hPtr = Tcl_FindHashEntry(&auxDataTypeTable, typeName);
    if (hPtr != (Tcl_HashEntry *) NULL) {
        typePtr = (AuxDataType *) Tcl_GetHashValue(hPtr);
    }

    return typePtr;
}

/*
 *--------------------------------------------------------------
 *
 * TclInitAuxDataTypeTable --
 *
 *    This procedure is invoked to perform once-only initialization of
 *    the AuxData type table. It also registers the AuxData types defined in 
 *    this file.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Initializes the table of defined AuxData types "auxDataTypeTable" with
 *    builtin AuxData types defined in this file.
 *
 *--------------------------------------------------------------
 */

void
TclInitAuxDataTypeTable()
{
    auxDataTypeTableInitialized = 1;

    Tcl_InitHashTable(&auxDataTypeTable, TCL_STRING_KEYS);
    TclRegisterAuxDataType(&tclForeachInfoType);
}

/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeAuxDataTypeTable --
 *
 *    This procedure is called by Tcl_Finalize after all exit handlers
 *    have been run to free up storage associated with the table of AuxData
 *    types.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Deletes all entries in the hash table of AuxData types, "auxDataTypeTable".
 *
 *----------------------------------------------------------------------
 */

void
TclFinalizeAuxDataTypeTable()
{
    if (auxDataTypeTableInitialized) {
        Tcl_DeleteHashTable(&auxDataTypeTable);
        auxDataTypeTableInitialized = 0;
    }
}


#ifdef KANJI
/*
 *----------------------------------------------------------------------
 *
 * GetKanjiVarAndEl --
 *
 *    Search variable name and index from given string with kanji care.
 *
 * Results:
 *    Set variable name and index to given pointers, return kanji code.
 *
 * Side effects:
 *    None.
 *
 *----------------------------------------------------------------------
 */

static int
GetKanjiVarAndEl(src, len, varName, elName, varLen, elLen, envPtr)
     char *src;
     int len;
     char **varName;
     char **elName;
     int *varLen;
     int *elLen;
     CompileEnv *envPtr;
{
    int i = 0;
    unsigned char *end = src + len;
    int kanjiCode = TCL_ANY;

    envPtr->lastScannedKanjiCode = TCL_ANY;
    *elName = (char *)NULL;
    *elLen = 0;
    *varName = src;
    *varLen = len;

    while ( (i < len) && src[i] != '(' ) {
        if (IS_KANJISTART(UCHAR(src[i]))) {
            i += Tcl_KanjiSkip(&(src[i]), end, &kanjiCode);
          if (kanjiCode != TCL_ANY && kanjiCode != TCL_NOT_KANJI) {
            envPtr->lastScannedKanjiCode = kanjiCode;
          }
        } else {
            i++;
        }
    }

    *varLen = i;
    if (i < len && src[i] == '(') {
      i++;
        if (src[len - 1] == ')') {
            *elName = &(src[i]);
            *elLen = len - i - 1;
        } else {
            *varLen = len;
        }
    }

    if (elName != NULL && *elLen > 0) {
      char *p = *elName;
      char *last = *elName + *elLen;
      while (p < last) {
          if (IS_KANJISTART(UCHAR(*p))) {
            p += Tcl_KanjiSkip(p, last, &kanjiCode);
            if (kanjiCode != TCL_ANY && kanjiCode != TCL_NOT_KANJI) {
                envPtr->lastScannedKanjiCode = kanjiCode;
            }
          } else {
            p++;
          }
      }
    }

#ifdef ARRAY_DEBUG      
    {
      char *vN = alloca(*varLen + 1);
      char *eN = alloca(*elLen + 1);
      char *ss = alloca(len + 1);

      memcpy(vN, *varName, *varLen);
      vN[*varLen] = '\0';

      memcpy(eN, *elName, *elLen);
      eN[*elLen] = '\0';

      memcpy(ss, src, len);
      ss[len] = '\0';
      fprintf(stderr, "src '%s' -> v:'%s' %d, e:'%s' %d\n", ss, vN, *varLen, eN, *elLen);
    }
#endif /* ARRAY_DEBUG */

    return kanjiCode;
}
#endif /* KANJI */

Generated by  Doxygen 1.6.0   Back to index