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

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

Parent Directory | Revision Log | View Patch Patch

-revision 64 by dashley,
Sun Oct 30 04:21:11 2016 UTC
+revision 71 by dashley,
Sat Nov  5 11:07:06 2016 UTC
 Line 1
  /* $Header$ */
  /*
   * 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-1998 Sun Microsystems, Inc.
   *
   * See the file "license.terms" for information on usage and redistribution
   * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
   *
   * RCS: @(#) $Id: tclcompile.c,v 1.1.1.1 2001/06/13 04:36:17 dtashley Exp $
   */
  #include "tclInt.h"
  #include "tclCompile.h"
  /*
   * Table of all AuxData types.
   */
  static Tcl_HashTable auxDataTypeTable;
  static int auxDataTypeTableInitialized; /* 0 means not yet initialized. */
  TCL_DECLARE_MUTEX(tableMutex)
  /*
   * 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;
  /*
   * A table describing the Tcl bytecode instructions. Entries in this table
   * must correspond to the instruction opcode definitions in tclCompile.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 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}
  };
  /*
   * Prototypes for procedures defined later in this file:
   */
  static void             DupByteCodeInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
                              Tcl_Obj *copyPtr));
  static unsigned char *  EncodeCmdLocMap _ANSI_ARGS_((
                              CompileEnv *envPtr, ByteCode *codePtr,
                              unsigned char *startPtr));
  static void             EnterCmdExtentData _ANSI_ARGS_((
                              CompileEnv *envPtr, int cmdNumber,
                              int numSrcBytes, int numCodeBytes));
  static void             EnterCmdStartData _ANSI_ARGS_((
                              CompileEnv *envPtr, int cmdNumber,
                              int srcOffset, int codeOffset));
  static void             FreeByteCodeInternalRep _ANSI_ARGS_((
                              Tcl_Obj *objPtr));
  static int              GetCmdLocEncodingSize _ANSI_ARGS_((
                              CompileEnv *envPtr));
  static void             LogCompilationInfo _ANSI_ARGS_((Tcl_Interp *interp,
                              char *script, char *command, int length));
  #ifdef TCL_COMPILE_STATS
  static void             RecordByteCodeStats _ANSI_ARGS_((
                              ByteCode *codePtr));
  #endif /* TCL_COMPILE_STATS */
  static int              SetByteCodeFromAny _ANSI_ARGS_((Tcl_Interp *interp,
                              Tcl_Obj *objPtr));
  /*
   * 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 */
      (Tcl_UpdateStringProc *) NULL,      /* updateStringProc */
      SetByteCodeFromAny                  /* setFromAnyProc */
  };
  /*
   *----------------------------------------------------------------------
   *
   * TclSetByteCodeFromAny --
   *
   *      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.  This function also takes
   *      a hook procedure that will be invoked to perform any needed post
   *      processing on the compilation results before generating byte
   *      codes.
   *
   * 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.
   *
   *----------------------------------------------------------------------
   */
  int
  TclSetByteCodeFromAny(interp, objPtr, hookProc, clientData)
      Tcl_Interp *interp;         /* The interpreter for which the code is
                                   * being compiled.  Must not be NULL. */
      Tcl_Obj *objPtr;            /* The object to make a ByteCode object. */
      CompileHookProc *hookProc;  /* Procedure to invoke after compilation. */
      ClientData clientData;      /* Hook procedure private data. */
  {
      Interp *iPtr = (Interp *) interp;
      CompileEnv compEnv;         /* Compilation environment structure
                                   * allocated in frame. */
      LiteralTable *localTablePtr = &(compEnv.localLitTable);
      register AuxData *auxDataPtr;
      LiteralEntry *entryPtr;
      register int i;
      int length, nested, result;
      char *string;
      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;
      }
      if (iPtr->evalFlags & TCL_BRACKET_TERM) {
          nested = 1;
      } else {
          nested = 0;
      }
      string = Tcl_GetStringFromObj(objPtr, &length);
      TclInitCompileEnv(interp, &compEnv, string, length);
      result = TclCompileScript(interp, string, length, nested, &compEnv);
      if (result == TCL_OK) {
          /*
           * Successful compilation. Add a "done" instruction at the end.
           */
          compEnv.numSrcBytes = iPtr->termOffset;
          TclEmitOpcode(INST_DONE, &compEnv);
          /*
           * Invoke the compilation hook procedure if one exists.
           */
          if (hookProc) {
              result = (*hookProc)(interp, &compEnv, clientData);
          }
          /*
           * Change the object into a ByteCode object. Ownership of the literal
           * objects and aux data items is given to the ByteCode object.
           */
  #ifdef TCL_COMPILE_DEBUG
          TclVerifyLocalLiteralTable(&compEnv);
  #endif /*TCL_COMPILE_DEBUG*/
          TclInitByteCodeObj(objPtr, &compEnv);
  #ifdef TCL_COMPILE_DEBUG
          if (tclTraceCompile == 2) {
              TclPrintByteCodeObj(interp, objPtr);
          }
  #endif /* TCL_COMPILE_DEBUG */
      }
      if (result != TCL_OK) {
          /*
           * Compilation errors.
           */
          entryPtr = compEnv.literalArrayPtr;
          for (i = 0;  i < compEnv.literalArrayNext;  i++) {
              TclReleaseLiteral(interp, entryPtr->objPtr);
              entryPtr++;
          }
  #ifdef TCL_COMPILE_DEBUG
          TclVerifyGlobalLiteralTable(iPtr);
  #endif /*TCL_COMPILE_DEBUG*/
          auxDataPtr = compEnv.auxDataArrayPtr;
          for (i = 0;  i < compEnv.auxDataArrayNext;  i++) {
              if (auxDataPtr->type->freeProc != NULL) {
                  auxDataPtr->type->freeProc(auxDataPtr->clientData);
              }
              auxDataPtr++;
          }
      }
      /*
       * Free storage allocated during compilation.
       */
      if (localTablePtr->buckets != localTablePtr->staticBuckets) {
          ckfree((char *) localTablePtr->buckets);
      }
      TclFreeCompileEnv(&compEnv);
      return result;
  }
  /*
   *-----------------------------------------------------------------------
   *
   * 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
                                   * being compiled.  Must not be NULL. */
      Tcl_Obj *objPtr;            /* The object to make a ByteCode object. */
  {
      return TclSetByteCodeFromAny(interp, objPtr,
              (CompileHookProc *) NULL, (ClientData) NULL);
  }
  /*
   *----------------------------------------------------------------------
   *
   * 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;
  }
  /*
   *----------------------------------------------------------------------
   *
   * 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 releases its
   *      literals and frees its auxiliary data items.
   *
   *----------------------------------------------------------------------
   */
  void
  TclCleanupByteCode(codePtr)
      register ByteCode *codePtr; /* Points to the ByteCode to free. */
  {
      Tcl_Interp *interp = (Tcl_Interp *) *codePtr->interpHandle;
      int numLitObjects = codePtr->numLitObjects;
      int numAuxDataItems = codePtr->numAuxDataItems;
      register Tcl_Obj **objArrayPtr;
      register AuxData *auxDataPtr;
      int i;
  #ifdef TCL_COMPILE_STATS
      if (interp != NULL) {
          ByteCodeStats *statsPtr;
          Tcl_Time destroyTime;
          int lifetimeSec, lifetimeMicroSec, log2;
          statsPtr = &((Interp *) interp)->stats;
          statsPtr->numByteCodesFreed++;
          statsPtr->currentSrcBytes -= (double) codePtr->numSrcBytes;
          statsPtr->currentByteCodeBytes -= (double) codePtr->structureSize;
          statsPtr->currentInstBytes   -= (double) codePtr->numCodeBytes;
          statsPtr->currentLitBytes    -=
                  (double) (codePtr->numLitObjects * sizeof(Tcl_Obj *));
          statsPtr->currentExceptBytes -=
                  (double) (codePtr->numExceptRanges * sizeof(ExceptionRange));
          statsPtr->currentAuxBytes    -=
                  (double) (codePtr->numAuxDataItems * sizeof(AuxData));
          statsPtr->currentCmdMapBytes -= (double) codePtr->numCmdLocBytes;
          TclpGetTime(&destroyTime);
          lifetimeSec = destroyTime.sec - codePtr->createTime.sec;
          if (lifetimeSec > 2000) {       /* avoid overflow */
              lifetimeSec = 2000;
          }
          lifetimeMicroSec =
              1000000*lifetimeSec + (destroyTime.usec - codePtr->createTime.usec);
          log2 = TclLog2(lifetimeMicroSec);
          if (log2 > 31) {
              log2 = 31;
          }
          statsPtr->lifetimeCount[log2]++;
      }
  #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 of the LiteralEntry's in
       * its literal array, 2) call the free procs for the auxiliary data
       * items, and 3) free the ByteCode structure's heap object.
       *
       * The case for TCL_BYTECODE_PRECOMPILED (precompiled ByteCodes,
       * like those generated from tbcload) is special, as they doesn't
       * make use of the global literal table.  They instead maintain
       * private references to their literals which must be decremented.
       */
      if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
          register Tcl_Obj *objPtr;
          objArrayPtr = codePtr->objArrayPtr;
          for (i = 0;  i < numLitObjects;  i++) {
              objPtr = *objArrayPtr;
              if (objPtr) {
                  Tcl_DecrRefCount(objPtr);
              }
              objArrayPtr++;
          }
          codePtr->numLitObjects = 0;
      } else if (interp != NULL) {
          /*
           * If the interp has already been freed, then Tcl will have already
           * forcefully released all the literals used by ByteCodes compiled
           * with respect to that interp.
           */
          objArrayPtr = codePtr->objArrayPtr;
          for (i = 0;  i < numLitObjects;  i++) {
              /*
               * TclReleaseLiteral sets a ByteCode's object array entry NULL to
               * indicate that it has already freed the literal.
               */
              if (*objArrayPtr != NULL) {
                  TclReleaseLiteral(interp, *objArrayPtr);
              }
              objArrayPtr++;
          }
      }
      auxDataPtr = codePtr->auxDataArrayPtr;
      for (i = 0;  i < numAuxDataItems;  i++) {
          if (auxDataPtr->type->freeProc != NULL) {
              (*auxDataPtr->type->freeProc)(auxDataPtr->clientData);
          }
          auxDataPtr++;
      }
      TclHandleRelease(codePtr->interpHandle);
      ckfree((char *) codePtr);
  }
  /*
   *----------------------------------------------------------------------
   *
   * 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, numBytes)
      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. */
      int numBytes;                /* Number of bytes in source string. */
  {
      Interp *iPtr = (Interp *) interp;
      envPtr->iPtr = iPtr;
      envPtr->source = string;
      envPtr->numSrcBytes = numBytes;
      envPtr->procPtr = iPtr->compiledProcPtr;
      envPtr->numCommands = 0;
      envPtr->exceptDepth = 0;
      envPtr->maxExceptDepth = 0;
      envPtr->maxStackDepth = 0;
      TclInitLiteralTable(&(envPtr->localLitTable));
      envPtr->exprIsJustVarRef = 0;
      envPtr->exprIsComparison = 0;
      envPtr->codeStart = envPtr->staticCodeSpace;
      envPtr->codeNext = envPtr->codeStart;
      envPtr->codeEnd = (envPtr->codeStart + COMPILEENV_INIT_CODE_BYTES);
      envPtr->mallocedCodeArray = 0;
      envPtr->literalArrayPtr = envPtr->staticLiteralSpace;
      envPtr->literalArrayNext = 0;
      envPtr->literalArrayEnd = COMPILEENV_INIT_NUM_OBJECTS;
      envPtr->mallocedLiteralArray = 0;
      envPtr->exceptArrayPtr = envPtr->staticExceptArraySpace;
      envPtr->exceptArrayNext = 0;
      envPtr->exceptArrayEnd = COMPILEENV_INIT_EXCEPT_RANGES;
      envPtr->mallocedExceptArray = 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;
  }
  /*
   *----------------------------------------------------------------------
   *
   * 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
   *      its local literal table is not deleted and its literal objects are
   *      not released. In addition, storage referenced by its auxiliary data
   *      items is not freed. This is done so that, when compilation is
   *      successful, "ownership" of these objects and aux data items is
   *      handed over to the corresponding ByteCode structure.
   *
   *----------------------------------------------------------------------
   */
  void
  TclFreeCompileEnv(envPtr)
      register CompileEnv *envPtr; /* Points to the CompileEnv structure. */
  {
      if (envPtr->mallocedCodeArray) {
          ckfree((char *) envPtr->codeStart);
      }
      if (envPtr->mallocedLiteralArray) {
          ckfree((char *) envPtr->literalArrayPtr);
      }
      if (envPtr->mallocedExceptArray) {
          ckfree((char *) envPtr->exceptArrayPtr);
      }
      if (envPtr->mallocedCmdMap) {
          ckfree((char *) envPtr->cmdMapPtr);
      }
      if (envPtr->mallocedAuxDataArray) {
          ckfree((char *) envPtr->auxDataArrayPtr);
      }
  }
  /*
   *----------------------------------------------------------------------
   *
   * TclCompileScript --
   *
   *      Compile a Tcl script in a 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.
   *
   *      interp->termOffset is set to the offset of the character in the
   *      script just after the last one successfully processed; this will be
   *      the offset of the ']' if (flags & TCL_BRACKET_TERM).
   *      envPtr->maxStackDepth is set to the maximum number of stack elements
   *      needed to execute the script's commands.
   *
   * Side effects:
   *      Adds instructions to envPtr to evaluate the script at runtime.
   *
   *----------------------------------------------------------------------
   */
  int
  TclCompileScript(interp, script, numBytes, nested, envPtr)
      Tcl_Interp *interp;         /* Used for error and status reporting. */
      char *script;               /* The source script to compile. */
      int numBytes;               /* Number of bytes in script. If < 0, the
                                   * script consists of all bytes up to the
                                   * first null character. */
      int nested;                 /* Non-zero means this is a nested command:
                                   * close bracket ']' should be considered a
                                   * command terminator. If zero, close
                                   * bracket has no special meaning. */
      CompileEnv *envPtr;         /* Holds resulting instructions. */
  {
      Interp *iPtr = (Interp *) interp;
      Tcl_Parse parse;
      int maxDepth = 0;           /* Maximum number of stack elements needed
                                   * to execute all cmds. */
      int lastTopLevelCmdIndex = -1;
                                  /* Index of most recent toplevel command in
                                   * the command location table. Initialized
                                   * to avoid compiler warning. */
      int startCodeOffset = -1;   /* Offset of first byte of current command's
                                   * code. Init. to avoid compiler warning. */
      unsigned char *entryCodeNext = envPtr->codeNext;
      char *p, *next;
      Namespace *cmdNsPtr;
      Command *cmdPtr;
      Tcl_Token *tokenPtr;
      int bytesLeft, isFirstCmd, gotParse, wordIdx, currCmdIndex;
      int commandLength, objIndex, code;
      char prev;
      Tcl_DString ds;
      Tcl_DStringInit(&ds);
      if (numBytes < 0) {
          numBytes = strlen(script);
      }
      Tcl_ResetResult(interp);
      isFirstCmd = 1;
      /*
       * Each iteration through the following loop compiles the next
       * command from the script.
       */
      p = script;
      bytesLeft = numBytes;
      gotParse = 0;
      while (bytesLeft > 0) {
          if (Tcl_ParseCommand(interp, p, bytesLeft, nested, &parse) != TCL_OK) {
              code = TCL_ERROR;
              goto error;
          }
          gotParse = 1;
          if (parse.numWords > 0) {
              /*
               * If not the first command, pop the previous command's result
               * and, if we're compiling a top level command, update the last
               * command's code size to account for the pop instruction.
               */
              if (!isFirstCmd) {
                  TclEmitOpcode(INST_POP, envPtr);
                  if (!nested) {
                      envPtr->cmdMapPtr[lastTopLevelCmdIndex].numCodeBytes =
                             (envPtr->codeNext - envPtr->codeStart)
                             - startCodeOffset;
                  }
              }
              /*
               * Determine the actual length of the command.
               */
              commandLength = parse.commandSize;
              prev = '\0';
              if (commandLength > 0) {
                  prev = parse.commandStart[commandLength-1];
              }
              if (((parse.commandStart+commandLength) != (script+numBytes))
                      || ((prev=='\n') || (nested && (prev==']')))) {
                  /*
                   * The command didn't end at the end of the script (i.e.  it
                   * ended at a terminator character such as ";".  Reduce the
                   * length by one so that the trace message doesn't include
                   * the terminator character.
                   */
                  commandLength -= 1;
              }
              /*
               * If tracing, print a line for each top level command compiled.
               */
              if ((tclTraceCompile >= 1)
                      && !nested && (envPtr->procPtr == NULL)) {
                  fprintf(stdout, "  Compiling: ");
                  TclPrintSource(stdout, parse.commandStart,
                          TclMin(commandLength, 55));
                  fprintf(stdout, "\n");
              }
              /*
               * Each iteration of the following loop compiles one word
               * from the command.
               */
              envPtr->numCommands++;
              currCmdIndex = (envPtr->numCommands - 1);
              if (!nested) {
                  lastTopLevelCmdIndex = currCmdIndex;
              }
              startCodeOffset = (envPtr->codeNext - envPtr->codeStart);
              EnterCmdStartData(envPtr, currCmdIndex,
                      (parse.commandStart - envPtr->source), startCodeOffset);
              for (wordIdx = 0, tokenPtr = parse.tokenPtr;
                      wordIdx < parse.numWords;
                      wordIdx++, tokenPtr += (tokenPtr->numComponents + 1)) {
                  if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
                      /*
                       * If this is the first word and the command has a
                       * compile procedure, let it compile the command.
                       */
                      if (wordIdx == 0) {
                          if (envPtr->procPtr != NULL) {
                              cmdNsPtr = envPtr->procPtr->cmdPtr->nsPtr;
                          } else {
                              cmdNsPtr = NULL; /* use current NS */
                          }
                          /*
                           * We copy the string before trying to find the command
                           * by name.  We used to modify the string in place, but
                           * this is not safe because the name resolution
                           * handlers could have side effects that rely on the
                           * unmodified string.
                           */
                          Tcl_DStringSetLength(&ds, 0);
                          Tcl_DStringAppend(&ds, tokenPtr[1].start,
                                  tokenPtr[1].size);
                          cmdPtr = (Command *) Tcl_FindCommand(interp,
                                  Tcl_DStringValue(&ds),
                                  (Tcl_Namespace *) cmdNsPtr, /*flags*/ 0);
                          if ((cmdPtr != NULL)
                                  && (cmdPtr->compileProc != NULL)
                                  && !(iPtr->flags & DONT_COMPILE_CMDS_INLINE)) {
                              code = (*(cmdPtr->compileProc))(interp, &parse,
                                      envPtr);
                              if (code == TCL_OK) {
                                  maxDepth = TclMax(envPtr->maxStackDepth,
                                          maxDepth);
                                  goto finishCommand;
                              } else if (code == TCL_OUT_LINE_COMPILE) {
                                  /* do nothing */
                              } else { /* an error */
                                  /*
                                   * There was a compilation error, the last
                                   * command did not get compiled into (*envPtr).
                                   * Decrement the number of commands
                                   * claimed to be in (*envPtr).
                                   */
                                  envPtr->numCommands--;
                                  goto error;
                              }
                          }
                          /*
                           * No compile procedure so push the word. If the
                           * command was found, push a CmdName object to
                           * reduce runtime lookups.
                           */
                          objIndex = TclRegisterLiteral(envPtr,
                                  tokenPtr[1].start, tokenPtr[1].size,
                                  /*onHeap*/ 0);
                          if (cmdPtr != NULL) {
                              TclSetCmdNameObj(interp,
                                     envPtr->literalArrayPtr[objIndex].objPtr,
                                     cmdPtr);
                          }
                      } else {
                          objIndex = TclRegisterLiteral(envPtr,
                                  tokenPtr[1].start, tokenPtr[1].size,
                                  /*onHeap*/ 0);
                      }
                      TclEmitPush(objIndex, envPtr);
                      maxDepth = TclMax((wordIdx + 1), maxDepth);
                  } else {
                      /*
                       * The word is not a simple string of characters.
                       */
                      code = TclCompileTokens(interp, tokenPtr+1,
                              tokenPtr->numComponents, envPtr);
                      if (code != TCL_OK) {
                          goto error;
                      }
                      maxDepth = TclMax((wordIdx + envPtr->maxStackDepth),
                             maxDepth);
                  }
              }
              /*
               * Emit an invoke instruction for the command. We skip this
               * if a compile procedure was found for the command.
               */
              if (wordIdx > 0) {
                  if (wordIdx <= 255) {
                      TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr);
                  } else {
                      TclEmitInstInt4(INST_INVOKE_STK4, wordIdx, envPtr);
                  }
              }
              /*
               * Update the compilation environment structure and record the
               * offsets of the source and code for the command.
               */
              finishCommand:
              EnterCmdExtentData(envPtr, currCmdIndex, commandLength,
                      (envPtr->codeNext-envPtr->codeStart) - startCodeOffset);
              isFirstCmd = 0;
          } /* end if parse.numWords > 0 */
          /*
           * Advance to the next command in the script.
           */
          next = parse.commandStart + parse.commandSize;
          bytesLeft -= (next - p);
          p = next;
          Tcl_FreeParse(&parse);
          gotParse = 0;
          if (nested && (p[-1] == ']')) {
              /*
               * We get here in the special case where TCL_BRACKET_TERM was
               * set in the interpreter and we reached a close bracket in the
               * script. Stop compilation.
               */
              break;
          }
      }
      /*
       * If the source script yielded no instructions (e.g., if it was empty),
       * push an empty string as the command's result.
       */
      if (envPtr->codeNext == entryCodeNext) {
          TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0),
                  envPtr);
          maxDepth = 1;
      }
      if ((nested != 0) && (p > script) && (p[-1] == ']')) {
          iPtr->termOffset = (p - 1) - script;
      } else {
          iPtr->termOffset = (p - script);
      }
      envPtr->maxStackDepth = maxDepth;
      Tcl_DStringFree(&ds);
      return TCL_OK;
      error:
      /*
       * Generate various pieces of error information, such as the line
       * number where the error occurred and information to add to the
       * errorInfo variable. Then free resources that had been allocated
       * to the command.
       */
      commandLength = parse.commandSize;
      prev = '\0';
      if (commandLength > 0) {
          prev = parse.commandStart[commandLength-1];
      }
      if (((parse.commandStart+commandLength) != (script+numBytes))
              || ((prev == '\n') || (nested && (prev == ']')))) {
          /*
           * The command where the error occurred didn't end at the end
           * of the script (i.e. it ended at a terminator character such
           * as ";".  Reduce the length by one so that the error message
           * doesn't include the terminator character.
           */
          commandLength -= 1;
      }
      LogCompilationInfo(interp, script, parse.commandStart, commandLength);
      if (gotParse) {
          Tcl_FreeParse(&parse);
      }
      iPtr->termOffset = (p - script);
      envPtr->maxStackDepth = maxDepth;
      Tcl_DStringFree(&ds);
      return code;
  }
  /*
   *----------------------------------------------------------------------
   *
   * TclCompileTokens --
   *
   *      Given an array of tokens parsed from a Tcl command (e.g., the tokens
   *      that make up a word) this procedure emits instructions to evaluate
   *      the tokens and concatenate their values to form a single result
   *      value on the interpreter's runtime evaluation stack.
   *
   * Results:
   *      The return value is a standard Tcl result. If an error occurs, an
   *      error message is left in the interpreter's result.
   *
   *      envPtr->maxStackDepth is updated with the maximum number of stack
   *      elements needed to evaluate the tokens.
   *
   * Side effects:
   *      Instructions are added to envPtr to push and evaluate the tokens
   *      at runtime.
   *
   *----------------------------------------------------------------------
   */
  int
  TclCompileTokens(interp, tokenPtr, count, envPtr)
      Tcl_Interp *interp;         /* Used for error and status reporting. */
      Tcl_Token *tokenPtr;        /* Pointer to first in an array of tokens
                                   * to compile. */
      int count;                  /* Number of tokens to consider at tokenPtr.
                                   * Must be at least 1. */
      CompileEnv *envPtr;         /* Holds the resulting instructions. */
  {
      Tcl_DString textBuffer;     /* Holds concatenated chars from adjacent
                                   * TCL_TOKEN_TEXT, TCL_TOKEN_BS tokens. */
      char buffer[TCL_UTF_MAX];
      char *name, *p;
      int numObjsToConcat, nameBytes, hasNsQualifiers, localVar;
      int length, maxDepth, depthForVar, i, code;
      unsigned char *entryCodeNext = envPtr->codeNext;
      Tcl_DStringInit(&textBuffer);
      maxDepth = 0;
      numObjsToConcat = 0;
      for ( ;  count > 0;  count--, tokenPtr++) {
          switch (tokenPtr->type) {
              case TCL_TOKEN_TEXT:
                  Tcl_DStringAppend(&textBuffer, tokenPtr->start,
                          tokenPtr->size);
                  break;
              case TCL_TOKEN_BS:
                  length = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL,
                          buffer);
                  Tcl_DStringAppend(&textBuffer, buffer, length);
                  break;
              case TCL_TOKEN_COMMAND:
                  /*
                   * Push any accumulated chars appearing before the command.
                   */
                  if (Tcl_DStringLength(&textBuffer) > 0) {
                      int literal;
                      literal = TclRegisterLiteral(envPtr,
                              Tcl_DStringValue(&textBuffer),
                              Tcl_DStringLength(&textBuffer), /*onHeap*/ 0);
                      TclEmitPush(literal, envPtr);
                      numObjsToConcat++;
                      maxDepth = TclMax(numObjsToConcat, maxDepth);
                      Tcl_DStringFree(&textBuffer);
                  }
                  code = TclCompileScript(interp, tokenPtr->start+1,
                          tokenPtr->size-2, /*nested*/ 1, envPtr);
                  if (code != TCL_OK) {
                      goto error;
                  }
                  maxDepth = TclMax((numObjsToConcat + envPtr->maxStackDepth),
                          maxDepth);
                  numObjsToConcat++;
                  break;
              case TCL_TOKEN_VARIABLE:
                  /*
                   * Push any accumulated chars appearing before the $<var>.
                   */
                  if (Tcl_DStringLength(&textBuffer) > 0) {
                      int literal;
                      literal = TclRegisterLiteral(envPtr,
                              Tcl_DStringValue(&textBuffer),
                              Tcl_DStringLength(&textBuffer), /*onHeap*/ 0);
                      TclEmitPush(literal, envPtr);
                      numObjsToConcat++;
                      maxDepth = TclMax(numObjsToConcat, maxDepth);
                      Tcl_DStringFree(&textBuffer);
                  }
                  /*
                   * Check if the name contains any namespace qualifiers.
                   */
                  name = tokenPtr[1].start;
                  nameBytes = tokenPtr[1].size;
                  hasNsQualifiers = 0;
                  for (i = 0, p = name;  i < nameBytes;  i++, p++) {
                      if ((*p == ':') && (i < (nameBytes-1))
                              && (*(p+1) == ':')) {
                          hasNsQualifiers = 1;
                          break;
                      }
                  }
                  /*
                   * Either push the variable's name, or find its index in
                   * the array of local variables in a procedure frame.
                   */
                  depthForVar = 0;
                  if ((envPtr->procPtr == NULL) || hasNsQualifiers) {
                      localVar = -1;
                      TclEmitPush(TclRegisterLiteral(envPtr, name, nameBytes,
                              /*onHeap*/ 0), envPtr);
                      depthForVar = 1;
                  } else {
                      localVar = TclFindCompiledLocal(name, nameBytes,
                              /*create*/ 0, /*flags*/ 0, envPtr->procPtr);
                      if (localVar < 0) {
                          TclEmitPush(TclRegisterLiteral(envPtr, name,
                                  nameBytes, /*onHeap*/ 0), envPtr);
                          depthForVar = 1;
                      }
                  }
                  /*
                   * Emit instructions to load the variable.
                   */
                  if (tokenPtr->numComponents == 1) {
                      if (localVar < 0) {
                          TclEmitOpcode(INST_LOAD_SCALAR_STK, envPtr);
                      } else if (localVar <= 255) {
                          TclEmitInstInt1(INST_LOAD_SCALAR1, localVar,
                                  envPtr);
                      } else {
                          TclEmitInstInt4(INST_LOAD_SCALAR4, localVar,
                                  envPtr);
                      }
                  } else {
                      code = TclCompileTokens(interp, tokenPtr+2,
                              tokenPtr->numComponents-1, envPtr);
                      if (code != TCL_OK) {
                          sprintf(buffer,
                                  "\n    (parsing index for array \"%.*s\")",
                                  ((nameBytes > 100)? 100 : nameBytes), name);
                          Tcl_AddObjErrorInfo(interp, buffer, -1);
                          goto error;
                      }
                      depthForVar += envPtr->maxStackDepth;
                      if (localVar < 0) {
                          TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr);
                      } else if (localVar <= 255) {
                          TclEmitInstInt1(INST_LOAD_ARRAY1, localVar,
                                  envPtr);
                      } else {
                          TclEmitInstInt4(INST_LOAD_ARRAY4, localVar,
                                  envPtr);
                      }
                  }
                  maxDepth = TclMax(numObjsToConcat + depthForVar, maxDepth);
                  numObjsToConcat++;
                  count -= tokenPtr->numComponents;
                  tokenPtr += tokenPtr->numComponents;
                  break;
              default:
                  panic("Unexpected token type in TclCompileTokens");
          }
      }
      /*
       * Push any accumulated characters appearing at the end.
       */
      if (Tcl_DStringLength(&textBuffer) > 0) {
          int literal;
          literal = TclRegisterLiteral(envPtr, Tcl_DStringValue(&textBuffer),
                  Tcl_DStringLength(&textBuffer), /*onHeap*/ 0);
          TclEmitPush(literal, envPtr);
          numObjsToConcat++;
          maxDepth = TclMax(numObjsToConcat, maxDepth);
      }
      /*
       * If necessary, concatenate the parts of the word.
       */
      while (numObjsToConcat > 255) {
          TclEmitInstInt1(INST_CONCAT1, 255, envPtr);
          numObjsToConcat -= 254; /* concat pushes 1 obj, the result */
      }
      if (numObjsToConcat > 1) {
          TclEmitInstInt1(INST_CONCAT1, numObjsToConcat, envPtr);
      }
      /*
       * If the tokens yielded no instructions, push an empty string.
       */
      if (envPtr->codeNext == entryCodeNext) {
          TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0),
                  envPtr);
          maxDepth = 1;
      }
      Tcl_DStringFree(&textBuffer);
      envPtr->maxStackDepth = maxDepth;
      return TCL_OK;
      error:
      Tcl_DStringFree(&textBuffer);
      envPtr->maxStackDepth = maxDepth;
      return code;
  }
  /*
   *----------------------------------------------------------------------
   *
   * TclCompileCmdWord --
   *
   *      Given an array of parse tokens for a word containing one or more Tcl
   *      commands, emit inline instructions to execute them. This procedure
   *      differs from TclCompileTokens in that a simple word such as a loop
   *      body enclosed in braces is not just pushed as a string, but is
   *      itself parsed into tokens and compiled.
   *
   * Results:
   *      The return value is a standard Tcl result. If an error occurs, an
   *      error message is left in the interpreter's result.
   *
   *      envPtr->maxStackDepth is updated with the maximum number of stack
   *      elements needed to execute the tokens.
   *
   * Side effects:
   *      Instructions are added to envPtr to execute the tokens at runtime.
   *
   *----------------------------------------------------------------------
   */
  int
  TclCompileCmdWord(interp, tokenPtr, count, envPtr)
      Tcl_Interp *interp;         /* Used for error and status reporting. */
      Tcl_Token *tokenPtr;        /* Pointer to first in an array of tokens
                                   * for a command word to compile inline. */
      int count;                  /* Number of tokens to consider at tokenPtr.
                                   * Must be at least 1. */
      CompileEnv *envPtr;         /* Holds the resulting instructions. */
  {
      int code;
      /*
       * Handle the common case: if there is a single text token, compile it
       * into an inline sequence of instructions.
       */
      envPtr->maxStackDepth = 0;
      if ((count == 1) && (tokenPtr->type == TCL_TOKEN_TEXT)) {
          code = TclCompileScript(interp, tokenPtr->start, tokenPtr->size,
                  /*nested*/ 0, envPtr);
          return code;
      }
      /*
       * Multiple tokens or the single token involves substitutions. Emit
       * instructions to invoke the eval command procedure at runtime on the
       * result of evaluating the tokens.
       */
      code = TclCompileTokens(interp, tokenPtr, count, envPtr);
      if (code != TCL_OK) {
          return code;
      }
      TclEmitOpcode(INST_EVAL_STK, envPtr);
      return TCL_OK;
  }
  /*
   *----------------------------------------------------------------------
   *
   * TclCompileExprWords --
   *
   *      Given an array of parse tokens representing one or more words that
   *      contain a Tcl expression, emit inline instructions to execute the
   *      expression. This procedure differs from TclCompileExpr in that it
   *      supports Tcl's two-level substitution semantics for expressions that
   *      appear as command words.
   *
   * Results:
   *      The return value is a standard Tcl result. If an error occurs, an
   *      error message is left in the interpreter's result.
   *
   *      envPtr->maxStackDepth is updated with the maximum number of stack
   *      elements needed to execute the expression.
   *
   * Side effects:
   *      Instructions are added to envPtr to execute the expression.
   *
   *----------------------------------------------------------------------
   */
  int
  TclCompileExprWords(interp, tokenPtr, numWords, envPtr)
      Tcl_Interp *interp;         /* Used for error and status reporting. */
      Tcl_Token *tokenPtr;        /* Points to first in an array of word
                                   * tokens tokens for the expression to
                                   * compile inline. */
      int numWords;               /* Number of word tokens starting at
                                   * tokenPtr. Must be at least 1. Each word
                                   * token contains one or more subtokens. */
      CompileEnv *envPtr;         /* Holds the resulting instructions. */
  {
      Tcl_Token *wordPtr;
      int maxDepth, range, numBytes, i, code;
      char *script;
      int saveExprIsJustVarRef = envPtr->exprIsJustVarRef;
      int saveExprIsComparison = envPtr->exprIsComparison;
      envPtr->maxStackDepth = 0;
      maxDepth = 0;
      range = -1;
      code = TCL_OK;
      /*
       * If the expression is a single word that doesn't require
       * substitutions, just compile it's string into inline instructions.
       */
      if ((numWords == 1) && (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD)) {
          /*
           * Temporarily overwrite the character just after the end of the
           * string with a 0 byte.
           */
          script = tokenPtr[1].start;
          numBytes = tokenPtr[1].size;
          code = TclCompileExpr(interp, script, numBytes, envPtr);
          return code;
      }
      /*
       * Emit code to call the expr command proc at runtime. Concatenate the
       * (already substituted once) expr tokens with a space between each.
       */
      wordPtr = tokenPtr;
      for (i = 0;  i < numWords;  i++) {
          code = TclCompileTokens(interp, wordPtr+1, wordPtr->numComponents,
                  envPtr);
          if (code != TCL_OK) {
              break;
          }
          if (i < (numWords - 1)) {
              TclEmitPush(TclRegisterLiteral(envPtr, " ", 1, /*onHeap*/ 0),
                      envPtr);
              maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
          } else {
              maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
          }
          wordPtr += (wordPtr->numComponents + 1);
      }
      if (code == TCL_OK) {
          int concatItems = 2*numWords - 1;
          while (concatItems > 255) {
              TclEmitInstInt1(INST_CONCAT1, 255, envPtr);
              concatItems -= 254;
          }
          if (concatItems > 1) {
              TclEmitInstInt1(INST_CONCAT1, concatItems, envPtr);
          }
          TclEmitOpcode(INST_EXPR_STK, envPtr);
      }
      envPtr->exprIsJustVarRef = saveExprIsJustVarRef;
      envPtr->exprIsComparison = saveExprIsComparison;
      envPtr->maxStackDepth = maxDepth;
      return code;
  }
  /*
   *----------------------------------------------------------------------
   *
   * 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, structureSize;
      register unsigned char *p;
      unsigned char *nextPtr;
      int numLitObjects = envPtr->literalArrayNext;
      Namespace *namespacePtr;
      int i;
      Interp *iPtr;
      iPtr = envPtr->iPtr;
      codeBytes = (envPtr->codeNext - envPtr->codeStart);
      objArrayBytes = (envPtr->literalArrayNext * sizeof(Tcl_Obj *));
      exceptArrayBytes = (envPtr->exceptArrayNext * sizeof(ExceptionRange));
      auxDataArrayBytes = (envPtr->auxDataArrayNext * sizeof(AuxData));
      cmdLocBytes = GetCmdLocEncodingSize(envPtr);
      /*
       * Compute the total number of bytes needed for this bytecode.
       */
      structureSize = sizeof(ByteCode);
      structureSize += TCL_ALIGN(codeBytes);        /* align object array */
      structureSize += TCL_ALIGN(objArrayBytes);    /* align exc range arr */
      structureSize += TCL_ALIGN(exceptArrayBytes); /* align AuxData array */
      structureSize += auxDataArrayBytes;
      structureSize += cmdLocBytes;
      if (envPtr->iPtr->varFramePtr != NULL) {
          namespacePtr = envPtr->iPtr->varFramePtr->nsPtr;
      } else {
          namespacePtr = envPtr->iPtr->globalNsPtr;
      }
      p = (unsigned char *) ckalloc((size_t) structureSize);
      codePtr = (ByteCode *) p;
      codePtr->interpHandle = TclHandlePreserve(iPtr->handle);
      codePtr->compileEpoch = iPtr->compileEpoch;
      codePtr->nsPtr = namespacePtr;
      codePtr->nsEpoch = namespacePtr->resolverEpoch;
      codePtr->refCount = 1;
      codePtr->flags = 0;
      codePtr->source = envPtr->source;
      codePtr->procPtr = envPtr->procPtr;
      codePtr->numCommands = envPtr->numCommands;
      codePtr->numSrcBytes = envPtr->numSrcBytes;
      codePtr->numCodeBytes = codeBytes;
      codePtr->numLitObjects = numLitObjects;
      codePtr->numExceptRanges = envPtr->exceptArrayNext;
      codePtr->numAuxDataItems = envPtr->auxDataArrayNext;
      codePtr->numCmdLocBytes = cmdLocBytes;
      codePtr->maxExceptDepth = envPtr->maxExceptDepth;
      codePtr->maxStackDepth = envPtr->maxStackDepth;
      p += sizeof(ByteCode);
      codePtr->codeStart = p;
      memcpy((VOID *) p, (VOID *) envPtr->codeStart, (size_t) codeBytes);
      p += TCL_ALIGN(codeBytes);        /* align object array */
      codePtr->objArrayPtr = (Tcl_Obj **) p;
      for (i = 0;  i < numLitObjects;  i++) {
          codePtr->objArrayPtr[i] = envPtr->literalArrayPtr[i].objPtr;
      }
      p += TCL_ALIGN(objArrayBytes);    /* align exception range array */
      if (exceptArrayBytes > 0) {
          codePtr->exceptArrayPtr = (ExceptionRange *) p;
          memcpy((VOID *) p, (VOID *) envPtr->exceptArrayPtr,
                  (size_t) exceptArrayBytes);
      } else {
          codePtr->exceptArrayPtr = NULL;
      }
      p += TCL_ALIGN(exceptArrayBytes); /* align AuxData array */
      if (auxDataArrayBytes > 0) {
          codePtr->auxDataArrayPtr = (AuxData *) p;
          memcpy((VOID *) p, (VOID *) envPtr->auxDataArrayPtr,
                  (size_t) auxDataArrayBytes);
      } else {
          codePtr->auxDataArrayPtr = NULL;
      }
      p += auxDataArrayBytes;
      nextPtr = EncodeCmdLocMap(envPtr, codePtr, (unsigned char *) p);
  #ifdef TCL_COMPILE_DEBUG
      if (((size_t)(nextPtr - p)) != cmdLocBytes) {
          panic("TclInitByteCodeObj: encoded cmd location bytes %d != expected size %d\n", (nextPtr - p), cmdLocBytes);
      }
  #endif
      /*
       * Record various compilation-related statistics about the new ByteCode
       * structure. Don't include overhead for statistics-related fields.
       */
  #ifdef TCL_COMPILE_STATS
      codePtr->structureSize = structureSize
              - (sizeof(size_t) + sizeof(Tcl_Time));
      TclpGetTime(&(codePtr->createTime));
      RecordByteCodeStats(codePtr);
  #endif /* TCL_COMPILE_STATS */
      /*
       * 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;
  }
  /*
   *----------------------------------------------------------------------
   *
   * LogCompilationInfo --
   *
   *      This procedure is invoked after an error occurs during compilation.
   *      It adds information to the "errorInfo" variable to describe the
   *      command that was being compiled when the error occurred.
   *
   * Results:
   *      None.
   *
   * Side effects:
   *      Information about the command is added to errorInfo and the
   *      line number stored internally in the interpreter is set.  If this
   *      is the first call to this procedure or Tcl_AddObjErrorInfo since
   *      an error occurred, then old information in errorInfo is
   *      deleted.
   *
   *----------------------------------------------------------------------
   */
  static void
  LogCompilationInfo(interp, script, command, length)
      Tcl_Interp *interp;         /* Interpreter in which to log the
                                   * information. */
      char *script;               /* First character in script containing
                                   * command (must be <= command). */
      char *command;              /* First character in command that
                                   * generated the error. */
      int length;                 /* Number of bytes in command (-1 means
                                   * use all bytes up to first null byte). */
  {
      char buffer[200];
      register char *p;
      char *ellipsis = "";
      Interp *iPtr = (Interp *) interp;
      if (iPtr->flags & ERR_ALREADY_LOGGED) {
          /*
           * Someone else has already logged error information for this
           * command; we shouldn't add anything more.
           */
          return;
      }
      /*
       * Compute the line number where the error occurred.
       */
      iPtr->errorLine = 1;
      for (p = script; p != command; p++) {
          if (*p == '\n') {
              iPtr->errorLine++;
          }
      }
      /*
       * Create an error message to add to errorInfo, including up to a
       * maximum number of characters of the command.
       */
      if (length < 0) {
          length = strlen(command);
      }
      if (length > 150) {
          length = 150;
          ellipsis = "...";
      }
      sprintf(buffer, "\n    while compiling\n\"%.*s%s\"",
              length, command, ellipsis);
      Tcl_AddObjErrorInfo(interp, buffer, -1);
  }
  /*
   *----------------------------------------------------------------------
   *
   * TclFindCompiledLocal --
   *
   *      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 create is 0 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
   *      create 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 create is 1 and
   *      the variable is unknown, or if the name is NULL.
   *
   *----------------------------------------------------------------------
   */
  int
  TclFindCompiledLocal(name, nameBytes, create, flags, 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 nameBytes;              /* Number of bytes in the name. */
      int create;                 /* If 1, allocate a local frame entry for
                                   * the variable if it is new. */
      int flags;                  /* 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 localVar = -1;
      register int i;
      /*
       * If not creating a temporary, does a local variable of the specified
       * name already exist?
       */
      if (name != NULL) {
          int localCt = procPtr->numCompiledLocals;
          localPtr = procPtr->firstLocalPtr;
          for (i = 0;  i < localCt;  i++) {
              if (!TclIsVarTemporary(localPtr)) {
                  char *localName = localPtr->name;
                  if ((nameBytes == localPtr->nameLength)
                          && (strncmp(name, localName, (unsigned) nameBytes) == 0)) {
                      return i;
                  }
              }
              localPtr = localPtr->nextPtr;
          }
      }
      /*
       * Create a new variable if appropriate.
       */
      if (create || (name == NULL)) {
          localVar = procPtr->numCompiledLocals;
          localPtr = (CompiledLocal *) ckalloc((unsigned)
                  (sizeof(CompiledLocal) - sizeof(localPtr->name)
                  + nameBytes+1));
          if (procPtr->firstLocalPtr == NULL) {
              procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
          } else {
              procPtr->lastLocalPtr->nextPtr = localPtr;
              procPtr->lastLocalPtr = localPtr;
          }
          localPtr->nextPtr = NULL;
          localPtr->nameLength = nameBytes;
          localPtr->frameIndex = localVar;
          localPtr->flags = flags;
          if (name == NULL) {
              localPtr->flags |= VAR_TEMPORARY;
          }
          localPtr->defValuePtr = NULL;
          localPtr->resolveInfo = NULL;
          if (name != NULL) {
              memcpy((VOID *) localPtr->name, (VOID *) name,
                      (size_t) nameBytes);
          }
          localPtr->name[nameBytes] = '\0';
          procPtr->numCompiledLocals++;
      }
      return localVar;
  }
  /*
   *----------------------------------------------------------------------
   *
   * 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++;
      }
  }
  /*
   *----------------------------------------------------------------------
   *
   * 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 = (envPtr->codeNext - envPtr->codeStart);
      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;
  }
  /*
   *----------------------------------------------------------------------
   *
   * 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 not sorted by code offset");
          }
      }
      cmdLocPtr = &(envPtr->cmdMapPtr[cmdIndex]);
      cmdLocPtr->codeOffset = codeOffset;
      cmdLocPtr->srcOffset = srcOffset;
      cmdLocPtr->numSrcBytes = -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, numSrcBytes, 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 numSrcBytes;            /* Number of command source chars. */
      int numCodeBytes;           /* Offset of last byte of command code. */
  {
      CmdLocation *cmdLocPtr;
      if ((cmdIndex < 0) || (cmdIndex >= envPtr->numCommands)) {
          panic("EnterCmdExtentData: bad command index %d\n", cmdIndex);
      }
      if (cmdIndex > envPtr->cmdMapEnd) {
          panic("EnterCmdExtentData: missing start data for command %d\n",
                  cmdIndex);
      }
      cmdLocPtr = &(envPtr->cmdMapPtr[cmdIndex]);
      cmdLocPtr->numSrcBytes = numSrcBytes;
      cmdLocPtr->numCodeBytes = numCodeBytes;
  }
  /*
   *----------------------------------------------------------------------
   *
   * TclCreateExceptRange --
   *
   *      Procedure that allocates and initializes a new ExceptionRange
   *      structure of the specified kind in a CompileEnv.
   *
   * 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->mallocedExceptArray is non-zero the old
   *      array is freed, and ExceptionRange entries are copied from the old
   *      array to the new one.
   *
   *----------------------------------------------------------------------
   */
  int
  TclCreateExceptRange(type, envPtr)
      ExceptionRangeType type;    /* The kind of ExceptionRange desired. */
      register CompileEnv *envPtr;/* Points to CompileEnv for which to
                                   * create a new ExceptionRange structure. */
  {
      register ExceptionRange *rangePtr;
      int index = envPtr->exceptArrayNext;
      if (index >= envPtr->exceptArrayEnd) {
          /*
           * Expand the ExceptionRange array. The currently allocated entries
           * are stored between elements 0 and (envPtr->exceptArrayNext - 1)
           * [inclusive].
           */
          size_t currBytes =
                  envPtr->exceptArrayNext * sizeof(ExceptionRange);
          int newElems = 2*envPtr->exceptArrayEnd;
          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->exceptArrayPtr,
                  currBytes);
          if (envPtr->mallocedExceptArray) {
              ckfree((char *) envPtr->exceptArrayPtr);
          }
          envPtr->exceptArrayPtr = (ExceptionRange *) newPtr;
          envPtr->exceptArrayEnd = newElems;
          envPtr->mallocedExceptArray = 1;
      }
      envPtr->exceptArrayNext++;
      rangePtr = &(envPtr->exceptArrayPtr[index]);
      rangePtr->type = type;
      rangePtr->nestingLevel = envPtr->exceptDepth;
      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->clientData = clientData;
      auxDataPtr->type = typePtr;
      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
       *    - exceptIndex is the index of the first ExceptionRange after
       *      the current one.
       */
      jumpFixupPtr->jumpType = jumpType;
      jumpFixupPtr->codeOffset = (envPtr->codeNext - envPtr->codeStart);
      jumpFixupPtr->cmdIndex = envPtr->numCommands;
      jumpFixupPtr->exceptIndex = envPtr->exceptArrayNext;
      switch (jumpType) {
      case TCL_UNCONDITIONAL_JUMP:
          TclEmitInstInt1(INST_JUMP1, 0, envPtr);
          break;
      case TCL_TRUE_JUMP:
          TclEmitInstInt1(INST_JUMP_TRUE1, 0, envPtr);
          break;
      default:
          TclEmitInstInt1(INST_JUMP_FALSE1, 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.
       * Note that if we expand the space for generated instructions,
       * code addresses might change; be careful about updating any of
       * these addresses held in variables.
       */
      if ((envPtr->codeNext + 3) > envPtr->codeEnd) {
          TclExpandCodeArray(envPtr);
      }
      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->exceptIndex;
      lastRange  = (envPtr->exceptArrayNext - 1);
      for (k = firstRange;  k <= lastRange;  k++) {
          ExceptionRange *rangePtr = &(envPtr->exceptArrayPtr[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: bad 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]).