* unix/tclUnixChan.c: Streamline async connect logic [Patch 1994512]

2008-08-05  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclExecute.c: Fix for [Bug 2038069] by dgp.
	* tests/execute.test:

2008-08-04  Don Porter  <dgp@users.sourceforge.net>S

	[dgp-refactor branch]

	* generic/tclBasic.c:	Move toplevel exception handling code into
	TclEvalScriptTokens where the right data is available to construct
	the stack trace, and out of callers which lacked that data.  Fixes
	long failing basic-46.* tests.

2008-08-04  Miguel Sofer  <msofer@users.sf.net>

	* tests/nre.test: Added tests for [if], [while] and [for]. A test
	for [foreach] has been added and marked as knownbug, awaiting for it
	to be NR-enabled.

 *-----------------------------------------------------------------------------
 */

int
TclCompileAssembleCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by TclParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *tokenPtr;	/* Token in the input script */

    int numCommands = envPtr->numCommands;

    if (TCL_ERROR == TclAssembleCode(envPtr, tokenPtr[1].start,
	    tokenPtr[1].size, TCL_EVAL_DIRECT)) {

	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (\"%.*s\" body, line %d)",
		parsePtr->tokenPtr->size, parsePtr->tokenPtr->start,
		Tcl_GetErrorLine(interp)));
	TclDisposeFailedCompile(envPtr, numCommands);
	envPtr->codeNext = envPtr->codeStart + offset;
	envPtr->currStackDepth = depth;
	TclCompileSyntaxError(interp, envPtr);
    }
    return TCL_OK;
}


    Tcl_Parse* parsePtr = assemEnvPtr->parsePtr;

    do {
	/*
	 * Parse out one command line from the assembly script.
	 */

	status = TclParseCommand(interp, instPtr, bytesLeft,
		PARSE_USE_INTERNAL_TOKENS, parsePtr);

	/*
	 * Report errors in the parse.
	 */

	if (status != TCL_OK) {
	    if (flags & TCL_EVAL_DIRECT) {

				 * errors. */
    Tcl_Token *tokenPtr,	/* Pointer to first in an array of tokens to
				 * evaluate and concatenate. */
    int count)			/* Number of tokens to consider at tokenPtr.
				 * Must be at least 1. */
{
    return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL, 1,
	    NULL, NULL, 0);
}

/*
 *----------------------------------------------------------------------
 *
 * TclEvalScriptTokens --
 *
 * 
 * Results:
 *
 * Side effects:
 *
 * TIP #280 : Keep public API, internally extended API.
 *----------------------------------------------------------------------
 */

int
TclEvalScriptTokens(
    Tcl_Interp *interp,
    Tcl_Token *tokenPtr,
    int length,
    int flags,
    int line,
    int*  clNextOuter,		/* Information about an outer context for */
    const char* outerScript)	/* continuation line data. This is set only in
				 * TclSubstTokens(), to properly handle
				 * [...]-nested commands. The 'outerScript'
				 * refers to the most-outer script containing
				 * the embedded command, which is refered to
				 * by 'script'. The 'clNextOuter' refers to
				 * the current entry in the table of
				 * continuation lines in this "master script",
				 * and the character offsets are relative to
				 * the 'outerScript' as well.
				 *
				 * If outerScript == script, then this call is
				 * for the outer-most script/command. See
				 * Tcl_EvalEx() and TclEvalObjEx() for places
				 * generating arguments for which this is true.
				 */
{
    int numCommands = tokenPtr->numComponents;
    Tcl_Token *scriptTokenPtr = tokenPtr;
    Interp *iPtr = (Interp *) interp;
    int code = TCL_OK;
    unsigned int objLength = 20;
    int *expand, *expandStack, *lines, *lineSpace, *linesStack;
    Tcl_Obj **objvSpace, **stackObjArray;
    const char *cmdString = scriptTokenPtr->start;
    int cmdSize = scriptTokenPtr->size;
    CmdFrame *eeFramePtr;	/* TIP #280 Structures for tracking of command
				 * locations. */
    int allowExceptions = 1;
    int *clNext = NULL;		/* Pointer for the tracking of invisible
				 * continuation lines. Initialized only if the
				 * caller gave us a table of locations to
				 * track, via scriptCLLocPtr. It always refers
				 * to the table entry holding the location of
				 * the next invisible continuation line to
				 * look for, while parsing the script. */

    if (iPtr->scriptCLLocPtr) {
	if (clNextOuter) {
	    clNext = clNextOuter;
	} else {
	    clNext = &iPtr->scriptCLLocPtr->loc[0];
	}
    }

    if (iPtr->numLevels == 0) {
	allowExceptions = iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS;
    }

    if (length == 0) {
        Tcl_Panic("EvalScriptTokens: can't eval zero tokens");
    }
    if (tokenPtr->type != TCL_TOKEN_SCRIPT) {
        Tcl_Panic("EvalScriptTokens: invalid token array, expected script");
    }
    tokenPtr++; length--;
    if (numCommands) {
	TclAdvanceLines(&line, scriptTokenPtr->start, tokenPtr->start);
	TclAdvanceContinuations(&line, &clNext, tokenPtr->start - outerScript);
    }

    if (length == 0) {
	return TclInterpReady(interp);
    }

    /*
     * TIP #280 Initialize tracking. Do not push on the frame stack yet.
     *
     * We open a new context, either for a sourced script, or 'eval'.
     * For sourced files we always have a path object, even if nothing was
     * specified in the interp itself. That makes code using it simpler as
     * NULL checks can be left out. Sourced file without path in the
     * 'scriptFile' is possible during Tcl initialization.
     */

    eeFramePtr = TclStackAlloc(interp, sizeof(CmdFrame));
    if (iPtr->evalFlags & TCL_EVAL_FILE) {
	/*
	 * Set up for a sourced file.
	 */

	eeFramePtr->type = TCL_LOCATION_SOURCE;

	if (iPtr->scriptFile) {
	    /*
	     * Normalization here, to have the correct pwd. Should have
	     * negligible impact on performance, as the norm should have been
	     * done already by the 'source' invoking us, and it caches the
	     * result.
	     */

	    Tcl_Obj *norm = Tcl_FSGetNormalizedPath(interp, iPtr->scriptFile);

	    if (norm == NULL) {
		/*
		 * Error message in the interp result.
		 */
		TclStackFree(interp, eeFramePtr);
		return TCL_ERROR;
	    }
	    eeFramePtr->data.eval.path = norm;
	} else {
	    TclNewLiteralStringObj(eeFramePtr->data.eval.path, "");
	}
	Tcl_IncrRefCount(eeFramePtr->data.eval.path);
    } else {
	/*
	 * Set up for plain eval.
	 */

	eeFramePtr->type = TCL_LOCATION_EVAL;
	eeFramePtr->data.eval.path = NULL;
    }

    eeFramePtr->level = iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level + 1 : 1;
    eeFramePtr->framePtr = iPtr->framePtr;
    eeFramePtr->nextPtr = iPtr->cmdFramePtr;
    eeFramePtr->nline = 0;
    eeFramePtr->line = NULL;
    eeFramePtr->cmdObj = NULL;

    iPtr->cmdFramePtr = eeFramePtr;
    iPtr->evalFlags = 0;
    objvSpace = stackObjArray =
	    TclStackAlloc(interp, objLength * sizeof(Tcl_Obj *));
    expand = expandStack =
	    TclStackAlloc(interp, objLength * sizeof(int));
    lineSpace = linesStack =
	    TclStackAlloc(interp, objLength * sizeof(int));
    while (numCommands-- && (code == TCL_OK)) {
	int objc, expandRequested = 0;
        unsigned int objectsNeeded = 0;
        unsigned int numWords = tokenPtr->numComponents;
	Tcl_Obj **objv;
        Tcl_Token *commandTokenPtr = tokenPtr;

	/*
	 * TIP #280. Track lines within the words of the current command.
	 * We use a separate pointer into the table of continuation line
	 * locations to not lose our position for the per-command parsing.
	 */

	int wordLine = line;
	const char *wordStart = commandTokenPtr->start;
	int *wordCLNext = clNext;

        if (length == 0) {
            Tcl_Panic("EvalScriptTokens: overran token array");
        }
        if (tokenPtr->type != TCL_TOKEN_CMD) {
            Tcl_Panic("EvalScriptTokens: invalid token array, expected cmd");
        }
        tokenPtr++; length--;

        if (numWords == 0) continue;
	if (numWords > objLength) {
	    if (expand != expandStack) {
		ckfree(expand);
	    }
            expand = ckalloc(numWords * sizeof(int));
	    if (objvSpace != stackObjArray) {
		ckfree(objvSpace);
	    }
            objvSpace = ckalloc(numWords * sizeof(Tcl_Obj *));
	    if (lineSpace != linesStack) {
		ckfree(lineSpace);
	    }
	    lineSpace = ckalloc(numWords * sizeof(int));
	    objLength = numWords;
	}

	objv = objvSpace;
	lines = lineSpace;
	iPtr->cmdFramePtr = eeFramePtr->nextPtr;
        for (objc = 0; objc < numWords;
                objc++, length -= (tokenPtr->numComponents + 1),
                tokenPtr += tokenPtr->numComponents+1) {
            if (length == 0) {
                Tcl_Panic("EvalScriptTokens: overran token array");
            }
            if (!(tokenPtr->type & (TCL_TOKEN_WORD 
		    | TCL_TOKEN_SIMPLE_WORD | TCL_TOKEN_EXPAND_WORD))) {
                Tcl_Panic("EvalScriptTokens: invalid token array, expected word: %d: %.*s", tokenPtr->type, tokenPtr->size, tokenPtr->start);
            }
            if (length < tokenPtr->numComponents + 1) {
                Tcl_Panic("EvalScriptTokens: overran token array");
            }

	    /*
	     * TIP #280. Track lines to current word. Save the information
	     * on a per-word basis, signaling dynamic words as needed.
	     * Make the information available to the recursively called
	     * evaluator as well, including the type of context (source
	     * vs. eval).
	     */

	    TclAdvanceLines(&wordLine, wordStart, tokenPtr->start);
	    TclAdvanceContinuations (&wordLine, &wordCLNext,
		    tokenPtr->start - outerScript);
	    wordStart = tokenPtr->start;

	    lines[objc] = TclWordKnownAtCompileTime(tokenPtr, NULL)
		    ? wordLine : -1;

	    if (eeFramePtr->type == TCL_LOCATION_SOURCE) {
		iPtr->evalFlags |= TCL_EVAL_FILE;
	    }

            code = TclSubstTokens(interp, tokenPtr+1, tokenPtr->numComponents,
                    NULL, wordLine, wordCLNext, outerScript, flags);

	    iPtr->evalFlags = 0;

            if (code != TCL_OK) {
		break;
	    }
	    objv[objc] = Tcl_GetObjResult(interp);
	    Tcl_IncrRefCount(objv[objc]);
	    if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
		int numElements;

		code = TclListObjLength(interp, objv[objc], &numElements);
		if (code == TCL_ERROR) {
		    /*
		     * Attempt to expand a non-list
		     */
		    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
			    "\n    (expanding word %d)", objc));
		    objc++;
		    break;
		}
		expandRequested = 1;
		expand[objc] = 1;
		objectsNeeded += (numElements ? numElements : 1);
	    } else {
		expand[objc] = 0;
		objectsNeeded++;
	    }

	    if (wordCLNext) {
		TclContinuationsEnterDerived (objv[objc],
			wordStart - outerScript, wordCLNext);
	    }
        }
	iPtr->cmdFramePtr = eeFramePtr;
	if (code != TCL_OK) {
	    goto error;
	}
	if (expandRequested) {
	    /* Some word expansion was requested.  Check for objv resize */
	    Tcl_Obj **copy = objvSpace;
	    int *lcopy = lineSpace;
	    int wordIdx = numWords;
	    int objIdx = objectsNeeded - 1;
	    int inPlaceCopy = 1;

	    if (objectsNeeded > objLength) {
		inPlaceCopy = 0;
		objv = objvSpace = ckalloc(objectsNeeded * sizeof(Tcl_Obj*));
		lines = lineSpace = ckalloc(objectsNeeded * sizeof (int));
	    }

	    objc = 0;
	    while (wordIdx--) {
		if (expand[wordIdx]) {
		    int numElements;
		    Tcl_Obj **elements, *temp = copy[wordIdx];
		    Tcl_ListObjGetElements(NULL, temp, &numElements,
			    &elements);
		    objc += numElements;
		    while (numElements--) {
			lines[objIdx] = -1;
			objv[objIdx--] = elements[numElements];
			Tcl_IncrRefCount(elements[numElements]);
		    }
		    Tcl_DecrRefCount(temp);
	        } else {
		    lines[objIdx] = lcopy[wordIdx];
		    objv[objIdx--] = copy[wordIdx];
		    objc++;
		}
	    }
	    objv += objIdx+1;

            if (!inPlaceCopy && (copy != stackObjArray)) {
		ckfree(copy);
		ckfree(lcopy);
	    }
	}

	/*
	 * Execute the command and free the objects for its words.
	 *
	 * TIP #280: Remember the command itself for 'info frame'.
	 * Here is where we put our frame on the stack of frames too.
	 * _After_ the nested commands have been executed.
	 */

	eeFramePtr->cmd = commandTokenPtr->start;
	eeFramePtr->len = commandTokenPtr->size;
	eeFramePtr->nline = objc;
	eeFramePtr->line = lines;

	TclArgumentEnter(interp, objv, objc, eeFramePtr);
	code = Tcl_EvalObjv(interp, objc, objv,
		flags|TCL_EVAL_NOERR|TCL_EVAL_SOURCE_IN_FRAME);
	TclArgumentRelease(interp, objv, objc);

	eeFramePtr->line = NULL;
	eeFramePtr->nline = 0;
	if (eeFramePtr->cmdObj) {
	    Tcl_DecrRefCount(eeFramePtr->cmdObj);
	    eeFramePtr->cmdObj = NULL;
	}

        error:
	while (--objc >= 0) {
	    Tcl_DecrRefCount(objv[objc]);
	}
	cmdString = commandTokenPtr->start;
	cmdSize = commandTokenPtr->size;

	/*
	 * TIP #280 Track Lines. Now we track how many lines were in the
	 * executed command.
	 */

	if (numCommands) {
	    TclAdvanceLines(&line, commandTokenPtr->start, tokenPtr->start);
	}
    }
    if (length && (code == TCL_OK)) {
	code = TclSubstTokens(interp, tokenPtr, length, NULL, line, clNext,
		outerScript, flags);
    }
    if ((code == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
	Tcl_LogCommandInfo(interp, scriptTokenPtr->start, cmdString, cmdSize);
    }
    iPtr->flags &= ~ERR_ALREADY_LOGGED;
    if (lineSpace != linesStack) {
        ckfree(lineSpace);
    }
    TclStackFree(interp, linesStack);
    if (expand != expandStack) {
	ckfree(expand);
    }
    TclStackFree(interp, expandStack);
    if (objvSpace != stackObjArray) {
        ckfree(objvSpace);
    }
    TclStackFree(interp, stackObjArray);

    if (iPtr->numLevels == 0) {
	if (code == TCL_RETURN) {
	    code = TclUpdateReturnInfo(iPtr);
	}
	if ((code != TCL_OK) && (code != TCL_ERROR) && !allowExceptions) {
	    ProcessUnexpectedResult(interp, code);
	    code = TCL_ERROR;
	    Tcl_LogCommandInfo(interp, scriptTokenPtr->start,
		    cmdString, cmdSize);
	}
    }
    /*
     * TIP #280. Release the local CmdFrame, and its contents.
     */

    iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
    if (eeFramePtr->type == TCL_LOCATION_SOURCE) {
	Tcl_DecrRefCount(eeFramePtr->data.eval.path);
    }
    TclStackFree(interp, eeFramePtr);
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_EvalEx, TclEvalEx --
 *

int
TclEvalEx(
    Tcl_Interp *interp,		/* Interpreter in which to evaluate the
				 * script. Also used for error reporting. */
    const char *script,		/* First character of script to evaluate. */
    int numBytes,		/* Number of bytes in script. If < 0, the
				 * script consists of all bytes up to the
				 * first null character. */
    int flags,			/* Collection of OR-ed bits that control
				 * the evaluation of the script. Only
				 * TCL_EVAL_GLOBAL is currently
				 * supported. */
    int line,			/* The line the script starts on. */
    int*  clNextOuter,       /* Information about an outer context for */
    const char* outerScript) /* continuation line data. This is set only in
			      * EvalTokensStandard(), to properly handle
			      * [...]-nested commands. The 'outerScript'
			      * refers to the most-outer script containing the










































































































			      * embedded command, which is refered to by

			      * 'script'. The 'clNextOuter' refers to the




			      * current entry in the table of continuation












			      * lines in this "master script", and the



			      * character offsets are relative to the









































































			      * 'outerScript' as well.










			      *






			      * If outerScript == script, then this call is







			      * for the outer-most script/command. See





			      * Tcl_EvalEx() and TclEvalObjEx() for places













			      * generating arguments for which this is true.


















































			      */























{













    Tcl_Token *lastTokenPtr, *tokensPtr = TclParseScript(interp,




	    script, numBytes, /* flags */ 0, &lastTokenPtr, NULL);





    int code = TclEvalScriptTokens(interp, tokensPtr,






	    1 + (int)(lastTokenPtr - tokensPtr), flags, line,










	    clNextOuter, outerScript);















































    ckfree(tokensPtr);


















    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * TclAdvanceLines --

				 * evaluation of the script. Supported values
				 * are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */
    const CmdFrame *invoker,	/* Frame of the command doing the eval. */
    int word)			/* Index of the word which is in objPtr. */
{
    Interp *iPtr = (Interp *) interp;
    int result;
    int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);

    /*
     * This function consists of three independent blocks for: direct
     * evaluation of canonical lists, compilation and bytecode execution and
     * finally direct evaluation. Precisely one of these blocks will be run.
     */

	/*
	 * Let the compiler/engine subsystem do the evaluation.
	 *
	 * TIP #280 The invoker provides us with the context for the script.
	 * We transfer this to the byte code compiler.
	 */


	ByteCode *codePtr;
	CallFrame *savedVarFramePtr = NULL;	/* Saves old copy of
						 * iPtr->varFramePtr in case
						 * TCL_EVAL_GLOBAL was set. */

        if (TclInterpReady(interp) != TCL_OK) {
            return TCL_ERROR;

    {
	/*
	 * We're not supposed to use the compiler or byte-code
	 * interpreter. Let Tcl_EvalEx evaluate the command directly (and
	 * probably more slowly).
	 */
	Tcl_Token *lastTokenPtr, *tokensPtr;



	/*
	 * Now we check if we have data about invisible continuation lines for
	 * the script, and make it available to the direct script parser and
	 * evaluator we are about to call, if so.
	 *
	 * It may be possible that the script Tcl_Obj* can be free'd while the
	 * evaluator is using it, leading to the release of the associated
	 * ContLineLoc structure as well. To ensure that the latter doesn't
	 * happen we set a lock on it. We release this lock later in this
	 * function, after the evaluator is done. The relevant "lineCLPtr"
	 * hashtable is managed in the file "tclObj.c".
	 *
	 * Another important action is to save (and later restore) the
	 * continuation line information of the caller, in case we are
	 * executing nested commands in the eval/direct path.
	 */

	ContLineLoc *saveCLLocPtr = iPtr->scriptCLLocPtr;
	Tcl_Obj *copyPtr = TclTokensCopy(objPtr);

	assert(invoker == NULL);

	iPtr->scriptCLLocPtr = TclContinuationsGet(objPtr);

	Tcl_IncrRefCount(objPtr);

	tokensPtr = TclGetTokensFromObj(copyPtr, &lastTokenPtr);
	result = TclEvalScriptTokens(interp, tokensPtr,
		1 + (int)(lastTokenPtr - tokensPtr), flags, 1, NULL,
		tokensPtr[0].start);

	Tcl_DecrRefCount(objPtr);
	Tcl_DecrRefCount(copyPtr);

	iPtr->scriptCLLocPtr = saveCLLocPtr;
	return result;
    }
}

static int

    int objc,			/* Count of arguments. */
    Tcl_Obj *const objv[],	/* Argument objects; objv[0] points to the
				 * name of the command to invoke. */
    int flags)			/* Combination of flags controlling the call:
				 * TCL_INVOKE_HIDDEN, TCL_INVOKE_NO_UNKNOWN,
				 * or TCL_INVOKE_NO_TRACEBACK. */
{
    /* make whole thing a call to Tcl_EvalObjv */


    if ((objc < 1) || (objv == NULL)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "illegal argument vector", -1));
	return TCL_ERROR;
    }
    if ((flags & TCL_INVOKE_HIDDEN) == 0) {
	Tcl_Panic("TclObjInvoke: called without TCL_INVOKE_HIDDEN");

/*
 * tclBrodnik.c --
 *
 *	This file contains the implementation of a BrodnikArray.
 *
 * Contributions from Don Porter, NIST, 2013. (not subject to US copyright)
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclBrodnik.h"

#if defined(HAVE_INTRIN_H)
#    include <intrin.h>
#ifdef _WIN64
#    pragma intrinsic(_BitScanReverse64)
#else
#    pragma intrinsic(_BitScanReverse)
#endif
#endif

/*
 *----------------------------------------------------------------------
 *
 * TclMSB --
 *
 *	Given a size_t non-zero value n, return the index of the most
 *	significant bit in n that is set.  This is equivalent to returning
 *	trunc(log2(n)).  It's also equivalent to the largest integer k
 *	such that 2^k <= n.
 *
 *	This routine is adapted from Andrej Brodnik, "Computation of the
 *	Least Significant Set Bit", pp 7-10, Proceedings of the 2nd
 *	Electrotechnical and Computer Science Conference, Portoroz,
 *	Slovenia, 1993.  The adaptations permit the computation to take
 *	place within size_t values without the need for double length
 *	buffers for calculation.  They also fill in a number of details
 *	the paper omits or leaves unclear.
 *
 * Results:
 *	The index of the most significant set bit in n, a value between
 *	0 and CHAR_BIT*sizeof(size_t) - 1, inclusive.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclMSB(
    size_t n)
{
    const int M = CHAR_BIT * sizeof(size_t);	/* Bits in a size_t */

    /*
     * TODO: This function corresponds to a processor instruction on
     * many platforms.  Add here the various platform and compiler
     * specific incantations to invoke those assembly instructions.
     */
#if defined(__GNUC__) && ((__GNUC__ >= 4) || ((__GNUC__ == 3) && (__GNUC_MINOR__ >= 4)))
	return n ? M - 1 - __builtin_clzll(n) : 0;
#endif

#if defined(_MSC_VER) && _MSCVER >= 1300
	unsigned long result;

#ifdef _WIN64
	(void) _BitScanReverse64(&result, n)
#else
	(void) _BitScanReverse(&result, n)
#endif

	return result;
#endif

    if (M == 64) {

	/*
	 * For a byte, consider two masks, C1 = 10000000 selecting just
	 * the high bit, and C2 = 01111111 selecting all other bits.
	 * Then for any byte value n, the computation
	 *	LEAD(n) = C1 & (n | (C2 + (n & C2)))
	 * will leave all bits but the high bit unset, and will have the
	 * high bit set iff n!=0.  The whole thing is an 8-bit test
	 * for being non-zero.  For an 8-byte size_t, each byte can have
	 * the test applied all at once, with combined masks.
	 */
	const size_t C1 = 0x8080808080808080;
	const size_t C2 = 0x7F7F7F7F7F7F7F7F;
#define LEAD(n) (C1 & (n | (C2 + (n & C2))))

	/*
	 * To shift a bit to a new place, multiplication by 2^k will do.
	 * To shift the top 7 bits produced by the LEAD test to the high
	 * 7 bits of the entire size_t, multiply by the right sum of
	 * powers of 2.  In this case
	 * Q = 1 + 2^7 + 2^14 + 2^21 + 2^28 + 2^35 + 2^42
	 * Then shift those 7 bits down to the low 7 bits of the size_t.
	 * The key to making this work is that none of the shifted bits
	 * collide with each other in the top 7-bit destination.
	 * Note that we lose the bit that indicates whether the low byte
	 * is non-zero.  That doesn't matter because we require the original
	 * value n to be non-zero, so if all other bytes signal to be zero,
	 * we know the low byte is non-zero, and if one of the other bytes
	 * signals non-zero, we just don't care what the low byte is.
	 */
	const size_t  Q = 0x0000040810204081;

	/*
	 * To place a copy of a 7-bit value in each of 7 bytes in
	 * a size_t, just multply by the right value.  In this case
	 *  P = 0x00 01 01 01 01 01 01 01
	 * We don't put a copy in the high byte since analysis of the
	 * remaining steps in the algorithm indicates we do not need it.
	 */
	const size_t  P = 0x0001010101010101;

	/*
	 * With 7 copies of the LEAD value, we can now apply 7 masks
	 * to it in a single step by an & against the right value.
	 * B =	00000000 01111111 01111110 01111100
	 *	01111000 01110000 01100000 01000000
	 * The higher the MSB of the copied value is, the more of the
	 * B-masked bytes stored in t will be non-zero.
	 */
	const size_t  B = 0x007F7E7C78706040;
	size_t t = B & P * (LEAD(n) * Q >> 57);

	/*
	 * We want to get a count of the non-zero bytes stored in t.
	 * First use LEAD(t) to create a set of high bits signaling
	 * non-zero values as before.  Call this value
	 * X = x6*2^55 +x5*2^47 +x4*2^39 +x3*2^31 +x2*2^23 +x1*2^15 +x0*2^7
	 * Then notice what multiplication by
	 * P =    2^48 +   2^40 +   2^32 +   2^24 +   2^16 +   2^8 + 1
	 * produces:
	 * P*X = x0*2^7 + (x0 + x1)*2^15 + ...
	 *       ... + (x0 + x1 + x2 + x3 + x4 + x5 + x6) * 2^55 + ...
	 *	 ... + (x5 + x6)*2^95 + x6*2^103
	 * The high terms of this product are going to overflow the size_t
	 * and get lost, but we don't care about them.  What we care is that
	 * the 2^55 term is exactly the sum we seek.  We shift the product
	 * down by 55 bits and then mask away all but the bottom 3 bits
	 * (Max sum can be 7) we get exactly the count of non-zero B-masked
	 * bytes.  By design of the mask, this count is the index of the
	 * MSB of the LEAD value.  It indicates which byte of the original
	 * value contains the MSB of the original value.
	 */
#define SUM(t) (0x7 & (int)(LEAD(t) * P >> 55));

	/*
	 * Multiply by 8 to get the number of bits to shift to place
	 * that MSB-containing byte in the low byte.
	 */
	int k = 8 * SUM(t);

	/*
	 * Shift the MSB byte to the low byte.  Then shift one more bit.
	 * Since we know the MSB byte is non-zero we only need to compute
	 * the MSB of the top 7 bits.  If all top 7 bits are zero, we know
	 * the bottom bit is the 1 and the correct index is 0.  Compute the
	 * MSB of that value by the same steps we did before.
	 */
	t = B & P * (n >> k >> 1);

	/*
	 * Add the index of the MSB of the byte to the index of the low
	 * bit of that byte computed before to get the final answer.
	 */
	return k + SUM(t);

	/* Total operations: 33
	 * 10 bit-ands, 6 multiplies, 4 adds, 5 rightshifts,
	 * 3 assignments, 3 bit-ors, 2 typecasts.
	 *
	 * The whole task is one direct computation.
	 * No branches. No loops.
	 *
	 * 33 operations cannot beat one instruction, so assembly
	 * wins and should be used wherever possible, but this isn't bad.
	 */

#undef SUM
    } else if (M == 32) {

	/* Same scheme as above, with adjustments to the 32-bit size */
	const size_t C1 = 0xA0820820;
	const size_t C2 = 0x5F7DF7DF;
	const size_t C3 = 0xC0820820;
	const size_t C4 = 0x20000000;
	const size_t Q  = 0x00010841;
	const size_t P = 0x01041041;
	const size_t B = 0x1F79C610;

#define SUM(t) (0x7 & (LEAD(t) * P >> 29));

	size_t t = B & P * ((C3 & (LEAD(n) + C4)) * Q >> 27);
	int k = 6 * SUM(t);

	t = B & P * (n >> k >> 1);
	return k + SUM(t);

	/* Total operations: 33
	 * 11 bit-ands, 6 multiplies, 5 adds, 5 rightshifts,
	 * 3 assignments, 3 bit-ors.
	 */

#undef SUM
#undef LEAD

    } else {
	/* Simple and slow fallback for cases we haven't done yet. */
	int k = 0;

	while (n >>= 1) {
	    k++;
	}
	return k;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclBAConvertIndices --
 *
 *	Given a size_t index into the sequence, convert into the
 *	corresponding index pair of the store[] of a BrodnikArray.
 *
 *	store[] is an array of arrays, and as the total size grows
 *	larger, the size of the arrays store[i] grow in a way that
 *	each new array is of about size sqrt(N), yet the index conversion
 *	routine remains relatively simple to calculate.
 *
 * Results:
 *	The index pair is written to *hiPtr and *loPtr, which may not
 *	be NULL.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
TclBAConvertIndices(
    size_t		index,
    unsigned int	*hiPtr,
    unsigned int	*loPtr)
{
    size_t		r = index + 1;
    int			k = TclMSB(r);
    int			shift = (k + 1) >> 1;
    unsigned int	lobits = (1 << shift) - 1;
    unsigned int	hibits = 1 << (k - shift);

    *hiPtr	= (lobits << 1) - ((k & 1) * hibits)
			+ ((r >> shift) & (hibits - 1));
    *loPtr	= r & lobits;
}

/*
 *----------------------------------------------------------------------
 *
 * TclBAInvertIndices --
 *
 *	Given a size_t index pair hi, lo into the store[] of a BrodnikArray,
 *	compute and return the size_t index of the element found there.
 *
 * Results:
 *	The size_t index value.
 *
 * Side effects:
 *	None.
 *----------------------------------------------------------------------
 */

size_t
TclBAInvertIndices(
    unsigned int	hi,
    unsigned int	lo)
{
    size_t		plus2 = hi + 2;
    int			n = TclMSB(plus2) - 1;
    unsigned int	bit = (((size_t)1)<<n);
    int			SB = 2*n + ((plus2 & bit)!=0);
    size_t		base = (((size_t)1)<<SB) - 1;
    size_t		increment = ((bit - 1) & plus2) << n;

    return base + increment + lo;
}

/*
 * tclBrodnik.h --
 *
 *	This file contains the implementation of a BrodnikArray.
 *
 * Contributions from Don Porter, NIST, 2013. (not subject to US copyright)
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

/*
 * The routines that follow implement a BrodnikArray of T elements, where
 * T is the type of the elements to be stored, which is the argument of
 * the macro.  
 *
 * The BrodnikArray data structure is adapted from Andrej Brodnik et al.,
 * "Resizable Arrays in Optimal Time and Space", from the Proceedings of
 * the 1999 Workshop on Algorithms and Data Structures, Lecture Notes
 * in Computer Science (LNCS) vol. 1663, pp. 37-48.
 *
 * The BrodnikArray is an indexed sequence of values.  The routines
 * Append() and Detach() permit inserting and deleting an element at
 * the end of the sequence, with allocated memory growing and shrinking
 * as needed.  The At(index) routine returns a (T *) pointing to the
 * index'th element in the sequence.  Indices are size_t values and
 * array elements have indices starting with 0.  Through the pointer
 * elements may be read or (over)written.  These routines provide
 * stack-like access as well as random access to the elements stored
 * in the array.
 *
 * The memory allocation management is such that for N elements stored
 * in the array, the amount of memory allocated, but not used
 * is O(sqrt(N)).  This is more efficient than the traditional Tcl
 * array growth algorithm that has O(N) memory waste.  The longest
 * contiguous span of allocated memory is also O(sqrt(N)) so longer
 * sequences should be possible without failure due to lack of a
 * long enough contiguous span of memory.  The main drawback of the
 * BrodnikArray is that it is a two-level storage structure, so two
 * pointer derefences are required to get an element, when a plain
 * array gets the job done in only one.  The other potential trouble
 * is the need for frequent reallocs as small arrays grow, though that's
 * not hard to remedy if it's a problem in practice.
 */

#define TclBrodnikArrayDeclare(T,scope)					\
									\
typedef struct BrodnikArray_ ## T BA_ ## T;				\
typedef struct BrodnikPointer_ ## T BP_ ## T;				\
									\
struct BrodnikPointer_ ## T {						\
    T *			ptr;						\
    BA_ ## T *		array;						\
    unsigned int	hi;						\
    unsigned int	lo;						\
    unsigned int	dbsize;						\
    unsigned int	count;						\
};									\
									\
struct BrodnikArray_ ## T {						\
    unsigned int	hi;						\
    unsigned int	lo;						\
    unsigned int	dbsize;						\
    unsigned int	count;						\
    unsigned int	dbused;						\
    unsigned int	dbavail;					\
    T **		store;						\
};									\
									\
scope	BA_ ## T *	BA_ ## T ## _Create();				\
scope	void		BA_ ## T ## _Destroy(BA_ ## T *a);		\
scope	size_t		BA_ ## T ## _Size(BA_ ## T *a);			\
scope	void		BA_ ## T ## _Copy(T *p,	BA_ ## T *a);		\
scope	T *		BA_ ## T ## _Append(BA_ ## T *a);		\
scope	T *		BA_ ## T ## _Detach(BA_ ## T *a);		\
scope	T *		BA_ ## T ## _Get(BA_ ## T *a, size_t index,	\
			    BP_ ## T *p);				\
scope	T *		BA_ ## T ## _At(BA_ ## T *a, size_t index);	\
									\
scope	T *		BA_ ## T ## _First(BA_ ## T *a, BP_ ## T *p);	\
scope	T *		BP_ ## T ## _Next(BP_ ## T *p);			\
scope	T *		BP_ ## T ## _Plus(BP_ ## T *p, size_t incr);	\
scope	T *		BP_ ## T ## _Minus(BP_ ## T *p, size_t incr)

									
#define TclBrodnikArray(T) 						\
									\
TclBrodnikArrayDeclare(T,static);					\
TclBrodnikArrayDefine(T,static)

#define TclBrodnikArrayDefine(T,scope)					\
scope BA_ ## T *							\
BA_ ## T ## _Create()							\
{									\
    BA_ ## T *newPtr = ckalloc(sizeof(BA_ ## T));			\
									\
    newPtr->hi = 0;							\
    newPtr->lo = 0;							\
    newPtr->dbsize = 1;							\
    newPtr->count = 0;							\
    newPtr->dbused = 1;							\
    newPtr->dbavail = 1;						\
    newPtr->store = ckalloc(sizeof(T *));				\
    newPtr->store[0] = ckalloc(sizeof(T));				\
    return newPtr;							\
}									\
									\
scope void								\
BA_ ## T ## _Destroy(							\
    BA_ ## T *a)							\
{									\
    unsigned int i = a->dbused;						\
									\
    while (i--) {							\
	ckfree(a->store[i]);						\
    }									\
    ckfree(a->store);							\
    ckfree(a);								\
}									\
									\
scope size_t								\
BA_ ## T ## _Size(							\
    BA_ ## T *a)							\
{									\
    if (a == NULL) {							\
	return 0;							\
    }									\
    return TclBAInvertIndices(a->hi, a->lo);				\
}									\
									\
scope void								\
BA_ ## T ## _Grow(							\
    BA_ ## T *a)							\
{									\
    if (a->dbused == a->dbavail) {					\
	a->dbavail *= 2;						\
	a->store = ckrealloc(a->store, a->dbavail*sizeof(T *));		\
    }									\
    a->store[a->dbused] = ckalloc(a->dbsize * sizeof(T));		\
    a->dbused++;							\
}									\
									\
scope void								\
BA_ ## T ## _Shrink(							\
    BA_ ## T *a)							\
{									\
    a->dbused--;							\
    ckfree(a->store[a->dbused]);					\
    if (a->dbavail / a->dbused >= 4) {					\
	a->dbavail /= 2;						\
	a->store = ckrealloc(a->store, a->dbavail*sizeof(T *));		\
    }									\
}									\
									\
scope void								\
BA_ ## T ## _Copy(							\
    T *p,								\
    BA_ ## T *a)							\
{									\
    unsigned int i = 0, n = 1, m = 0;					\
    if (a->hi == 0) {							\
	return;								\
    }									\
    while (i < a->hi) {							\
	memcpy(p, a->store[i++], n * sizeof(T));			\
	p += n;								\
	if (m == 0) {							\
	    m = n; n *= 2; m += n;					\
	}								\
	m--;								\
    }									\
    if (a->lo) {							\
	memcpy(p, a->store[a->hi], a->lo * sizeof(T));			\
    }									\
}									\
									\
scope T *								\
BA_ ## T ## _Append(							\
    BA_ ## T *a)							\
{									\
    T *elemPtr;								\
    if (a->hi == a->dbused) {						\
	BA_ ## T ## _Grow(a);						\
    }									\
    elemPtr = a->store[a->hi] + a->lo;					\
    a->lo++;								\
    if (a->lo == a->dbsize) {						\
	a->lo = 0;							\
	a->hi++;							\
	if (a->count == 0) {						\
	    a->count = a->dbsize;					\
	    a->dbsize *= 2;						\
	    a->count += a->dbsize;					\
	}								\
	a->count--;							\
    }									\
    return elemPtr;							\
}									\
									\
scope T *								\
BA_ ## T ## _Detach(							\
    BA_ ## T *a)							\
{									\
    T *elemPtr;								\
    if (a->hi == 0) {							\
	return NULL;							\
    }									\
    if (a->lo) {							\
	a->lo--;							\
    } else {								\
	a->hi--;							\
	a->count++;							\
	if (a->count == 3 * (a->dbsize / 2)) {				\
	    a->count = 0;						\
	    a->dbsize /= 2;						\
	}								\
	a->lo = a->dbsize - 1;						\
    }									\
    elemPtr = a->store[a->hi] + a->lo;					\
    if (a->lo == 0 && (a->hi != a->dbused - 1)) {			\
	BA_ ## T ## _Shrink(a);						\
    }									\
    return elemPtr;							\
}									\
									\
scope T *								\
BA_ ## T ## _Get(							\
    BA_ ## T *a,							\
    size_t index,							\
    BP_ ## T *p)							\
{									\
    unsigned int hi, lo;						\
									\
    TclBAConvertIndices(index, &hi, &lo);				\
    if (hi > a->hi || (hi == a->hi && lo >= a->lo)) {			\
	if (p) {p->ptr = NULL;}						\
	return NULL;							\
    }									\
    if (p) {								\
	size_t plus2 = hi + 2;						\
	int n = TclMSB(plus2) - 1;					\
	p->array = a;							\
	p->hi = hi;							\
	p->lo = lo;							\
	p->dbsize = 1 << (n + ((plus2 >> n) & 1));			\
	p->count = 3 * p->dbsize - 3 - hi;				\
	p->ptr = a->store[hi] + lo;					\
    }									\
    return a->store[hi] + lo;						\
}									\
									\
scope T *								\
BA_ ## T ## _At(							\
    BA_ ## T *a,							\
    size_t index)							\
{									\
    return BA_ ## T ## _Get(a, index, NULL);				\
}									\
									\
scope T *								\
BA_ ## T ## _First(							\
    BA_ ## T *a,							\
    BP_ ## T *p)							\
{									\
    p->array = a;							\
    p->hi = 0;								\
    p->lo = 0;								\
    p->dbsize = 1;							\
    p->count = 0;							\
    p->ptr = (a->hi) ? a->store[0] : NULL;				\
    return p->ptr;							\
}									\
									\
scope T *								\
BP_ ## T ## _Next(							\
    BP_ ## T *p)							\
{									\
    if (p->ptr) {							\
	p->lo++;							\
	if (p->lo < p->dbsize) {					\
	    p->ptr++;							\
	} else {							\
	    p->lo = 0;							\
	    p->hi++;							\
	    p->ptr = p->array->store[p->hi];				\
	    if (p->count == 0) {					\
		p->count = p->dbsize;					\
		p->dbsize *= 2;						\
		p->count += p->dbsize;					\
	    }								\
	    p->count--;							\
	}								\
	if (p->hi > p->array->hi 					\
		|| (p->hi == p->array->hi && p->lo >= p->array->lo)) {	\
	    p->ptr = NULL;						\
	}								\
    }									\
    return p->ptr;							\
}									\
									\
scope T *								\
BP_ ## T ## _Plus(							\
    BP_ ## T *p,							\
    size_t incr)							\
{									\
    if (p->ptr) {							\
	size_t index = TclBAInvertIndices(p->hi, p->lo);		\
	index += incr;							\
	return BA_ ## T ## _Get(p->array, index, p);			\
    }									\
    return p->ptr;							\
}									\
									\
scope T *								\
BP_ ## T ## _Minus(							\
    BP_ ## T *p,							\
    size_t incr)							\
{									\
    if (p->ptr) {							\
	size_t index = TclBAInvertIndices(p->hi, p->lo);		\
	if (index < incr) {						\
	    return p->ptr = NULL;					\
	}								\
	index -= incr;							\
	return BA_ ## T ## _Get(p->array, index, p);			\
    }									\
    return p->ptr;							\
}

 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"
#include "tclBrodnik.h"
#include <assert.h>

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

static void		CompileReturnInternal(CompileEnv *envPtr,

 * Side effects:
 *	Instructions are added to envPtr to execute the "if" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

TclBrodnikArrayDefine(JumpFixup,MODULE_SCOPE);

int
TclCompileIfCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    BA_JumpFixup *jumpFalseFixup;
				/* Used to fix the ifFalse jump after each
				 * test when its target PC is determined. */
    BA_JumpFixup *jumpEndFixup;
				/* Used to fix the jump after each "then" body
				 * to the end of the "if" when that PC is
				 * determined. */
    JumpFixup *falseFixupPtr = NULL, *endFixupPtr = NULL;
    Tcl_Token *tokenPtr, *testTokenPtr;

    int jumpFalseDist, numWords, wordIdx, numBytes, code;
    const char *word;
    int realCond = 1;		/* Set to 0 for static conditions:
				 * "if 0 {..}" */
    int boolVal;		/* Value of static condition. */
    int compileScripts = 1;
    DefineLineInformation;	/* TIP #280 */

    for (wordIdx = 0; wordIdx < numWords; wordIdx++) {
	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    return TCL_ERROR;
	}
	tokenPtr = TokenAfter(tokenPtr);
    }

    jumpFalseFixup = BA_JumpFixup_Create();
    jumpEndFixup = BA_JumpFixup_Create();
    code = TCL_OK;

    /*
     * Each iteration of this loop compiles one "if expr ?then? body" or
     * "elseif expr ?then? body" clause.
     */

		if (!boolVal) {
		    compileScripts = 0;
		}
	    } else {
		SetLineInformation(wordIdx);
		Tcl_ResetResult(interp);
		TclCompileExprWords(interp, testTokenPtr, 1, envPtr);




		falseFixupPtr = BA_JumpFixup_Append(jumpFalseFixup);
		TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, falseFixupPtr);

	    }
	    code = TCL_OK;
	}

	/*
	 * Skip over the optional "then" before the then clause.
	 */

	 */

	if (compileScripts) {
	    BODY(tokenPtr, wordIdx);
	}

	if (realCond) {




	    endFixupPtr = BA_JumpFixup_Append(jumpEndFixup);




	    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, endFixupPtr);


	    /*
	     * Fix the target of the jumpFalse after the test. Generate a 4
	     * byte jump if the distance is > 120 bytes. This is conservative,
	     * and ensures that we won't have to replace this jump if we later
	     * also need to replace the proceeding jump to the end of the "if"
	     * with a 4 byte jump.
	     */

	    TclAdjustStackDepth(-1, envPtr);
	    if (TclFixupForwardJumpToHere(envPtr, falseFixupPtr, 120)) {

		/*
		 * Adjust the code offset for the proceeding jump to the end
		 * of the "if" command.
		 */

		endFixupPtr->codeOffset += 3;
	    }
	} else if (boolVal) {
	    /*
	     * We were processing an "if 1 {...}"; stop compiling scripts.
	     */

	    compileScripts = 0;

	}
    }

    /*
     * Fix the unconditional jumps to the end of the "if" command.
     */

    endFixupPtr = BA_JumpFixup_Detach(jumpEndFixup);
    falseFixupPtr = BA_JumpFixup_Detach(jumpFalseFixup);

    while (endFixupPtr) {
	if (TclFixupForwardJumpToHere(envPtr, endFixupPtr, 127)) {

	    /*
	     * Adjust the immediately preceeding "ifFalse" jump. We moved it's
	     * target (just after this jump) down three bytes.
	     */

	    unsigned char *ifFalsePc = envPtr->codeStart
		    + falseFixupPtr->codeOffset;
	    unsigned char opCode = *ifFalsePc;

	    if (opCode == INST_JUMP_FALSE1) {
		jumpFalseDist = TclGetInt1AtPtr(ifFalsePc + 1);
		jumpFalseDist += 3;
		TclStoreInt1AtPtr(jumpFalseDist, (ifFalsePc + 1));
	    } else if (opCode == INST_JUMP_FALSE4) {
		jumpFalseDist = TclGetInt4AtPtr(ifFalsePc + 1);
		jumpFalseDist += 3;
		TclStoreInt4AtPtr(jumpFalseDist, (ifFalsePc + 1));
	    } else {
		Tcl_Panic("TclCompileIfCmd: unexpected opcode \"%d\" updating ifFalse jump", (int) opCode);
	    }
	}

	endFixupPtr = BA_JumpFixup_Detach(jumpEndFixup);
	falseFixupPtr = BA_JumpFixup_Detach(jumpFalseFixup);
    }

    /*
     * Free the jumpFixupArray array if malloc'ed storage was used.
     */

  done:
    BA_JumpFixup_Destroy(jumpFalseFixup);
    BA_JumpFixup_Destroy(jumpEndFixup);
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileIncrCmd --

    int flags,
    int line,
    CompileEnv *envPtr)
{
    Tcl_Token *endTokenPtr, *tokenPtr;
    int breakOffset = 0, count = 0, bline = line;
    Tcl_Parse parse;


    parse.commandStart = NULL;
    TclSubstParse(interp, bytes, numBytes, flags, &parse);




    /*
     * Tricky point! If the first token does not result in a *guaranteed* push
     * of a Tcl_Obj on the stack, we must push an empty object. Otherwise it
     * is possible to get to an INST_STR_CONCAT1 or INST_DONE without enough
     * values on the stack, resulting in a crash. Thanks to Joe Mistachkin for
     * identifying a script that could trigger this case.

	     * always TCL_TOKEN_TEXT...
	     */

	    if (tokenPtr->numComponents > 1) {
		int i, foundCommand = 0;

		for (i=2 ; i<=tokenPtr->numComponents ; i++) {
		    if (tokenPtr[i].type == TCL_TOKEN_SCRIPT_SUBST) {
			foundCommand = 1;
			break;
		    }
		}
		if (foundCommand) {
		    break;
		}

	envPtr->line = bline;
	catchRange = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
	OP4(	BEGIN_CATCH4, catchRange);
	ExceptionRangeStarts(envPtr, catchRange);

	switch (tokenPtr->type) {
	case TCL_TOKEN_SCRIPT_SUBST:
	    TclCompileTokens(interp, tokenPtr, tokenPtr->numComponents + 1,
		    envPtr);
	    count++;
	    break;
	case TCL_TOKEN_VARIABLE:
	    TclCompileVarSubst(interp, tokenPtr, envPtr);
	    count++;
	    break;
	case TCL_TOKEN_ERROR:
	    TclCompileTokens(interp, tokenPtr, 1, envPtr);
	    break;
	default:
	    Tcl_Panic("unexpected token type in TclCompileSubstCmd: %d",
		    tokenPtr->type);
	}

	ExceptionRangeEnds(envPtr, catchRange);

    while (count > 255) {
	OP1(	STR_CONCAT1, 255);
	count -= 254;
    }
    if (count > 1) {
	OP1(	STR_CONCAT1, count);
    }

    if (endTokenPtr[-1].type == TCL_TOKEN_ERROR) {
	/*
	 * Bytecode execution will only reach this point after a
	 * TCL_RETURN, TCL_CONTINUE, or other exception is raised.
	 * In those cases, we're at a +1 status in stack depth, so
	 * we POP before continuing with instructions to raise the
	 * syntax error message.
	 */
	OP(	POP);
	TclCompileTokens(interp, endTokenPtr - 1, 1, envPtr);
    }

    Tcl_FreeParse(&parse);







    /* Final target of the multi-jump from all BREAKs */
    if (breakOffset > 0) {
	TclUpdateInstInt4AtPc(INST_JUMP4, CurrentOffset(envPtr) - breakOffset,
		envPtr->codeStart + breakOffset);
    }
}


	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,		/* a-m */
	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,		/* n-z */
	BRACED		/* { */,	0		/* | or || */,
	INVALID		/* } */,	BIT_NOT		/* ~ */,
	INVALID		/* DEL */
};















/*
 * Declarations for local functions to this file:
 */

static void		CompileExprTree(Tcl_Interp *interp, OpNode *nodes,
			    int index, Tcl_Obj *const **litObjvPtr,
			    Tcl_Obj *const *funcObjv, Tcl_Token *tokenPtr,

	    tokenPtr = parsePtr->tokenPtr + wordIndex;
	    tokenPtr->type = TCL_TOKEN_WORD;
	    tokenPtr->start = start;
	    parsePtr->numTokens++;

	    switch (lexeme) {
	    case QUOTED:
		code = parseOnly ?  Tcl_ParseQuotedString(NULL, start,
			numBytes, parsePtr, 1, &end)
			: TclParseQuotedString(NULL, start, numBytes, parsePtr,
			PARSE_APPEND | PARSE_USE_INTERNAL_TOKENS, &end);
		scanned = end - start;
		break;

	    case BRACED:
		code = Tcl_ParseBraces(NULL, start, numBytes,
			parsePtr, 1, &end);
		scanned = end - start;
		break;

	    case VARIABLE:
		code = parseOnly ? Tcl_ParseVarName(NULL, start, numBytes,
			parsePtr, 1) : TclParseVarName(NULL, start, numBytes,
			parsePtr, PARSE_APPEND | PARSE_USE_INTERNAL_TOKENS);

		/*
		 * Handle the quirk that Tcl_ParseVarName reports a successful
		 * parse even when it gets only a "$" with no variable name.
		 */

		tokenPtr = parsePtr->tokenPtr + wordIndex + 1;
		if (code == TCL_OK && tokenPtr->type != TCL_TOKEN_VARIABLE) {
		    TclNewLiteralStringObj(msg, "invalid character \"$\"");
		    errCode = "BADCHAR";
		    goto error;
		}
		scanned = tokenPtr->size;
		break;

	    case SCRIPT:
	      if (parseOnly) {
		Tcl_Parse *nestedPtr =
			TclStackAlloc(interp, sizeof(Tcl_Parse));

		tokenPtr = parsePtr->tokenPtr + parsePtr->numTokens;
		tokenPtr->type = TCL_TOKEN_COMMAND;
		tokenPtr->start = start;
		tokenPtr->numComponents = 0;

		TclStackFree(interp, nestedPtr);
		end = start;
		start = tokenPtr->start;
		scanned = end - start;
		tokenPtr->size = scanned;
		parsePtr->numTokens++;
		break;

	      }
		code = TclParseScriptSubst(start, numBytes, parsePtr, 0);
		scanned = parsePtr->term + 1 - start;
		break;
	    }
	    if (code != TCL_OK) {
		/*
		 * Here we handle all the syntax errors generated by the
		 * Tcl_Token generating parsing routines called in the switch
		 * just above. If the value of parsePtr->incomplete is 1, then
		 * the error was an unbalanced '[', '(', '{', or '"' and

    Tcl_Token *tokenPtr,
    CompileEnv *envPtr,
    int optimize)
{
    OpNode *nodePtr = nodes + index;
    OpNode *rootPtr = nodePtr;
    int numWords = 0;
    JumpFixup *jumpPtr = NULL;
    BA_JumpFixup *stack = NULL;
    int convert = 1;

    while (1) {
	int next;


	if (nodePtr->mark == MARK_LEFT) {
	    next = nodePtr->left;

	    if (nodePtr->lexeme == QUESTION) {
		convert = 1;
	    }

		 */

		nodePtr->left = numWords;
		numWords = 2;	/* Command plus one argument */
		break;
	    }
	    case QUESTION:
		if (stack == NULL) {
		    stack = BA_JumpFixup_Create();
		}
		jumpPtr = BA_JumpFixup_Append(stack);
		TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, jumpPtr);
		break;
	    case COLON:


		jumpPtr = BA_JumpFixup_Append(stack);
		TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, jumpPtr);

		TclAdjustStackDepth(-1, envPtr);
		if (convert) {
		    jumpPtr->jumpType = TCL_TRUE_JUMP;
		}
		convert = 1;
		break;
	    case AND:
	    case OR:
		if (stack == NULL) {
		    stack = BA_JumpFixup_Create();
		}
		jumpPtr = BA_JumpFixup_Append(stack);
		TclEmitForwardJump(envPtr, (nodePtr->lexeme == AND)
			?  TCL_FALSE_JUMP : TCL_TRUE_JUMP, jumpPtr);
		break;
	    }
	} else {
	    int pc1, pc2, target;

	    switch (nodePtr->lexeme) {
	    case START:

		/*
		 * Each comma implies another function argument.
		 */

		numWords++;
		break;
	    case COLON:
		jumpPtr = BA_JumpFixup_Detach(stack);
		CLANG_ASSERT(jumpPtr);
		if (jumpPtr->jumpType == TCL_TRUE_JUMP) {
		    jumpPtr->jumpType = TCL_UNCONDITIONAL_JUMP;
		    convert = 1;
		}
		target = jumpPtr->codeOffset + 2;
		if (TclFixupForwardJumpToHere(envPtr, jumpPtr, 127)) {
		    target += 3;
		}

		jumpPtr = BA_JumpFixup_Detach(stack);

		TclFixupForwardJump(envPtr, jumpPtr,
			target - jumpPtr->codeOffset, 127);




		break;
	    case AND:
	    case OR:
		jumpPtr = BA_JumpFixup_Detach(stack);
		CLANG_ASSERT(jumpPtr);
		pc1 = CurrentOffset(envPtr);
		TclEmitInstInt1((nodePtr->lexeme == AND) ? INST_JUMP_FALSE1
			: INST_JUMP_TRUE1, 0, envPtr);
		TclEmitPush(TclRegisterNewLiteral(envPtr,
			(nodePtr->lexeme == AND) ? "1" : "0", 1), envPtr);
		pc2 = CurrentOffset(envPtr);
		TclEmitInstInt1(INST_JUMP1, 0, envPtr);
		TclAdjustStackDepth(-1, envPtr);
		TclStoreInt1AtPtr(CurrentOffset(envPtr) - pc1,
			envPtr->codeStart + pc1 + 1);
		if (TclFixupForwardJumpToHere(envPtr, jumpPtr, 127)) {
		    pc2 += 3;
		}
		TclEmitPush(TclRegisterNewLiteral(envPtr,
			(nodePtr->lexeme == AND) ? "0" : "1", 1), envPtr);
		TclStoreInt1AtPtr(CurrentOffset(envPtr) - pc2,
			envPtr->codeStart + pc2 + 1);
		convert = 0;



		break;
	    default:
		TclEmitOpcode(instruction[nodePtr->lexeme], envPtr);
		convert = 0;
		break;
	    }
	    if (nodePtr == rootPtr) {
		/* We're done */

		if (stack) {
		    BA_JumpFixup_Destroy(stack);
		}
		return;
	    }
	    nodePtr = nodes + nodePtr->p.parent;
	    continue;
	}

	nodePtr->mark++;

 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"
#include <assert.h>
#include "tclBrodnik.h"

/*
 * Structure used to map between instruction pc and source locations. It
 * defines for each compiled Tcl command its code's starting offset and its
 * source's starting offset and length. Note that the code offset increases
 * monotonically: that is, the table is sorted in code offset order. The
 * source offset is not monotonic.
 */

typedef struct CmdLocation {
    int codeOffset;		/* Offset of first byte of command code. */
    int numCodeBytes;		/* Number of bytes for command's code. */
    int srcOffset;		/* Offset of first char of the command. */
    int numSrcBytes;		/* Number of command source chars. */
} CmdLocation;
TclBrodnikArray(CmdLocation);
TclBrodnikArrayDefine(AuxData,MODULE_SCOPE);

/*
 * Table of all AuxData types.
 */

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

    {NULL, 0, 0, 0, {OPERAND_NONE}}
};

/*
 * Prototypes for procedures defined later in this file:
 */

static void		CompileScriptTokens(Tcl_Interp *interp,
			    Tcl_Token *tokens, Tcl_Token *lastTokenPtr,
			    CompileEnv *envPtr);
static ByteCode *	CompileSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    int flags);
static void		DupByteCodeInternalRep(Tcl_Obj *srcPtr,
			    Tcl_Obj *copyPtr);
static unsigned char *	EncodeCmdLocMap(CompileEnv *envPtr,
			    ByteCode *codePtr, unsigned char *startPtr);


static CmdLocation *	EnterCmdStartData(CompileEnv *envPtr,
			    int srcOffset, int codeOffset);
static void		FreeByteCodeInternalRep(Tcl_Obj *objPtr);
static void		FreeSubstCodeInternalRep(Tcl_Obj *objPtr);
static int		GetCmdLocEncodingSize(CompileEnv *envPtr);
static int		IsCompactibleCompileEnv(Tcl_Interp *interp,
			    CompileEnv *envPtr);
#ifdef TCL_COMPILE_STATS
static void		RecordByteCodeStats(ByteCode *codePtr);

void
TclCleanupByteCode(
    register ByteCode *codePtr)	/* Points to the ByteCode to free. */
{
    Tcl_Interp *interp = (Tcl_Interp *) *codePtr->interpHandle;
    Interp *iPtr = (Interp *) interp;
    int numLitObjects = codePtr->numLitObjects;

    register Tcl_Obj **objArrayPtr, *objPtr;
    AuxData *auxDataPtr;
    int i;
#ifdef TCL_COMPILE_STATS

    if (interp != NULL) {
	ByteCodeStats *statsPtr;
	Tcl_Time destroyTime;
	int lifetimeSec, lifetimeMicroSec, log2;

	statsPtr = &iPtr->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)
		BA_AuxData_Size(codePtr->auxData) * sizeof(AuxData);
	statsPtr->currentCmdMapBytes -= (double) codePtr->numCmdLocBytes;

	Tcl_GetTime(&destroyTime);
	lifetimeSec = destroyTime.sec - codePtr->createTime.sec;
	if (lifetimeSec > 2000) {	/* avoid overflow */
	    lifetimeSec = 2000;
	}

	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 literal values in its literal array,
     * 2) call the free procs for the auxiliary data items, 3) free the
     * localCache if it is unused, and finally 4) 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

    } else {
	objArrayPtr = codePtr->objArrayPtr;
	while (numLitObjects--) {
	    /* TclReleaseLiteral calls Tcl_DecrRefCount() for us */
	    TclReleaseLiteral(interp, *objArrayPtr++);
	}
    }
    if (codePtr->flags & TCL_BYTECODE_FREE_LITERALS) {
	ckfree(codePtr->objArrayPtr);
    }

    if (codePtr->auxData) {
	BA_AuxData *adArray = codePtr->auxData;

	codePtr->auxData = NULL;
	auxDataPtr = BA_AuxData_Detach(adArray);
	while (auxDataPtr) {
	    if (auxDataPtr->type->freeProc != NULL) {
		auxDataPtr->type->freeProc(auxDataPtr->clientData);
	    }
	    auxDataPtr = BA_AuxData_Detach(adArray);
	}
	BA_AuxData_Destroy(adArray);
    }

    /*
     * TIP #280. Release the location data associated with this byte code
     * structure, if any. NOTE: The interp we belong to may be gone already,
     * and the data with it.
     *

    envPtr->procPtr = iPtr->compiledProcPtr;
    iPtr->compiledProcPtr = NULL;
    envPtr->numCommands = 0;
    envPtr->exceptDepth = 0;
    envPtr->maxExceptDepth = 0;
    envPtr->maxStackDepth = 0;
    envPtr->currStackDepth = 0;
    Tcl_InitHashTable(&envPtr->litMap, TCL_ONE_WORD_KEYS);

    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->exceptAuxArrayPtr = envPtr->staticExAuxArraySpace;
    envPtr->exceptArrayNext = 0;
    envPtr->exceptArrayEnd = COMPILEENV_INIT_EXCEPT_RANGES;
    envPtr->mallocedExceptArray = 0;

    envPtr->cmdMap = BA_CmdLocation_Create();


    envPtr->atCmdStart = 1;
    envPtr->expandCount = 0;

    /*
     * TIP #280: Set up the extended command location information, based on
     * the context invoking the byte code compiler. This structure is used to
     * keep the per-word line information for all compiled commands.

     * Initialize the data about invisible continuation lines as empty, i.e.
     * not used. The caller (TclSetByteCodeFromAny) will set this up, if such
     * data is available.
     */

    envPtr->clNext = NULL;


    envPtr->auxData = NULL;


}

/*
 *----------------------------------------------------------------------
 *
 * TclFreeCompileEnv --
 *

 *----------------------------------------------------------------------
 */

void
TclFreeCompileEnv(
    register CompileEnv *envPtr)/* Points to the CompileEnv structure. */
{

    Tcl_DeleteHashTable(&envPtr->litMap);


    if (envPtr->iPtr) {
	/* 
	 * We never converted to Bytecode, so free the things we would
	 * have transferred to it.
	 */

	int i;
	Tcl_Obj **litPtr = envPtr->literalArrayPtr;


	for (i = 0;  i < envPtr->literalArrayNext;  i++) {
	    TclReleaseLiteral((Tcl_Interp *)envPtr->iPtr, *litPtr++);

	}

#ifdef TCL_COMPILE_DEBUG
	TclVerifyGlobalLiteralTable(envPtr->iPtr);
#endif /*TCL_COMPILE_DEBUG*/

	if (envPtr->auxData) {
	    BA_AuxData *adArray = envPtr->auxData;
	    AuxData *auxDataPtr;

	    envPtr->auxData = NULL;
	    auxDataPtr = BA_AuxData_Detach(adArray);
	    while (auxDataPtr) {
		if (auxDataPtr->type->freeProc != NULL) {
		    auxDataPtr->type->freeProc(auxDataPtr->clientData);
		}
		auxDataPtr = BA_AuxData_Detach(adArray);
	    }
	    BA_AuxData_Destroy(adArray);
	}
    }
    if (envPtr->mallocedCodeArray) {
	ckfree(envPtr->codeStart);
    }
    if (envPtr->mallocedLiteralArray && envPtr->iPtr) {
	ckfree(envPtr->literalArrayPtr);
    }
    if (envPtr->mallocedExceptArray) {
	ckfree(envPtr->exceptArrayPtr);
	ckfree(envPtr->exceptAuxArrayPtr);
    }

    BA_CmdLocation_Destroy(envPtr->cmdMap);




    if (envPtr->extCmdMapPtr) {
	ReleaseCmdWordData(envPtr->extCmdMapPtr);
	envPtr->extCmdMapPtr = NULL;
    }
}

/*

    if (cmdPtr) {
	TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLitIdx), cmdPtr);
    }
    TclEmitPush(cmdLitIdx, envPtr);
}

Tcl_Token *
TclCompileInvocation(
    Tcl_Interp *interp,
    Tcl_Token *tokenPtr,
    Tcl_Obj *cmdObj,
    int numWords,
    CompileEnv *envPtr)
{

    if (wordIdx <= 255) {
	TclEmitInvoke(envPtr, INST_INVOKE_STK1, wordIdx);
    } else {
	TclEmitInvoke(envPtr, INST_INVOKE_STK4, wordIdx);
    }
    TclCheckStackDepth(depth+1, envPtr);

    return tokenPtr;
}

static Tcl_Token *
CompileExpanded(
    Tcl_Interp *interp,
    Tcl_Token *tokenPtr,
    Tcl_Obj *cmdObj,
    int numWords,
    CompileEnv *envPtr)
{
    int wordIdx = 0;

    int depth = TclGetStackDepth(envPtr);
    DefineLineInformation;

    StartExpanding(envPtr);
    if (cmdObj) {
	CompileCmdLiteral(interp, cmdObj, envPtr);
	wordIdx = 1;
	tokenPtr = TokenAfter(tokenPtr);
    }

     *
     * Note that the estimates are not correct while the command is being
     * prepared and run, INST_EXPAND_STKTOP is not stack-neutral in general.
     */

    TclEmitInvoke(envPtr, INST_INVOKE_EXPANDED, wordIdx);
    TclCheckStackDepth(depth+1, envPtr);

    return tokenPtr;
}

static int 
CompileCmdCompileProc(
    Tcl_Interp *interp,
    Tcl_Token *tokenPtr,
    Command *cmdPtr,
    CompileEnv *envPtr)
{
    int unwind = 0, incrOffset = -1;
    Tcl_Parse parse;
    int depth = TclGetStackDepth(envPtr);
    DefineLineInformation;

    parse.commandStart = tokenPtr->start;
    parse.commandSize = tokenPtr->size;
    parse.numWords = tokenPtr->numComponents;
    parse.tokenPtr = tokenPtr + 1;

    /*
     * Emit of the INST_START_CMD instruction is controlled by the value of
     * envPtr->atCmdStart:
     *
     * atCmdStart == 2	: We are not using the INST_START_CMD instruction.
     * atCmdStart == 1	: INST_START_CMD was the last instruction emitted.

	}
	break;
    case 2:
	/* Nothing to do */
	;
    }

    if (TCL_OK == TclAttemptCompileProc(interp, &parse, 1, cmdPtr, envPtr)) {
	if (incrOffset >= 0) {
	    /*
	     * We successfully compiled a command.  Increment the number of
	     * commands that start at the currently active INST_START_CMD.
	     */

	    unsigned char *incrPtr = envPtr->codeStart + incrOffset;

    }

    /*
     * Reset the index of next command.  Toss out any from failed nested
     * partial compiles.
     */

    TclDisposeFailedCompile(envPtr, mapPtr->nuloc);
    return TCL_ERROR;
}

void
TclDisposeFailedCompile(
    CompileEnv *envPtr,
    int numCommands)
{
    while (envPtr->numCommands > numCommands) {
	(void) BA_CmdLocation_Detach(envPtr->cmdMap);
	envPtr->numCommands--;
    }
}

static Tcl_Token *
CompileCommandTokens(
    Tcl_Interp *interp,
    Tcl_Token *commandTokenPtr,
    CompileEnv *envPtr,
    CmdLocation **cmdLocPtrPtr)
{
    Interp *iPtr = (Interp *) interp;

    Tcl_Token *tokenPtr = commandTokenPtr;
    int numWords = tokenPtr->numComponents;
    const char *commandStart = tokenPtr->start;
    int commandSize = tokenPtr->size;

    ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
    Tcl_Obj *cmdObj = Tcl_NewObj();
    Command *cmdPtr = NULL;
    CmdLocation *cmdLocPtr = NULL;
    int code = TCL_ERROR;
    int cmdKnown, expand = -1;
    int *wlines, wlineat;
    int cmdLine = envPtr->line;
    int *clNext = envPtr->clNext;

    int startCodeOffset = envPtr->codeNext - envPtr->codeStart;
    int depth = TclGetStackDepth(envPtr);
    
    assert (numWords > 0);

    /* Pre-Compile */

    tokenPtr++;
    envPtr->numCommands++;
    cmdLocPtr = EnterCmdStartData(envPtr, commandStart - envPtr->source,
	    startCodeOffset);

    /*
     * TIP #280. Scan the words and compute the extended location information.
     * The map first contain full per-word line information for use by the
     * compiler. This is later replaced by a reduced form which signals
     * non-literal words, stored in 'wlines'.
     */

    EnterCmdWordData(eclPtr, commandStart - envPtr->source,

	    tokenPtr, commandStart, commandSize, numWords, cmdLine,
	    clNext, &wlines, envPtr);
    wlineat = eclPtr->nuloc - 1;

    envPtr->line = eclPtr->loc[wlineat].line[0];
    envPtr->clNext = eclPtr->loc[wlineat].next[0];

    /* Do we know the command word? */
    Tcl_IncrRefCount(cmdObj);

    cmdKnown = TclWordKnownAtCompileTime(tokenPtr, cmdObj);

    /* Is this a command we should (try to) compile with a compileProc ? */
    if (cmdKnown && !(iPtr->flags & DONT_COMPILE_CMDS_INLINE)) {
	cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj);
	if (cmdPtr) {
	    /*
	     * Found a command.  Test the ways we can be told not to attempt
	     * to compile it.
	     */
	    if ((cmdPtr->compileProc == NULL)
		    || (cmdPtr->nsPtr->flags & NS_SUPPRESS_COMPILATION)
		    || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {
		cmdPtr = NULL;
	    }
	}
	if (cmdPtr && !(cmdPtr->flags & CMD_COMPILES_EXPANDED)) {
	    expand = ExpandRequested(tokenPtr, numWords);
	    if (expand) {
		/* We need to expand, but compileProc cannot. */
		cmdPtr = NULL;
	    }
	}
    }

    /* If cmdPtr != NULL, we will try to call cmdPtr->compileProc */
    if (cmdPtr) {
	code = CompileCmdCompileProc(interp, commandTokenPtr, cmdPtr, envPtr);
    }

    if (code == TCL_ERROR) {
	if (expand < 0) {
	    expand = ExpandRequested(tokenPtr, numWords);
	}

	if (expand) {
	    tokenPtr = CompileExpanded(interp, tokenPtr,
		    cmdKnown ? cmdObj : NULL, numWords, envPtr);
	} else {
	    tokenPtr = TclCompileInvocation(interp, tokenPtr,
		    cmdKnown ? cmdObj : NULL, numWords, envPtr);
	}
    } else {
	while (numWords--) {
	    tokenPtr = TokenAfter(tokenPtr);
	}
    }

    Tcl_DecrRefCount(cmdObj);

    TclEmitOpcode(INST_POP, envPtr);

    cmdLocPtr->numSrcBytes = commandSize;
    cmdLocPtr->numCodeBytes = (envPtr->codeNext-envPtr->codeStart)
	    - startCodeOffset;

    /*
     * TIP #280: Free full form of per-word line data and insert the reduced
     * form now
     */

    envPtr->line = cmdLine;
    envPtr->clNext = clNext;
    ckfree(eclPtr->loc[wlineat].line);
    ckfree(eclPtr->loc[wlineat].next);
    eclPtr->loc[wlineat].line = wlines;
    eclPtr->loc[wlineat].next = NULL;

    *cmdLocPtrPtr = cmdLocPtr;
    TclCheckStackDepth(depth, envPtr);

    return tokenPtr;
}

void
TclCompileScript(
    Tcl_Interp *interp,		/* Used for error and status reporting. Also
				 * serves as context for finding and compiling
				 * commands. May not be NULL. */
    const 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. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *lastTokenPtr;
    Tcl_Token *tokens;

    if (envPtr->iPtr == NULL) {
	Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv");
    }
    tokens = TclParseScript(interp, script, numBytes, /* flags */ 0,
	    &lastTokenPtr, NULL);
    CompileScriptTokens(interp, tokens, lastTokenPtr, envPtr);
    ckfree(tokens);
}

static void
CompileScriptTokens(interp, tokens, lastTokenPtr, envPtr)
    Tcl_Interp *interp;		/* Used for error and status reporting.
				 * Also serves as context for finding and
				 * compiling commands.  May not be NULL. */
    Tcl_Token *tokens;
    Tcl_Token *lastTokenPtr;
    CompileEnv *envPtr;		/* Holds resulting instructions. */
{
    Tcl_Token *tokenPtr;
    int numCommands = tokens[0].numComponents;
    int depth = TclGetStackDepth(envPtr);
    CmdLocation *cmdLocPtr = NULL;	/* Pointer into envPtr->cmdMap for
					 * the last command this routine
					 * compiles into bytecode;  If we
					 * exit still value NULL, there
					 * was no bytecode generated. */

    if (lastTokenPtr < tokens) {
	Tcl_Panic("CompileScriptTokens: parse produced no tokens");
    }
    if (tokens[0].type != TCL_TOKEN_SCRIPT) {
        Tcl_Panic("CompileScriptTokens: invalid token array, expected script");
    }	 
    if (envPtr->iPtr == NULL) {
	Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv");
    }

    tokenPtr = &(tokens[1]);
    if (numCommands) {
	TclAdvanceLines(&envPtr->line, tokens[0].start, tokenPtr->start);
	TclAdvanceContinuations(&envPtr->line, &envPtr->clNext,
		tokenPtr->start - envPtr->source);
    }

    while (numCommands--) {

	int numWords = tokenPtr->numComponents;
	const char * commandStart = tokenPtr->start;



	if (tokenPtr > lastTokenPtr) {
	    Tcl_Panic("CompileScriptTokens: overran token array");

	}
        if (tokenPtr->type != TCL_TOKEN_CMD) {
            Tcl_Panic("CompileScriptTokens: invalid token array, expected cmd: %d: %.*s", tokenPtr->type, tokenPtr->size, tokenPtr->start);
        }

	/* TODO: comment here justifying. */
	if (numWords == 0) {
	    tokenPtr++;
	    continue;
	}
	
#ifdef TCL_COMPILE_DEBUG
	/*
	 * If tracing, print a line for each top level command compiled.

	 */

	if ((tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) {

	    fprintf(stdout, "  Compiling: ");
	    TclPrintSource(stdout, commandStart, TclMin(tokenPtr->size, 55));

	    fprintf(stdout, "\n");
	}
#endif






































	tokenPtr = CompileCommandTokens(interp, tokenPtr, envPtr, &cmdLocPtr);

	/*
	 * TIP #280: Track lines in the just compiled command.
	 */

	if (numCommands) {
	    TclAdvanceLines(&envPtr->line, commandStart, tokenPtr->start);
	    TclAdvanceContinuations(&envPtr->line, &envPtr->clNext,
		    tokenPtr->start - envPtr->source);

	}
    }
    if (tokenPtr <= lastTokenPtr) {
	TclCompileTokens(interp, tokenPtr, lastTokenPtr-tokenPtr+1, envPtr);
    } else if (cmdLocPtr == NULL) {
	/*
	 * Compiling the script yielded no bytecode.  The script must be all
	 * whitespace, comments, and empty commands.  Such scripts are defined
	 * to successfully produce the empty string result, so we emit the
	 * simple bytecode that makes that happen.
	 */

	PushStringLiteral(envPtr, "");
    } else {
	/*
	 * We compiled at least one command to bytecode.  The routine
	 * CompileCommandTokens() follows the bytecode of each compiled
	 * command with an INST_POP, so that stack balance is maintained when
	 * several commands are in sequence.  (The result of each command is
	 * thrown away before moving on to the next command).  For the last
	 * command compiled, we need to undo that INST_POP so that the result
	 * of the last command becomes the result of the script.  The code
	 * here removes that trailing INST_POP.
	 */

	cmdLocPtr->numCodeBytes--;
	envPtr->codeNext--;
	envPtr->currStackDepth++;
    }
    TclCheckStackDepth(depth+1, envPtr);
}

/*

		    clPosition[numCL] = clPos;
		    numCL ++;
		}
		adjust++;
	    }
	    break;



























	case TCL_TOKEN_VARIABLE:
	    /*
	     * Push any accumulated chars appearing before the $<var>.
	     */

	    if (Tcl_DStringLength(&textBuffer) > 0) {
		int literal;

		literal = TclRegisterDStringLiteral(envPtr, &textBuffer);
		TclEmitPush(literal, envPtr);
		numObjsToConcat++;
		Tcl_DStringFree(&textBuffer);
	    }

	    TclCompileVarSubst(interp, tokenPtr, envPtr);
	    numObjsToConcat++;
	    count -= tokenPtr->numComponents;
	    tokenPtr += tokenPtr->numComponents;
	    break;

	case TCL_TOKEN_SCRIPT_SUBST:
	    /*
	     * Push any accumulated chars appearing before the command.
	     */

	    if (Tcl_DStringLength(&textBuffer) > 0) {
		int literal = TclRegisterDStringLiteral(envPtr, &textBuffer);
		TclEmitPush(literal, envPtr);
		numObjsToConcat++;
		Tcl_DStringFree(&textBuffer);
	    }

	    if (count <= tokenPtr->numComponents) {
		Tcl_Panic("token components overflow token array");
	    }
		
	    envPtr->line += adjust;
	    CompileScriptTokens(interp, tokenPtr+1,
		    tokenPtr + (tokenPtr->numComponents), envPtr);
	    envPtr->line -= adjust;
	    numObjsToConcat++;
	    count -= tokenPtr->numComponents;
	    tokenPtr += tokenPtr->numComponents;
	    break;

	case TCL_TOKEN_ERROR:
	    /* Compile bytecodes to report the parse error at runtime. */
	    TclSubstTokens(interp, tokenPtr, 1, NULL, 1, NULL, NULL, 0);
	    Tcl_LogCommandInfo(interp, envPtr->source,
		    tokenPtr->start, tokenPtr->size);
	    TclCompileSyntaxError(interp, envPtr);
	    goto done;

	default:
	    Tcl_Panic("Unexpected token type in TclCompileTokens: %d; %.*s",
		    tokenPtr->type, tokenPtr->size, tokenPtr->start);
	}
    }

    /*
     * If the tokens yielded no instructions, push an empty string.
     */

    if (envPtr->codeNext == entryCodeNext) {
	PushStringLiteral(envPtr, "");
    }
done:
    Tcl_DStringFree(&textBuffer);

    /*
     * Release the temp table we used to collect the locations of continuation
     * lines, if any.
     */

				 * 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 structureSize;
    register unsigned char *p;
#ifdef TCL_COMPILE_DEBUG
    unsigned char *nextPtr;
#endif
    int numLitObjects = envPtr->literalArrayNext;
    Namespace *namespacePtr;
    int isNew;
    Interp *iPtr;
    Tcl_HashEntry *hePtr = NULL;

    if (envPtr->iPtr == NULL) {
	Tcl_Panic("TclInitByteCodeObj() called on uninitialized CompileEnv");
    }

    iPtr = envPtr->iPtr;

    codeBytes = envPtr->codeNext - envPtr->codeStart;
    objArrayBytes = envPtr->mallocedLiteralArray ? 0 :
	    envPtr->literalArrayNext * sizeof(Tcl_Obj *);
    exceptArrayBytes = envPtr->exceptArrayNext * sizeof(ExceptionRange);

    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 += cmdLocBytes;

    if (envPtr->iPtr->varFramePtr != NULL) {
	namespacePtr = envPtr->iPtr->varFramePtr->nsPtr;
    } else {
	namespacePtr = envPtr->iPtr->globalNsPtr;
    }

    codePtr->procPtr = envPtr->procPtr;

    codePtr->numCommands = envPtr->numCommands;
    codePtr->numSrcBytes = envPtr->numSrcBytes;
    codePtr->numCodeBytes = codeBytes;
    codePtr->numLitObjects = numLitObjects;
    codePtr->numExceptRanges = envPtr->exceptArrayNext;

    codePtr->numCmdLocBytes = cmdLocBytes;
    codePtr->maxExceptDepth = envPtr->maxExceptDepth;
    codePtr->maxStackDepth = envPtr->maxStackDepth;

    p += sizeof(ByteCode);
    codePtr->codeStart = p;
    memcpy(p, envPtr->codeStart, (size_t) codeBytes);

    p += TCL_ALIGN(codeBytes);		/* align object array */




    hePtr = Tcl_FindHashEntry(&envPtr->litMap, objPtr);
    if (hePtr) {
	/*
	 * Prevent circular reference where the bytecode intrep of
	 * a value contains a literal which is that same value.
	 * If this is allowed to happen, refcount decrements may not
	 * reach zero, and memory may leak.  Bugs 467523, 3357771
	 *
	 * NOTE:  [Bugs 3392070, 3389764] We make a copy based completely
	 * on the string value, and do not call Tcl_DuplicateObj() so we
         * can be sure we do not have any lingering cycles hiding in
	 * the intrep.
	 */

	int numBytes, i = PTR2INT(Tcl_GetHashValue(hePtr));
	const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes);

	envPtr->literalArrayPtr[i] = Tcl_NewStringObj(bytes, numBytes);
	Tcl_IncrRefCount(envPtr->literalArrayPtr[i]);
	TclReleaseLiteral((Tcl_Interp *)iPtr, objPtr);
    }

    if (envPtr->mallocedLiteralArray) {
	codePtr->objArrayPtr = envPtr->literalArrayPtr;
	codePtr->flags |= TCL_BYTECODE_FREE_LITERALS;
    } else {
	codePtr->objArrayPtr = (Tcl_Obj **) p;
	memcpy(p, envPtr->literalArrayPtr, (size_t) objArrayBytes);
	p += TCL_ALIGN(objArrayBytes);	/* align exception range array */
    }



    if (exceptArrayBytes > 0) {
	codePtr->exceptArrayPtr = (ExceptionRange *) p;
	memcpy(p, envPtr->exceptArrayPtr, (size_t) exceptArrayBytes);
    } else {
	codePtr->exceptArrayPtr = NULL;
    }

    p += exceptArrayBytes;

    codePtr->auxData = envPtr->auxData;


    envPtr->auxData = NULL;



#ifndef TCL_COMPILE_DEBUG
    EncodeCmdLocMap(envPtr, codePtr, (unsigned char *) p);
#else
    nextPtr = EncodeCmdLocMap(envPtr, codePtr, (unsigned char *) p);
    if (((size_t)(nextPtr - p)) != cmdLocBytes) {
	Tcl_Panic("TclInitByteCodeObj: encoded cmd location bytes %lu != expected size %lu", (unsigned long)(nextPtr - p), (unsigned long)cmdLocBytes);
    }

 *	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 CmdLocation *
EnterCmdStartData(
    CompileEnv *envPtr,		/* Points to the compilation environment
				 * structure in which to enter command
				 * location information. */


    int srcOffset,		/* Offset of first char of the command. */
    int codeOffset)		/* Offset of first byte of command code. */
{
    CmdLocation *cmdLocPtr = BA_CmdLocation_Append(envPtr->cmdMap);









































    cmdLocPtr->codeOffset = codeOffset;
    cmdLocPtr->srcOffset = srcOffset;
    cmdLocPtr->numSrcBytes = -1;
    cmdLocPtr->numCodeBytes = -1;

































    return cmdLocPtr;













}

/*
 *----------------------------------------------------------------------
 * TIP #280
 *
 * EnterCmdWordData --

	auxPtr->numContinueTargets = 0;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclFetchAuxData --
 *
 *	Fetch back from the CompileEnv an item of AuxData stored at
 *	index.
 *
 * Results:
 *	The ClientData previously stored by TclCreatAuxData().
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

ClientData
TclFetchAuxData(
    CompileEnv *envPtr,		/* CompileEnv from which to fetch */
    int index)			/* Index of AuxData to fetch */
{
    if (envPtr->auxData == NULL) {
	return NULL;
    }
    return BA_AuxData_At(envPtr->auxData, index)->clientData;
}

/*
 *----------------------------------------------------------------------
 *
 * 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.
 *

    ClientData clientData,	/* The compilation auxiliary data to store in
				 * the new aux data record. */
    const 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. */
{


    AuxData *auxDataPtr;	/* Points to the new AuxData structure */

    if (envPtr->auxData == NULL) {












	envPtr->auxData = BA_AuxData_Create();






    }








    auxDataPtr = BA_AuxData_Append(envPtr->auxData);


    auxDataPtr->clientData = clientData;
    auxDataPtr->type = typePtr;


    return (int) (BA_AuxData_Size(envPtr->auxData) - 1);











































































































}

/*
 *----------------------------------------------------------------------
 *
 * TclEmitForwardJump --
 *

    JumpFixup *jumpFixupPtr,	/* Points to the JumpFixup structure that
				 * describes the forward jump. */
    int jumpDist,		/* Jump distance to set in jump instr. */
    int distThreshold)		/* Maximum distance before the two byte jump
				 * is grown to five bytes. */
{
    unsigned char *jumpPc, *p;
    int firstRange, lastRange, k;
    unsigned numBytes;
    CmdLocation *cmdLocPtr = NULL;
    BP_CmdLocation ptr;

    if (jumpDist <= distThreshold) {
	jumpPc = envPtr->codeStart + jumpFixupPtr->codeOffset;
	switch (jumpFixupPtr->jumpType) {
	case TCL_UNCONDITIONAL_JUMP:
	    TclUpdateInstInt1AtPc(INST_JUMP1, jumpDist, jumpPc);
	    break;

    }

    /*
     * Adjust the code offsets for any commands and any ExceptionRange records
     * between the jump and the current code address.
     */

    for (cmdLocPtr = BA_CmdLocation_Get(envPtr->cmdMap,
	    jumpFixupPtr->cmdIndex, &ptr); cmdLocPtr;

	    cmdLocPtr = BP_CmdLocation_Next(&ptr)) {

	cmdLocPtr->codeOffset += 3;

    }

    firstRange = jumpFixupPtr->exceptIndex;
    lastRange = envPtr->exceptArrayNext - 1;
    for (k = firstRange;  k <= lastRange;  k++) {
	ExceptionRange *rangePtr = &envPtr->exceptArrayPtr[k];

    }
    Tcl_MutexUnlock(&tableMutex);
}

/*
 *----------------------------------------------------------------------
 *
 * TclCmdStartAddress --
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Deletes all entries in the hash table of AuxData types.
 *
 *----------------------------------------------------------------------
 */

void *
TclCmdStartAddress(
    CompileEnv *envPtr,
    int i)
{
    BA_CmdLocation *map = envPtr->cmdMap;

    return envPtr->codeStart + BA_CmdLocation_At(map, i)->codeOffset;
}

/*
 *----------------------------------------------------------------------
 *
 * GetCmdLocEncodingSize --
 *
 *	Computes the total number of bytes needed to encode the command
 *	location information for some compiled code.
 *
 * Results:
 *	The byte count needed to encode the compiled location information.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
GetCmdLocEncodingSize(
    CompileEnv *envPtr)		/* Points to compilation environment structure
				 * containing the CmdLocation structure to
				 * encode. */
{


    int codeDelta, codeLen, srcDelta, srcLen;
    int codeDeltaNext, codeLengthNext, srcDeltaNext, srcLengthNext;
				/* The offsets in their respective byte
				 * sequences where the next encoded offset or
				 * length should go. */
    int prevCodeOffset, prevSrcOffset;
    BA_CmdLocation *map = envPtr->cmdMap;
    CmdLocation *cmdLocPtr;
    BP_CmdLocation ptr;

    codeDeltaNext = codeLengthNext = srcDeltaNext = srcLengthNext = 0;
    prevCodeOffset = prevSrcOffset = 0;
    for (cmdLocPtr = BA_CmdLocation_First(map, &ptr); cmdLocPtr;
	    cmdLocPtr = BP_CmdLocation_Next(&ptr)) {
	codeDelta = cmdLocPtr->codeOffset - prevCodeOffset;
	if (codeDelta < 0) {
	    Tcl_Panic("GetCmdLocEncodingSize: bad code offset");
	} else if (codeDelta <= 127) {
	    codeDeltaNext++;
	} else {
	    codeDeltaNext += 5;	/* 1 byte for 0xFF, 4 for positive delta */
	}
	prevCodeOffset = cmdLocPtr->codeOffset;

	codeLen = cmdLocPtr->numCodeBytes;
	if (codeLen < 0) {
	    Tcl_Panic("GetCmdLocEncodingSize: bad code length");
	} else if (codeLen <= 127) {
	    codeLengthNext++;
	} else {
	    codeLengthNext += 5;/* 1 byte for 0xFF, 4 for length */
	}

	srcDelta = cmdLocPtr->srcOffset - prevSrcOffset;
	if ((-127 <= srcDelta) && (srcDelta <= 127) && (srcDelta != -1)) {
	    srcDeltaNext++;
	} else {
	    srcDeltaNext += 5;	/* 1 byte for 0xFF, 4 for delta */
	}
	prevSrcOffset = cmdLocPtr->srcOffset;

	srcLen = cmdLocPtr->numSrcBytes;
	if (srcLen < 0) {
	    Tcl_Panic("GetCmdLocEncodingSize: bad source length");
	} else if (srcLen <= 127) {
	    srcLengthNext++;
	} else {
	    srcLengthNext += 5;	/* 1 byte for 0xFF, 4 for length */
	}

				 * encode. */
    ByteCode *codePtr,		/* ByteCode in which to encode envPtr's
				 * command location information. */
    unsigned char *startPtr)	/* Points to the first byte in codePtr's
				 * memory block where the location information
				 * is to be stored. */
{


    register unsigned char *p = startPtr;
    int codeDelta, codeLen, srcDelta, srcLen, prevOffset;
    BA_CmdLocation *map = envPtr->cmdMap;
    BP_CmdLocation ptr;
    CmdLocation *cmdLocPtr;

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

    codePtr->codeDeltaStart = p;
    prevOffset = 0;
    for (cmdLocPtr = BA_CmdLocation_First(map, &ptr);  cmdLocPtr;
	    cmdLocPtr = BP_CmdLocation_Next(&ptr)) {
	codeDelta = cmdLocPtr->codeOffset - prevOffset;
	if (codeDelta < 0) {
	    Tcl_Panic("EncodeCmdLocMap: bad code offset");
	} else if (codeDelta <= 127) {
	    TclStoreInt1AtPtr(codeDelta, p);
	    p++;
	} else {
	    TclStoreInt1AtPtr(0xFF, p);
	    p++;
	    TclStoreInt4AtPtr(codeDelta, p);
	    p += 4;
	}
	prevOffset = cmdLocPtr->codeOffset;
    }

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

    codePtr->codeLengthStart = p;
    for (cmdLocPtr = BA_CmdLocation_First(map, &ptr);  cmdLocPtr;
	    cmdLocPtr = BP_CmdLocation_Next(&ptr)) {
	codeLen = cmdLocPtr->numCodeBytes;
	if (codeLen < 0) {
	    Tcl_Panic("EncodeCmdLocMap: bad code length");
	} else if (codeLen <= 127) {
	    TclStoreInt1AtPtr(codeLen, p);
	    p++;
	} else {
	    TclStoreInt1AtPtr(0xFF, p);
	    p++;
	    TclStoreInt4AtPtr(codeLen, p);
	    p += 4;
	}
    }

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

    codePtr->srcDeltaStart = p;
    prevOffset = 0;
    for (cmdLocPtr = BA_CmdLocation_First(map, &ptr);  cmdLocPtr;
	    cmdLocPtr = BP_CmdLocation_Next(&ptr)) {
	srcDelta = cmdLocPtr->srcOffset - prevOffset;
	if ((-127 <= srcDelta) && (srcDelta <= 127) && (srcDelta != -1)) {
	    TclStoreInt1AtPtr(srcDelta, p);
	    p++;
	} else {
	    TclStoreInt1AtPtr(0xFF, p);
	    p++;
	    TclStoreInt4AtPtr(srcDelta, p);
	    p += 4;
	}
	prevOffset = cmdLocPtr->srcOffset;
    }

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

    codePtr->srcLengthStart = p;
    for (cmdLocPtr = BA_CmdLocation_First(map, &ptr);  cmdLocPtr;
	    cmdLocPtr = BP_CmdLocation_Next(&ptr)) {
	srcLen = cmdLocPtr->numSrcBytes;
	if (srcLen < 0) {
	    Tcl_Panic("EncodeCmdLocMap: bad source length");
	} else if (srcLen <= 127) {
	    TclStoreInt1AtPtr(srcLen, p);
	    p++;
	} else {
	    TclStoreInt1AtPtr(0xFF, p);

    statsPtr->currentInstBytes += (double) codePtr->numCodeBytes;
    statsPtr->currentLitBytes += (double)
	    codePtr->numLitObjects * sizeof(Tcl_Obj *);
    statsPtr->currentExceptBytes += (double)
	    codePtr->numExceptRanges * sizeof(ExceptionRange);
    statsPtr->currentAuxBytes += (double)
	    BA_AuxData_Size(codePtr->auxData) * sizeof(AuxData);
    statsPtr->currentCmdMapBytes += (double) codePtr->numCmdLocBytes;
}
#endif /* TCL_COMPILE_STATS */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * End:
 */

				 * update. Note that resizing a jump (via
				 * TclFixupForwardJump) can cause the contents
				 * of this array to be updated. When
				 * numContinueTargets==0, this is NULL. */
    int allocContinueTargets;	/* The size of the continueTargets array. */
} ExceptionAux;
















/*
 * TIP #280
 * Structure to record additional location information for byte code. This
 * information is internal and not saved. i.e. tbcload'ed code will not have
 * this information. It records the lines for all words of all commands found
 * in the byte code. The association with a ByteCode structure BC is done
 * through the 'lineBCPtr' HashTable in Interp, keyed by the address of BC.

typedef struct AuxData {
    const AuxDataType *type;	/* Pointer to the AuxData type associated with
				 * this ClientData. */
    ClientData clientData;	/* The compilation data itself. */
} AuxData;

/* Forward declarations for fields below */
struct BrodnikArray_CmdLocation;
TclBrodnikArrayDeclare(AuxData,MODULE_SCOPE);

/*
 * Structure defining the compilation environment. After compilation, fields
 * describing bytecode instructions are copied out into the more compact
 * ByteCode structure defined below.
 */

#define COMPILEENV_INIT_CODE_BYTES    250
#define COMPILEENV_INIT_NUM_OBJECTS    60
#define COMPILEENV_INIT_EXCEPT_RANGES   5



typedef struct CompileEnv {
    Interp *iPtr;		/* Interpreter containing the code being
				 * compiled. Commands and their compile procs
				 * are specific to an interpreter so the code
				 * emitted will depend on the interpreter. */
    const char *source;		/* The source string being compiled by

				 * if not in any range currently. */
    int maxExceptDepth;		/* Max nesting level of exception ranges; -1
				 * if no ranges have been compiled. */
    int maxStackDepth;		/* Maximum number of stack elements needed to
				 * execute the code. Set by compilation
				 * procedures before returning. */
    int currStackDepth;		/* Current stack depth. */
    Tcl_HashTable litMap;	/* Map from literal value to int index where
				 * that value is stored in literalArrayPtr.

				 * Used to prevent dup value refs. */

    unsigned char *codeStart;	/* Points to the first byte of the code. */
    unsigned char *codeNext;	/* Points to next code array byte to use. */
    unsigned char *codeEnd;	/* Points just after the last allocated code
				 * array byte. */
    int mallocedCodeArray;	/* Set 1 if code array was expanded and
				 * codeStart points into the heap.*/
    Tcl_Obj **literalArrayPtr;
    				/* Points of array of literal values. */
    int literalArrayNext;	/* Index of next free object array entry. */
    int literalArrayEnd;	/* Index just after last obj array entry. */
    int mallocedLiteralArray;	/* 1 if object array was expanded and objArray
				 * points into the heap, else 0. */
    ExceptionRange *exceptArrayPtr;
    				/* Points to start of the ExceptionRange
				 * array. */
    int exceptArrayNext;	/* Next free ExceptionRange array index.
				 * exceptArrayNext is the number of ranges and
				 * (exceptArrayNext-1) is the index of the
				 * current range's array entry. */
    int exceptArrayEnd;		/* Index after the last ExceptionRange array
				 * entry. */
    int mallocedExceptArray;	/* 1 if ExceptionRange array was expanded and
				 * exceptArrayPtr points in heap, else 0. */
    ExceptionAux *exceptAuxArrayPtr;
				/* Array of information used to restore the
				 * state when processing BREAK/CONTINUE
				 * exceptions. Must be the same size as the
				 * exceptArrayPtr. */
    struct BrodnikArray_CmdLocation *cmdMap;
				/* Points to array of CmdLocation.
				 * numCommands is the index of the next entry
				 * to use; (numCommands-1) is the entry index
				 * for the last command. */



    BA_AuxData *auxData;	/* Points to array of AuxData */







    unsigned char staticCodeSpace[COMPILEENV_INIT_CODE_BYTES];
				/* Initial storage for code. */
    Tcl_Obj *staticLiteralSpace[COMPILEENV_INIT_NUM_OBJECTS];
				/* Initial storage of literal value array. */
    ExceptionRange staticExceptArraySpace[COMPILEENV_INIT_EXCEPT_RANGES];
				/* Initial ExceptionRange array storage. */
    ExceptionAux staticExAuxArraySpace[COMPILEENV_INIT_EXCEPT_RANGES];
				/* Initial static except auxiliary info array
				 * storage. */




    /* TIP #280 */
    ExtCmdLoc *extCmdMapPtr;	/* Extended command location information for
				 * 'info frame'. */
    int line;			/* First line of the script, based on the
				 * invoking context, then the line of the
				 * command currently compiled. */
    int atCmdStart;		/* Flag to say whether an INST_START_CMD

 * applied yet: this is indicated by the TCL_BYTECODE_RESOLVE_VARS flag.
 */

#define TCL_BYTECODE_RESOLVE_VARS		0x0002

#define TCL_BYTECODE_RECOMPILE			0x0004

#define TCL_BYTECODE_FREE_LITERALS		0x0008

typedef struct ByteCode {
    TclHandle interpHandle;	/* Handle for interpreter containing the
				 * compiled code. Commands and their compile
				 * procs are specific to an interpreter so the
				 * code emitted will depend on the
				 * interpreter. */
    int compileEpoch;		/* Value of iPtr->compileEpoch when this

				 * literal Tcl objects or storage referenced
				 * by AuxData entries. */
    int numCommands;		/* Number of commands compiled. */
    int numSrcBytes;		/* Number of source bytes compiled. */
    int numCodeBytes;		/* Number of code bytes. */
    int numLitObjects;		/* Number of objects in literal array. */
    int numExceptRanges;	/* Number of ExceptionRange array elems. */

    int numCmdLocBytes;		/* Number of bytes needed for encoded command
				 * location information. */
    int maxExceptDepth;		/* Maximum nesting level of ExceptionRanges;
				 * -1 if no ranges were compiled. */
    int maxStackDepth;		/* Maximum number of stack elements needed to
				 * execute the code. */
    unsigned char *codeStart;	/* Points to the first byte of the code. This
				 * is just after the final ByteCode member
				 * cmdMapPtr. */
    Tcl_Obj **objArrayPtr;	/* Points to the start of the literal object
				 * array. This is just after the last code
				 * byte. */
    ExceptionRange *exceptArrayPtr;
    				/* Points to the start of the ExceptionRange
				 * array. This is just after the last object
				 * in the object array. */
    BA_AuxData *auxData;	/* Array of auxiliary data. */


    unsigned char *codeDeltaStart;
				/* Points to the first of a sequence of bytes
				 * that encode the change in the starting
				 * offset of each command's code. If -127 <=
				 * delta <= 127, it is encoded as 1 byte,
				 * otherwise 0xFF (128) appears and the delta
				 * is encoded by the next 4 bytes. Code deltas

    int exceptIndex;		/* Index of the first range entry in the
				 * ExceptionRange array after the current one.
				 * This field is used to adjust the code
				 * offsets in subsequent ExceptionRange
				 * records when a jump is grown from 2 bytes
				 * to 5 bytes. */
} JumpFixup;
TclBrodnikArrayDeclare(JumpFixup,MODULE_SCOPE);












/*
 * The structure describing one variable list of a foreach command. Note that
 * only foreach commands inside procedure bodies are compiled inline so a
 * ForeachVarList structure always describes local variables. Furthermore,
 * only scalar variables are supported for inline-compiled foreach loops.
 */

				 * LAST FIELD IN THE STRUCTURE! */
} ForeachInfo;

MODULE_SCOPE const AuxDataType tclForeachInfoType;
MODULE_SCOPE const AuxDataType tclNewForeachInfoType;

#define FOREACHINFO(envPtr, index) \
    ((ForeachInfo*)(TclFetchAuxData(envPtr, TclGetUInt4AtPtr(index))))

/*
 * Structure used to hold information about a switch command that is needed
 * during program execution. These structures are stored in CompileEnv and
 * ByteCode structures as auxiliary data.
 */

typedef struct JumptableInfo {
    Tcl_HashTable hashTable;	/* Hash that maps strings to signed ints (PC
				 * offsets). */
} JumptableInfo;

MODULE_SCOPE const AuxDataType tclJumptableInfoType;

#define JUMPTABLEINFO(envPtr, index) \
    ((JumptableInfo*)(TclFetchAuxData(envPtr, TclGetUInt4AtPtr(index))))

/*
 * Structure used to hold information about a [dict update] command that is
 * needed during program execution. These structures are stored in CompileEnv
 * and ByteCode structures as auxiliary data.
 */

typedef struct {
    int length;			/* Size of array */
    int varIndices[1];		/* Array of variable indices to manage when
				 * processing the start and end of a [dict
				 * update]. There is really more than one
				 * entry, and the structure is allocated to
				 * take account of this. MUST BE LAST FIELD IN
				 * STRUCTURE. */
} DictUpdateInfo;

MODULE_SCOPE const AuxDataType tclDictUpdateInfoType;

#define DICTUPDATEINFO(envPtr, index) \
    ((DictUpdateInfo*)(TclFetchAuxData(envPtr, TclGetUInt4AtPtr(index))))

/*
 * ClientData type used by the math operator commands.
 */

typedef struct {
    const char *op;		/* Do not call it 'operator': C++ reserved */

MODULE_SCOPE int	TclAttemptCompileProc(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, int depth, Command *cmdPtr,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCleanupByteCode(ByteCode *codePtr);
MODULE_SCOPE void	TclCleanupStackForBreakContinue(CompileEnv *envPtr,
			    ExceptionAux *auxPtr);
MODULE_SCOPE void *	TclCmdStartAddress(CompileEnv *envPtr, int i);
MODULE_SCOPE void	TclCompileCmdWord(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, int count,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileExpr(Tcl_Interp *interp, const char *script,
			    int numBytes, CompileEnv *envPtr, int optimize);
MODULE_SCOPE void	TclCompileExprWords(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, int numWords,
			    CompileEnv *envPtr);
MODULE_SCOPE Tcl_Token *TclCompileInvocation(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, Tcl_Obj *cmdObj, int numWords,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileScript(Tcl_Interp *interp,
			    const char *script, int numBytes,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileSyntaxError(Tcl_Interp *interp,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileTokens(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, int count,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileVarSubst(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, CompileEnv *envPtr);
MODULE_SCOPE int	TclCreateAuxData(ClientData clientData,
			    const AuxDataType *typePtr, CompileEnv *envPtr);
MODULE_SCOPE int	TclCreateExceptRange(ExceptionRangeType type,
			    CompileEnv *envPtr);
MODULE_SCOPE ExecEnv *	TclCreateExecEnv(Tcl_Interp *interp, int size);
MODULE_SCOPE Tcl_Obj *	TclCreateLiteral(Interp *iPtr, char *bytes, int length);



MODULE_SCOPE void	TclDeleteExecEnv(ExecEnv *eePtr);
MODULE_SCOPE void	TclDeleteLiteralTable(Tcl_Interp *interp,
			    LiteralTable *tablePtr);
MODULE_SCOPE void	TclDisposeFailedCompile(CompileEnv *envPtr, int num);
MODULE_SCOPE void	TclEmitForwardJump(CompileEnv *envPtr,
			    TclJumpType jumpType, JumpFixup *jumpFixupPtr);
MODULE_SCOPE void	TclEmitInvoke(CompileEnv *envPtr, int opcode, ...);
MODULE_SCOPE ExceptionRange * TclGetExceptionRangeForPc(unsigned char *pc,
			    int catchOnly, ByteCode *codePtr);

MODULE_SCOPE int	TclNRExecuteByteCode(Tcl_Interp *interp,
			    ByteCode *codePtr);
MODULE_SCOPE ClientData	TclFetchAuxData(CompileEnv *envPtr, int index);
MODULE_SCOPE Tcl_Obj *	TclFetchLiteral(CompileEnv *envPtr, unsigned int index);
MODULE_SCOPE void	TclFinalizeAuxDataTypeTable(void);
MODULE_SCOPE int	TclFindCompiledLocal(const char *name, int nameChars,
			    int create, CompileEnv *envPtr);
MODULE_SCOPE int	TclFixupForwardJump(CompileEnv *envPtr,
			    JumpFixup *jumpFixupPtr, int jumpDist,
			    int distThreshold);
MODULE_SCOPE void	TclFreeCompileEnv(CompileEnv *envPtr);

MODULE_SCOPE void	TclInitAuxDataTypeTable(void);
MODULE_SCOPE void	TclInitByteCodeObj(Tcl_Obj *objPtr,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclInitCompileEnv(Tcl_Interp *interp,
			    CompileEnv *envPtr, const char *string,
			    int numBytes, const CmdFrame *invoker, int word);

MODULE_SCOPE void	TclInitLiteralTable(LiteralTable *tablePtr);
MODULE_SCOPE ExceptionRange *TclGetInnermostExceptionRange(CompileEnv *envPtr,
			    int returnCode, ExceptionAux **auxPtrPtr);
MODULE_SCOPE void	TclAddLoopBreakFixup(CompileEnv *envPtr,
			    ExceptionAux *auxPtr);
MODULE_SCOPE void	TclAddLoopContinueFixup(CompileEnv *envPtr,
			    ExceptionAux *auxPtr);

/*
 *----------------------------------------------------------------
 * Macros and flag values used by Tcl bytecode compilation and execution
 * modules inside the Tcl core but not used outside.
 *----------------------------------------------------------------
 */










#define LITERAL_ON_HEAP		0x01
#define LITERAL_CMD_NAME	0x02

/*
 * Form of TclRegisterLiteral with flags == 0. In that case, it is safe to
 * cast away constness, and it is cleanest to do that here, all in one place.
 *

	    iPtr->compileEpoch);
    Tcl_AppendToObj(bufferObj, "  Source ", -1);
    PrintSourceToObj(bufferObj, codePtr->source,
	    TclMin(codePtr->numSrcBytes, 55));
    Tcl_AppendPrintfToObj(bufferObj,
	    "\n  Cmds %d, src %d, inst %d, litObjs %u, aux %d, stkDepth %u, code/src %.2f\n",
	    numCmds, codePtr->numSrcBytes, codePtr->numCodeBytes,
	    codePtr->numLitObjects, (int) BA_AuxData_Size(codePtr->auxData),
	    codePtr->maxStackDepth,
#ifdef TCL_COMPILE_STATS
	    codePtr->numSrcBytes?
		    codePtr->structureSize/(float)codePtr->numSrcBytes :
#endif
	    0.0);

#ifdef TCL_COMPILE_STATS
    Tcl_AppendPrintfToObj(bufferObj,
	    "  Code %lu = header %lu+inst %d+litObj %lu+exc %lu+aux %lu+cmdMap %d\n",
	    (unsigned long) codePtr->structureSize,
	    (unsigned long) (sizeof(ByteCode) - sizeof(size_t) - sizeof(Tcl_Time)),
	    codePtr->numCodeBytes,
	    (unsigned long) (codePtr->numLitObjects * sizeof(Tcl_Obj *)),
	    (unsigned long) (codePtr->numExceptRanges*sizeof(ExceptionRange)),
	    (unsigned long) (BA_AuxData_Size(codePtr->auxData) * sizeof(AuxData)),
	    codePtr->numCmdLocBytes);
#endif /* TCL_COMPILE_STATS */

    /*
     * If the ByteCode is the compiled body of a Tcl procedure, print
     * information about that procedure. Note that we don't know the
     * procedure's name since ByteCode's can be shared among procedures.

	    opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4;
	    suffixObj = codePtr->objArrayPtr[opnd];
	    Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd);
	    break;
	case OPERAND_AUX4:
	    opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4;
	    Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd);
	    auxPtr = BA_AuxData_At(codePtr->auxData,opnd);
	    break;
	case OPERAND_IDX4:
	    opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
	    if (opnd >= -1) {
		Tcl_AppendPrintfToObj(bufferObj, "%d ", opnd);
	    } else if (opnd == -2) {
		Tcl_AppendPrintfToObj(bufferObj, "end ");

	pc += instDesc->numBytes;
    }

    /*
     * Get the auxiliary data from the bytecode.
     */

    /* TODO: convert to loop over an iterating BP */
    aux = Tcl_NewObj();
    for (i=0 ; i<BA_AuxData_Size(codePtr->auxData) ; i++) {
	AuxData *auxData = BA_AuxData_At(codePtr->auxData,i);
	Tcl_Obj *auxDesc = Tcl_NewStringObj(auxData->type->name, -1);

	if (auxData->type->disassembleProc) {
	    Tcl_Obj *desc = Tcl_NewObj();

	    Tcl_DictObjPut(NULL, desc, Tcl_NewStringObj("name", -1), auxDesc);
	    auxDesc = desc;

	    hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
	    Tcl_SetHashValue(hPtr, valueObj);
	    Tcl_IncrRefCount(valueObj);
	    Tcl_DictObjNext(&dictSearch, &keyObj, &valueObj, &done);
	}
    } else {




































	TclFillTableWithExports(ensemblePtr->nsPtr, hash);










    }

    if (hash->numEntries == 0) {
	ensemblePtr->subcommandArrayPtr = NULL;
	return;
    }

				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Obj *objPtr = Tcl_NewObj();

    Tcl_IncrRefCount(objPtr);
    Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
    (void) TclCompileInvocation(interp, parsePtr->tokenPtr, objPtr,
	    parsePtr->numWords, envPtr);
    Tcl_DecrRefCount(objPtr);
    return TCL_OK;
}

int
TclCompileBasic0ArgCmd(

 * Copyright (c) 1994-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.
 */

#include "tclInt.h"
#include "tclBrodnik.h"

typedef char * pchar;
TclBrodnikArray(pchar);

TCL_DECLARE_MUTEX(envMutex)	/* To serialize access to environ. */

static struct {
    BA_pchar *cachePtr;		/* Cache of the env strings we alloc'd */


#ifndef USE_PUTENV
    char **ourEnviron;		/* Cache of the array that we allocate. We
				 * need to track this in case another
				 * subsystem swaps around the environ array
				 * like we do. */
    int ourEnvironSize;		/* Non-zero means that the environ array was
				 * malloced and has this many total entries

 */

static void
ReplaceString(
    const char *oldStr,		/* Old environment string. */
    char *newStr)		/* New environment string. */
{

    if (env.cachePtr == NULL) {




	env.cachePtr = BA_pchar_Create();

    }




    if (oldStr) {
	BP_pchar ptr;
	pchar *p = BA_pchar_First(env.cachePtr, &ptr);

	while (p) {

	    if (*p == oldStr) {
		pchar *lastPtr;


		ckfree(*p);

		if (newStr) {
		    *p = newStr;
		    return;
		}

		lastPtr = BA_pchar_Detach(env.cachePtr);
		if (p != lastPtr) {

		    *p = *lastPtr;
		}

		return;
	    }




	    p = BP_pchar_Next(&ptr);
	}

    }

    if (newStr) {
	pchar *newPtr = BA_pchar_Append(env.cachePtr);
	*newPtr = newStr;



    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeEnvironment --

     * For now we just deallocate the cache array and none of the environment
     * strings. This may leak more memory that strictly necessary, since some
     * of the strings may no longer be in the environment. However,
     * determining which ones are ok to delete is n-squared, and is pretty
     * unlikely, so we don't bother.
     */

    if (env.cachePtr) {
	BA_pchar_Destroy(env.cachePtr);
	env.cachePtr = NULL;

    }
#ifndef USE_PUTENV
    if (env.ourEnviron && (env.ourEnviron != environ)) {
	ckfree(env.ourEnviron);
    }
    env.ourEnviron = NULL;
    env.ourEnvironSize = 0;
#endif

}

#if defined(__CYGWIN__)

/*
 * When using cygwin, when an environment variable changes, we need to synch
 * with both the cygwin environment (in case the application C code calls

	/*
	 * Jump to location looked up in a hashtable; fall through to next
	 * instr if lookup fails.
	 */

	opnd = TclGetInt4AtPtr(pc+1);
	jtPtr = BA_AuxData_At(codePtr->auxData, opnd)->clientData;
	TRACE(("%d \"%.20s\" => ", opnd, O2S(OBJ_AT_TOS)));
	hPtr = Tcl_FindHashEntry(&jtPtr->hashTable, TclGetString(OBJ_AT_TOS));
	if (hPtr != NULL) {
	    int jumpOffset = PTR2INT(Tcl_GetHashValue(hPtr));

	    TRACE_APPEND(("found in table, new pc %u\n",
		    (unsigned)(pc - codePtr->codeStart + jumpOffset)));

    case INST_FOREACH_START4: /* DEPRECATED */
	/*
	 * Initialize the temporary local var that holds the count of the
	 * number of iterations of the loop body to -1.
	 */

	opnd = TclGetUInt4AtPtr(pc+1);
	infoPtr = BA_AuxData_At(codePtr->auxData, opnd)->clientData;
	iterTmpIndex = infoPtr->loopCtTemp;
	iterVarPtr = LOCAL(iterTmpIndex);
	oldValuePtr = iterVarPtr->value.objPtr;

	if (oldValuePtr == NULL) {
	    TclNewLongObj(iterVarPtr->value.objPtr, -1);
	    Tcl_IncrRefCount(iterVarPtr->value.objPtr);

	/*
	 * "Step" a foreach loop (i.e., begin its next iteration) by assigning
	 * the next value list element to each loop var.
	 */

	opnd = TclGetUInt4AtPtr(pc+1);
	TRACE(("%u => ", opnd));
	infoPtr = BA_AuxData_At(codePtr->auxData, opnd)->clientData;
	numLists = infoPtr->numLists;

	/*
	 * Increment the temp holding the loop iteration number.
	 */

	iterVarPtr = LOCAL(infoPtr->loopCtTemp);

    case INST_FOREACH_START:
	/*
	 * Initialize the data for the looping construct, pushing the
	 * corresponding Tcl_Objs to the stack.
	 */

	opnd = TclGetUInt4AtPtr(pc+1);
	infoPtr = BA_AuxData_At(codePtr->auxData, opnd)->clientData;
	numLists = infoPtr->numLists;
	TRACE(("%u => ", opnd));

	/*
	 * Compute the number of iterations that will be run: iterMax
	 */

	JUMP_PEEPHOLE_F(done, 5, 0);

    case INST_DICT_UPDATE_START:
	opnd = TclGetUInt4AtPtr(pc+1);
	opnd2 = TclGetUInt4AtPtr(pc+5);
	TRACE(("%u => ", opnd));
	varPtr = LOCAL(opnd);
	duiPtr = BA_AuxData_At(codePtr->auxData, opnd2)->clientData;
	while (TclIsVarLink(varPtr)) {
	    varPtr = varPtr->value.linkPtr;
	}
	if (TclIsVarDirectReadable(varPtr)) {
	    dictPtr = varPtr->value.objPtr;
	} else {
	    DECACHE_STACK_INFO();

	NEXT_INST_F(9, 0, 0);

    case INST_DICT_UPDATE_END:
	opnd = TclGetUInt4AtPtr(pc+1);
	opnd2 = TclGetUInt4AtPtr(pc+5);
	TRACE(("%u => ", opnd));
	varPtr = LOCAL(opnd);
	duiPtr = BA_AuxData_At(codePtr->auxData, opnd2)->clientData;
	while (TclIsVarLink(varPtr)) {
	    varPtr = varPtr->value.linkPtr;
	}
	if (TclIsVarDirectReadable(varPtr)) {
	    dictPtr = varPtr->value.objPtr;
	} else {
	    DECACHE_STACK_INFO();

static void
PrintByteCodeInfo(
    register ByteCode *codePtr)	/* The bytecode whose summary is printed to
				 * stdout. */
{
    Proc *procPtr = codePtr->procPtr;
    Interp *iPtr = (Interp *) *codePtr->interpHandle;
    int numAuxDataItems = codePtr->auxData?BA_AuxData_Size(codePtr->auxData):0;

    fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %u, epoch %u, interp 0x%p (epoch %u)\n",
	    codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr,
	    iPtr->compileEpoch);

    fprintf(stdout, "  Source: ");
    TclPrintSource(stdout, codePtr->source, 60);

    fprintf(stdout, "\n  Cmds %d, src %d, inst %u, litObjs %u, aux %d, stkDepth %u, code/src %.2f\n",
	    codePtr->numCommands, codePtr->numSrcBytes,
	    codePtr->numCodeBytes, codePtr->numLitObjects,
	    numAuxDataItems, codePtr->maxStackDepth,
#ifdef TCL_COMPILE_STATS
	    codePtr->numSrcBytes?
		    ((float)codePtr->structureSize)/codePtr->numSrcBytes :
#endif
	    0.0);

#ifdef TCL_COMPILE_STATS
    fprintf(stdout, "  Code %lu = header %lu+inst %d+litObj %lu+exc %lu+aux %lu+cmdMap %d\n",
	    (unsigned long) codePtr->structureSize,
	    (unsigned long) (sizeof(ByteCode)-sizeof(size_t)-sizeof(Tcl_Time)),
	    codePtr->numCodeBytes,
	    (unsigned long) (codePtr->numLitObjects * sizeof(Tcl_Obj *)),
	    (unsigned long) (codePtr->numExceptRanges*sizeof(ExceptionRange)),
	    (unsigned long) (numAuxDataItems * sizeof(AuxData)),
	    codePtr->numCmdLocBytes);
#endif /* TCL_COMPILE_STATS */
    if (procPtr != NULL) {
	fprintf(stdout,
		"  Proc 0x%p, refCt %d, args %d, compiled locals %d\n",
		procPtr, procPtr->refCount, procPtr->numArgs,
		procPtr->numCompiledLocals);

 */

int
TclLog2(
    register int value)		/* The integer for which to compute the log
				 * base 2. */
{
    if (value == 0) {

	return 0;



    }
    return TclMSB(value);
}

/*
 *----------------------------------------------------------------------
 *
 * EvalStatsCmd --
 *

Tcl_FSEvalFileEx(
    Tcl_Interp *interp,		/* Interpreter in which to process file. */
    Tcl_Obj *pathPtr,		/* Path of file to process. Tilde-substitution
				 * will be performed on this name. */
    const char *encodingName)	/* If non-NULL, then use this encoding for the
				 * file. NULL means use the system encoding. */
{
    int result = TCL_ERROR;
    Tcl_StatBuf statBuf;
    Tcl_Obj *oldScriptFile;
    Interp *iPtr;
    const char *string;
    Tcl_Channel chan;
    Tcl_Obj *objPtr;

	goto end;
    }

    iPtr = (Interp *) interp;
    oldScriptFile = iPtr->scriptFile;
    iPtr->scriptFile = pathPtr;
    Tcl_IncrRefCount(iPtr->scriptFile);


    /*
     * TIP #280 Force the evaluator to open a frame for a sourced file.
     */

    iPtr->evalFlags |= TCL_EVAL_FILE;
    result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT);

    /*
     * Now we have to be careful; the script may have changed the
     * iPtr->scriptFile value, so we must reset it without assuming it still
     * points to 'pathPtr'.
     */

    if (iPtr->scriptFile != NULL) {
	Tcl_DecrRefCount(iPtr->scriptFile);
    }
    iPtr->scriptFile = oldScriptFile;

    if (result == TCL_RETURN) {
	result = TclUpdateReturnInfo(iPtr);
    } else if (result == TCL_ERROR) {
	/*
	 * Record information telling where the error occurred.
	 */

	int length;
	const char *pathString = Tcl_GetStringFromObj(pathPtr, &length);
	int limit = 150;
	int overflow = (length > limit);

	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (file \"%.*s%s\" line %d)",
		(overflow ? limit : length), pathString,

 * here, so that system-dependent personalizations for the include files only
 * have to be made in once place. This results in a few extra includes, but
 * greater modularity. The order of the three groups of #includes is
 * important. For example, stdio.h is needed by tcl.h.
 */

#include "tclPort.h"
#include "tclBrodnik.h"

#include <stdio.h>

#include <ctype.h>
#ifdef NO_STDLIB_H
#   include "../compat/stdlib.h"
#else

				 * Command structures that point (via an
				 * ImportedCmdRef structure) to the Command
				 * structure in the source namespace's command
				 * table. */
    TclVarHashTable varTable;	/* Contains all the (global) variables
				 * currently in this namespace. Indexed by
				 * strings; values have type (Var *). */

    Tcl_Obj *exportPatternList;
				/* Set of "string match" style patterns that
				 * specify which commands are exported. 
				 * No namespace qualifiers are allowed. */






    int cmdRefEpoch;		/* Incremented if a newly added command
				 * shadows a command for which this namespace
				 * has already cached a Command* pointer; this
				 * causes all its cached Command* pointers to
				 * be invalidated. */
    int resolverEpoch;		/* Incremented whenever (a) the name
				 * resolution rules change for this namespace

 * Data structures related to procedures
 *----------------------------------------------------------------
 */

typedef Tcl_CmdProc *TclCmdProcType;
typedef Tcl_ObjCmdProc *TclObjCmdProcType;

/*
 *----------------------------------------------------------------
 * Internal definitions related to parsing, substitution, evaluation
 *----------------------------------------------------------------
 */

/*
 * New internal Tcl_Token types.
 *
 * TCL_TOKEN_SCRIPT -           Leading Tcl_Token type for an entire script.
 *                              The numComponents field stores the number of
 *                              commands in the script.
 * TCL_TOKEN_SCRIPT_SUBST -     So-called "command substituion" in Tcl is
 *                              really "script substitution" and this internal
 *                              Tcl_Token type indicates it.  Unlike
 *                              the TCL_TOKEN_COMMAND type, which also denotes
 *                              "command substitution", the numComponents field
 *                              is *not* always 0, so we can store the results
 *                              of nested parsing, and avoid reparsing the
 *                              same string again and again.  The numComponents
 *                              field stores the number of following Tcl_Tokens
 *                              that are parsed from the nested script.  The
 *                              numComponents value is always at least 1, for
 *                              the TCL_TOKEN_SCRIPT token that follows.
 * TCL_TOKEN_CMD -              Leading Tcl_Token type for a parsed Tcl command. *                              There will be one of these tokens for each
 *                              command in a script.  The numComponents field
 *                              stores the number of words in the command.
 * TCL_TOKEN_ERROR -            This Tcl_Token type is used to represent a
 *                              parse error.  It may appear following all
 *                              the commands that follow a TCL_TOKEN_SCRIPT
 *                              token.  The TCL_TOKEN_ERROR token represents
 *                              the remainder of the original string that
 *                              could not be parsed into commands.
 */

#define TCL_TOKEN_SCRIPT        512
#define TCL_TOKEN_SCRIPT_SUBST  1024
#define TCL_TOKEN_CMD           2048
#define TCL_TOKEN_ERROR         4096

/*
 *----------------------------------------------------------------
 * Data structures for process-global values.
 *----------------------------------------------------------------
 */

typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, int *lengthPtr,

 * the value of an empty string representation for an object. This value is
 * shared by all new objects allocated by Tcl_NewObj.
 */

MODULE_SCOPE char *	tclEmptyStringRep;
MODULE_SCOPE char	tclEmptyString;

/*
 * Flags used to control details of parsing.
 * The first three are #define'd in tcl.h, so that may be set by callers
 * of Tcl_SubstObj().  See the docs for what they do.
 *
 * #define TCL_SUBST_COMMANDS           001
 * #define TCL_SUBST_VARIABLES          002
 * #define TCL_SUBST_BACKSLASHES        004
 *
 * tcl.h also #define's their combination for brevity:
 *
 * #define TCL_SUBST_ALL                007
 *
 * The other flag values that control parsing are:
 *
 * PARSE_NESTED -               Passed to ParseCommand to indicate that the
 *                              close bracket character should be treated as
 *                              a command terminator, as well as newlines,
 *                              semi-colons, and end of string.
 *
 * PARSE_APPEND -               Passed throughout the Parse routines to 
 *                              indicate that parsing should append to the
 *                              Tcl_Parse structure passed in (by reference).
 *                              If this flag is not set, some routines will
 *                              re-initialize the Tcl_Parse structure.
 *
 * PARSE_USE_INTERNAL_TOKENS -  Passed throughout the Parse routines to
 *                              indicate the parse is being done for Tcl's
 *                              internal use, so it is acceptable to use
 *                              Tcl_Token types that are known only internally.
 */

#define PARSE_NESTED                    010
#define PARSE_APPEND                    020
#define PARSE_USE_INTERNAL_TOKENS       040

/*
 *----------------------------------------------------------------
 * Procedures shared among Tcl modules but not used by the outside world,
 * introduced by/for NRE.
 *----------------------------------------------------------------
 */

			    void *codePtr, CmdFrame *cfPtr, int cmd, int pc);
MODULE_SCOPE void	TclArgumentBCRelease(Tcl_Interp *interp,
			    CmdFrame *cfPtr);
MODULE_SCOPE void	TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj,
			    CmdFrame **cfPtrPtr, int *wordPtr);
MODULE_SCOPE int	TclArraySet(Tcl_Interp *interp,
			    Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj);
MODULE_SCOPE void	TclBAConvertIndices(size_t index, unsigned int *hiPtr,
			    unsigned int *loPtr);
MODULE_SCOPE size_t	TclBAInvertIndices(unsigned int hi, unsigned int lo);
MODULE_SCOPE double	TclBignumToDouble(const mp_int *bignum);
MODULE_SCOPE int	TclByteArrayMatch(const unsigned char *string,
			    int strLen, const unsigned char *pattern,
			    int ptnLen, int flags);
MODULE_SCOPE double	TclCeil(const mp_int *a);
MODULE_SCOPE void	TclChannelPreserve(Tcl_Channel chan);
MODULE_SCOPE void	TclChannelRelease(Tcl_Channel chan);

			    const char *dict, int dictLength,
			    const char **elementPtr, const char **nextPtr,
			    int *sizePtr, int *literalPtr);
/* TIP #280 - Modified token based evulation, with line information. */
MODULE_SCOPE int	TclEvalEx(Tcl_Interp *interp, const char *script,
			    int numBytes, int flags, int line,
			    int *clNextOuter, const char *outerScript);
MODULE_SCOPE int	TclEvalScriptTokens(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, int length, int flags,
			    int line, int* clNextOuter,
			    const char* outerScript);
MODULE_SCOPE Tcl_ObjCmdProc TclFileAttrsCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileCopyCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileDeleteCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileLinkCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileMakeDirsCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileReadLinkCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileRenameCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileTemporaryCmd;
MODULE_SCOPE void	TclCreateLateExitHandler(Tcl_ExitProc *proc,
			    ClientData clientData);
MODULE_SCOPE void	TclDeleteLateExitHandler(Tcl_ExitProc *proc,
			    ClientData clientData);
MODULE_SCOPE char *	TclDStringAppendObj(Tcl_DString *dsPtr,
			    Tcl_Obj *objPtr);
MODULE_SCOPE char *	TclDStringAppendDString(Tcl_DString *dsPtr,
			    Tcl_DString *toAppendPtr);
MODULE_SCOPE Tcl_Obj *	TclDStringToObj(Tcl_DString *dsPtr);
MODULE_SCOPE void	TclFillTableWithExports(Namespace *nsPtr,
			    Tcl_HashTable *hash);
MODULE_SCOPE void	TclFinalizeAllocSubsystem(void);
MODULE_SCOPE void	TclFinalizeAsync(void);
MODULE_SCOPE void	TclFinalizeDoubleConversion(void);
MODULE_SCOPE void	TclFinalizeEncodingSubsystem(void);
MODULE_SCOPE void	TclFinalizeEnvironment(void);
MODULE_SCOPE void	TclFinalizeEvaluation(void);
MODULE_SCOPE void	TclFinalizeExecution(void);

			    const char *modeString, int *seekFlagPtr,
			    int *binaryPtr);
MODULE_SCOPE Tcl_Obj *	TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr);
MODULE_SCOPE Tcl_Obj *	TclGetSourceFromFrame(CmdFrame *cfPtr, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE char *	TclGetStringStorage(Tcl_Obj *objPtr,
			    unsigned int *sizePtr);
MODULE_SCOPE Tcl_Token *TclGetTokensFromObj(Tcl_Obj *objPtr,
			    Tcl_Token **lastTokenPtrPtr);
MODULE_SCOPE int	TclIncrObj(Tcl_Interp *interp, Tcl_Obj *valuePtr,
			    Tcl_Obj *incrPtr);
MODULE_SCOPE Tcl_Obj *	TclIncrObjVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags);
MODULE_SCOPE int	TclInfoExistsCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclInfoCoroutineCmd(ClientData dummy, Tcl_Interp *interp,

MODULE_SCOPE Tcl_Command TclMakeEnsemble(Tcl_Interp *interp, const char *name,
			    const EnsembleImplMap map[]);
MODULE_SCOPE int	TclMaxListLength(const char *bytes, int numBytes,
			    const char **endPtr);
MODULE_SCOPE int	TclMergeReturnOptions(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[], Tcl_Obj **optionsPtrPtr,
			    int *codePtr, int *levelPtr);
MODULE_SCOPE int	TclMSB(size_t n);
MODULE_SCOPE Tcl_Obj *  TclNoErrorStack(Tcl_Interp *interp, Tcl_Obj *options);
MODULE_SCOPE int	TclNokia770Doubles(void);
MODULE_SCOPE void	TclNsDecrRefCount(Namespace *nsPtr);
MODULE_SCOPE void	TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, const char *operation,
			    const char *reason, int index);
MODULE_SCOPE int	TclObjInvokeNamespace(Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[],
			    Tcl_Namespace *nsPtr, int flags);
MODULE_SCOPE int	TclObjUnsetVar2(Tcl_Interp *interp,
			    Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags);
MODULE_SCOPE int	TclParseBackslash(const char *src,
			    int numBytes, int *readPtr, char *dst);
MODULE_SCOPE int	TclParseCommand(Tcl_Interp *interp, const char *start,
			    int numBytes, int flags, Tcl_Parse *parsePtr);
MODULE_SCOPE int	TclParseHex(const char *src, int numBytes,
			    int *resultPtr);
MODULE_SCOPE int	TclParseNumber(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    const char *expected, const char *bytes,
			    int numBytes, const char **endPtrPtr, int flags);
MODULE_SCOPE void	TclParseInit(Tcl_Interp *interp, const char *string,
			    int numBytes, Tcl_Parse *parsePtr);

MODULE_SCOPE int	TclParseQuotedString(Tcl_Interp *interp,
			    const char *start, int numBytes,
			    Tcl_Parse *parsePtr, int flags,
			    const char **termPtr);
MODULE_SCOPE Tcl_Token *TclParseScript(Tcl_Interp *interp, const char *script,
			    int numBytes, int flags,
			    Tcl_Token **lastTokenPtrPtr, const char **termPtr);
MODULE_SCOPE int	TclParseScriptSubst(const char *src, int numBytes,
			    Tcl_Parse *parsePtr, int flags);
MODULE_SCOPE int	TclParseVarName(Tcl_Interp *interp, const char *start,
			    int numBytes, Tcl_Parse *parsePtr, int flags);
MODULE_SCOPE int	TclParseAllWhiteSpace(const char *src, int numBytes);
MODULE_SCOPE int	TclProcessReturn(Tcl_Interp *interp,
			    int code, int level, Tcl_Obj *returnOpts);
MODULE_SCOPE int	TclpObjLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
MODULE_SCOPE Tcl_Obj *	TclpTempFileName(void);
MODULE_SCOPE Tcl_Obj *  TclpTempFileNameForLibrary(Tcl_Interp *interp, Tcl_Obj* pathPtr);
MODULE_SCOPE Tcl_Obj *	TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep,

MODULE_SCOPE Tcl_Obj *	TclStringObjReverse(Tcl_Obj *objPtr);
MODULE_SCOPE void	TclSubstCompile(Tcl_Interp *interp, const char *bytes,
			    int numBytes, int flags, int line,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclSubstOptions(Tcl_Interp *interp, int numOpts,
			    Tcl_Obj *const opts[], int *flagPtr);
MODULE_SCOPE void	TclSubstParse(Tcl_Interp *interp, const char *bytes,
			    int numBytes, int flags, Tcl_Parse *parsePtr);

MODULE_SCOPE int	TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
			    int count, int *tokensLeftPtr, int line,
			    int* clNextOuter, const char* outerScript,
			    int flags);
MODULE_SCOPE Tcl_Obj *	TclTokensCopy(Tcl_Obj *objPtr);
MODULE_SCOPE int	TclTrimLeft(const char *bytes, int numBytes,
			    const char *trim, int numTrim);
MODULE_SCOPE int	TclTrimRight(const char *bytes, int numBytes,
			    const char *trim, int numTrim);
MODULE_SCOPE int	TclUtfCasecmp(const char *cs, const char *ct);
MODULE_SCOPE Tcl_Obj *	TclpNativeToNormalized(ClientData clientData);
MODULE_SCOPE Tcl_Obj *	TclpFilesystemPathType(Tcl_Obj *pathPtr);

 * counter. The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE void	TclInvalidateNsCmdLookup(Namespace *nsPtr);
 *----------------------------------------------------------------
 */

#define TclInvalidateNsCmdLookup(nsPtr) \
    if ((nsPtr)->exportPatternList) {		\
	(nsPtr)->exportLookupEpoch++;		\
    }						\
    if ((nsPtr)->commandPathLength) {		\
	(nsPtr)->cmdRefEpoch++;			\
    }

/*

#define REBUILD_MULTIPLIER	3

/*
 * Function prototypes for static functions in this file:
 */

static Tcl_Obj *	CreateLiteral(Interp *iPtr, char *bytes, int length,
			    int *newPtr, Namespace *nsPtr, int flags,
			    LiteralEntry **globalPtrPtr);
static void		ExpandLocalLiteralArray(CompileEnv *envPtr);
static unsigned		HashString(const char *string, int length);
#ifdef TCL_COMPILE_DEBUG
static LiteralEntry *	LookupLiteralEntry(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
#endif
static void		RebuildLiteralTable(LiteralTable *tablePtr);

 *
 *	Find, or if necessary create, an object in the interpreter's literal
 *	table that has a string representation matching the argument
 *	string. If nsPtr!=NULL then only literals stored for the namespace are
 *	considered.
 *
 * Results:
 *	The literal object.

 *
 * Side effects:
 *	Increments the ref count of the global LiteralEntry since the caller
 *	now holds a reference. If LITERAL_ON_HEAP is set in flags, this
 *	function is given ownership of the string: if an object is created
 *	then its string representation is set directly from string, otherwise
 *	the string is freed. Typically, a caller sets LITERAL_ON_HEAP if
 *	"string" is an already heap-allocated buffer holding the result of
 *	backslash substitutions.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclCreateLiteral(
    Interp *iPtr,
    char *bytes,		/* The start of the string. Note that this is
				 * not a NUL-terminated string. */
    int length)			/* Number of bytes in the string. */
{
    int new;
    return CreateLiteral(iPtr, bytes, length, &new, NULL, 0, NULL);
}

static Tcl_Obj *
CreateLiteral(
    Interp *iPtr,
    char *bytes,		/* The start of the string. Note that this is
				 * not a NUL-terminated string. */
    int length,			/* Number of bytes in the string. */
    int *newPtr,
    Namespace *nsPtr,
    int flags,
    LiteralEntry **globalPtrPtr)
{
    LiteralTable *globalTablePtr = &iPtr->literalTable;
    LiteralEntry *globalPtr;
    int globalHash;
    Tcl_Obj *objPtr;

    /*
     * Is it in the interpreter's global literal table?
     */

    if (length < 0) {
	length = strlen(bytes);
    }
    globalHash = (HashString(bytes, length) & globalTablePtr->mask);
    for (globalPtr=globalTablePtr->buckets[globalHash] ; globalPtr!=NULL;
	    globalPtr = globalPtr->nextPtr) {
	objPtr = globalPtr->objPtr;
	if ((globalPtr->nsPtr == nsPtr)
		&& (objPtr->length == length) && ((length == 0)
		|| ((objPtr->bytes[0] == bytes[0])
		&& (memcmp(objPtr->bytes, bytes, (unsigned) length) == 0)))) {
	    /*
	     * A literal was found: return it
	     */

	    if (newPtr) {
		*newPtr = 0;
	    }



	    if (flags & LITERAL_ON_HEAP) {
		ckfree(bytes);
	    }
	    if (globalPtrPtr) {
		*globalPtrPtr = globalPtr;
	    } else {
		globalPtr->refCount++;
#ifdef TCL_COMPILE_DEBUG
    if (globalPtr->refCount < 1) {
	Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d",
		"TclRegisterLiteral", (length>60? 60 : length), bytes,
		globalPtr->refCount);
    }
#endif
	    }
	    return objPtr;
	}
    }
    if (newPtr == NULL) {
	if (flags & LITERAL_ON_HEAP) {
	    ckfree(bytes);
	}
	return NULL;
    }

    /*

    iPtr->stats.totalLitStringBytes += (double) (length + 1);
    iPtr->stats.currentLitStringBytes += (double) (length + 1);
    iPtr->stats.literalCount[TclLog2(length)]++;
#endif /*TCL_COMPILE_STATS*/

    if (globalPtrPtr) {
	*globalPtrPtr = globalPtr;
    } 
    *newPtr = 1;
    return objPtr;
}

/*
 *----------------------------------------------------------------------
 *

				 * fetch the registered literal value. */
    unsigned int index)		/* Index of the desired literal, as returned
				 * by prior call to TclRegisterLiteral() */
{
    if (index >= (unsigned int) envPtr->literalArrayNext) {
	return NULL;
    }
    return envPtr->literalArrayPtr[index];
}

/*
 *----------------------------------------------------------------------
 *
 * TclRegisterLiteral --
 *

				 * malloc'd bytes and ownership is passed to
				 * this function. If LITERAL_CMD_NAME then
				 * the literal should not be shared accross
				 * namespaces. */
{
    CompileEnv *envPtr = ePtr;
    Interp *iPtr = envPtr->iPtr;





    Namespace *nsPtr = NULL;
    Tcl_Obj *objPtr;




    LiteralEntry *globalPtr;




    Tcl_HashEntry *hePtr;















    int objIndex, globalNew, new = 0;



    /*
     * If the literal is a command name, avoid sharing it across namespaces,
     * and try not to share it with non-cmd literals. Note that FQ command
     * names can be shared, so that we register the namespace as the
     * interp's global NS.
     */

    if (flags & LITERAL_CMD_NAME) {
	if ((length >= 2) && (bytes[0] == ':') && (bytes[1] == ':')) {
	    nsPtr = iPtr->globalNsPtr;
	} else {
	    nsPtr = iPtr->varFramePtr->nsPtr;
	}


    }





    objPtr = CreateLiteral(iPtr, bytes, length, &globalNew, nsPtr,
	    flags, &globalPtr);

    
    hePtr = Tcl_CreateHashEntry(&envPtr->litMap, objPtr, &new);
    if (new) {
	objIndex = TclAddLiteralObj(envPtr, objPtr, NULL);
	Tcl_SetHashValue(hePtr, INT2PTR(objIndex));
	if (!globalNew) {


	    globalPtr->refCount++;
	}


    } else {
	objIndex = PTR2INT(Tcl_GetHashValue(hePtr));
    }
    return objIndex;
}

#ifdef TCL_COMPILE_DEBUG
/*
 *----------------------------------------------------------------------
 *

    Tcl_Interp *interp,		/* Interpreter for which objPtr was created to
				 * hold a literal. */
    register CompileEnv *envPtr,/* Points to CompileEnv whose literal array
				 * contains the entry being hidden. */
    int index)			/* The index of the entry in the literal
				 * array. */
{



    Tcl_Obj **lPtr;
    Tcl_Obj *newObjPtr;
    Tcl_HashEntry *hePtr;

    lPtr = &envPtr->literalArrayPtr[index];

    /*
     * To avoid unwanted sharing we need to copy the object and remove it from
     * the local and global literal tables. It still has a slot in the literal
     * array so it can be referred to by byte codes, but it will not be
     * matched by literal searches.
     */

    hePtr = Tcl_FindHashEntry(&envPtr->litMap, *lPtr);
    if (hePtr) {
	Tcl_DeleteHashEntry(hePtr);
    }

    newObjPtr = Tcl_DuplicateObj(*lPtr);
    Tcl_IncrRefCount(newObjPtr);
    TclReleaseLiteral(interp, *lPtr);
    *lPtr = newObjPtr;














}

/*
 *----------------------------------------------------------------------
 *
 * TclAddLiteralObj --
 *
 *	Add a single literal object to the literal array. This function does
 *	not add the literal to the local or global literal tables. The caller
 *	is expected to add the entry to whatever tables are appropriate.
 *
 * Results:
 *	The index in the CompileEnv's literal array that references the
 *	literal.

 *
 * Side effects:
 *	Expands the literal array if necessary. Increments the refcount on the
 *	literal object.
 *
 *----------------------------------------------------------------------
 */

int
TclAddLiteralObj(
    register CompileEnv *envPtr,/* Points to CompileEnv in whose literal array
				 * the object is to be inserted. */
    Tcl_Obj *objPtr,		/* The object to insert into the array. */
    LiteralEntry **litPtrPtr)	/* UNUSED.  Still in place due to publication
				 * in the internal stubs table, and use by
				 * tclcompiler. */
{

    int objIndex;

    if (envPtr->literalArrayNext >= envPtr->literalArrayEnd) {
	ExpandLocalLiteralArray(envPtr);
    }
    objIndex = envPtr->literalArrayNext;
    envPtr->literalArrayNext++;

    envPtr->literalArrayPtr[objIndex] = objPtr;

    Tcl_IncrRefCount(objPtr);


















































































    return objIndex;
}

/*
 *----------------------------------------------------------------------
 *

				 * must be enlarged. */
{
    /*
     * The current allocated local literal entries are stored between elements
     * 0 and (envPtr->literalArrayNext - 1) [inclusive].
     */


    int currElems = envPtr->literalArrayNext;
    size_t currBytes = (currElems * sizeof(Tcl_Obj *));
    Tcl_Obj **currArrayPtr = envPtr->literalArrayPtr;
    Tcl_Obj **newArrayPtr;


    if (envPtr->mallocedLiteralArray) {
	newArrayPtr = ckrealloc(currArrayPtr, 2 * currBytes);
    } else {
	/*
	 * envPtr->literalArrayPtr isn't a ckalloc'd pointer, so we must
	 * code a ckrealloc equivalent for ourselves.
	 */

	newArrayPtr = ckalloc(2 * currBytes);
	memcpy(newArrayPtr, currArrayPtr, currBytes);
	envPtr->mallocedLiteralArray = 1;



















    }

    envPtr->literalArrayPtr = newArrayPtr;
    envPtr->literalArrayEnd = (2 * currElems);
}

/*

				 * command literal. */
    const char *name,		/* Points to the start of the cmd literal
				 * name. */
    Namespace *nsPtr)		/* The namespace for which to lookup and
				 * invalidate a cmd literal. */
{
    Interp *iPtr = (Interp *) interp;
    LiteralEntry *globalPtr;
    Tcl_Obj *literalObjPtr = CreateLiteral(iPtr, (char *) name, -1,
	    NULL, nsPtr, 0, &globalPtr);

    if (literalObjPtr && (literalObjPtr->typePtr == &tclCmdNameType)) {

	TclFreeIntRep(literalObjPtr);




    }
}

#ifdef TCL_COMPILE_STATS
/*
 *----------------------------------------------------------------------
 *

 */

void
TclVerifyLocalLiteralTable(
    CompileEnv *envPtr)		/* Points to CompileEnv whose literal table is
				 * to be validated. */
{
    Tcl_HashTable *mapPtr = &envPtr->litMap;
    Tcl_HashSearch search;
    Tcl_HashEntry *hePtr = Tcl_FirstHashEntry(mapPtr, &search);







    while (hePtr) {
	Tcl_Obj *objPtr = Tcl_GetHashKey(mapPtr, hePtr);

	if (objPtr->bytes == NULL) {

	    Tcl_Panic("%s: literal has NULL string rep",
		    "TclVerifyLocalLiteralTable");

	}
	if (LookupLiteralEntry((Tcl_Interp *) envPtr->iPtr, objPtr) == NULL) {

	    int length;
	    const char *bytes = Tcl_GetStringFromObj(objPtr, &length);
	    Tcl_Panic("%s: local literal \"%.*s\" is not global",
			"TclVerifyLocalLiteralTable",
			(length>60? 60 : length), bytes);
	}









	hePtr = Tcl_NextHashEntry(&search);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclVerifyGlobalLiteralTable --

    nsPtr->nsId = ++(tsdPtr->numNsCreated);
    nsPtr->interp = interp;
    nsPtr->flags = 0;
    nsPtr->activationCount = 0;
    nsPtr->refCount = 0;
    Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS);
    TclInitVarHashTable(&nsPtr->varTable, nsPtr);
    nsPtr->exportPatternList = NULL;


    nsPtr->cmdRefEpoch = 0;
    nsPtr->resolverEpoch = 0;
    nsPtr->cmdResProc = NULL;
    nsPtr->varResProc = NULL;
    nsPtr->compiledVarResProc = NULL;
    nsPtr->exportLookupEpoch = 0;
    nsPtr->ensembles = NULL;

				 * and unlinked from its parent. */
{
    Interp *iPtr = (Interp *) nsPtr->interp;
    register Tcl_HashEntry *entryPtr;
    Tcl_HashSearch search;
    Tcl_Namespace *childNsPtr;
    Tcl_Command cmd;


    /*
     * Start by destroying the namespace's variable table, since variables
     * might trigger traces. Variable table should be cleared but not freed!
     * TclDeleteNamespaceVars frees it, so we reinitialize it afterwards.
     */

    }
#endif

    /*
     * Free the namespace's export pattern array.
     */

    if (nsPtr->exportPatternList != NULL) {



	Tcl_DecrRefCount(nsPtr->exportPatternList);
	nsPtr->exportPatternList = NULL;


    }

    /*
     * Free any client data associated with the namespace.
     */

    if (nsPtr->deleteProc != NULL) {

    const char *pattern,	/* String pattern indicating which commands to
				 * export. This pattern may not include any
				 * namespace qualifiers; only commands in the
				 * specified namespace may be exported. */
    int resetListFirst)		/* If nonzero, resets the namespace's export
				 * list before appending. */
{

    Namespace *nsPtr, *exportNsPtr, *dummyPtr;
    Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    const char *simplePattern;



    /*
     * If the specified namespace is NULL, use the current namespace.
     */

    if (namespacePtr == NULL) {
	nsPtr = (Namespace *) currNsPtr;
    } else {
	nsPtr = (Namespace *) namespacePtr;
    }

    /*
     * If resetListFirst is true (nonzero), clear the namespace's export
     * pattern list.
     */

    if (resetListFirst && nsPtr->exportPatternList) {






	TclInvalidateNsCmdLookup(nsPtr);
	Tcl_DecrRefCount(nsPtr->exportPatternList);
	nsPtr->exportPatternList = NULL;

    }

    /*
     * Check that the pattern doesn't have namespace qualifiers.
     */

    TclGetNamespaceForQualName(interp, pattern, nsPtr, TCL_NAMESPACE_ONLY,
	    &exportNsPtr, &dummyPtr, &dummyPtr, &simplePattern);

    if ((exportNsPtr != nsPtr) || (strcmp(pattern, simplePattern) != 0)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid export pattern"
                " \"%s\": pattern can't specify a namespace", pattern));
	Tcl_SetErrorCode(interp, "TCL", "EXPORT", "INVALID", NULL);
	return TCL_ERROR;
    }

    /*
     * Make sure that we don't already have the pattern in the array
     */

    if (nsPtr->exportPatternList != NULL) {
	int objc;
	Tcl_Obj **objv;

	Tcl_ListObjGetElements(NULL, nsPtr->exportPatternList, &objc, &objv);
	while (objc--) {
	    if (strcmp(pattern, Tcl_GetString(*objv++)) == 0) {
		/*
		 * The pattern already exists in the list.
		 */

		return TCL_OK;
	    }
	}

    } else {




	nsPtr->exportPatternList = Tcl_NewObj();






    }

    /*
     * Add the pattern to the namespace's list of export patterns.
     */




    Tcl_ListObjAppendElement(NULL, nsPtr->exportPatternList,

	    Tcl_NewStringObj(pattern, -1));

    /*
     * The list of commands actually exported from the namespace might have
     * changed (probably will have!) However, we do not need to recompute this
     * just yet; next time we need the info will be soon enough.
     */

    TclInvalidateNsCmdLookup(nsPtr);

    return TCL_OK;

}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppendExportList --
 *

    Tcl_Namespace *namespacePtr,/* Points to the namespace whose export
				 * pattern list is appended onto objPtr. NULL
				 * for the current namespace. */
    Tcl_Obj *objPtr)		/* Points to the Tcl object onto which the
				 * export pattern list is appended. */
{
    Namespace *nsPtr;


    /*
     * If the specified namespace is NULL, use the current namespace.
     */

    if (namespacePtr == NULL) {
	nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    } else {
	nsPtr = (Namespace *) namespacePtr;
    }

    /*
     * Append the export pattern list onto objPtr.
     */

    if (nsPtr->exportPatternList == NULL) {
	return TCL_OK;
    }
    return Tcl_ListObjAppendList(interp, objPtr, nsPtr->exportPatternList);
}

/*
 *----------------------------------------------------------------------
 *
 * TclFillTableWithExports --
 *
 *	Discover what commands are actually exported by *nsPtr.
 *	What we have is an array of patterns and a hash table whose keys
 *	are the command names defined in the namespace (the contents do
 *	not matter here.) We must find out what commands are actually
 *	exported by filtering each command in the namespace against each of
 *	the patterns in the export list.  Store the exported command
 * 	set in hash, with fully qualified command prefix as value.
 *
 *	Suggestion for future enhancement: compute the unique prefixes and
 *	place them in the hash too, which should make for even faster
 *	matching.
 *
 * Results:
 *
 * Side effects:
 *
 *----------------------------------------------------------------------
 */

void
TclFillTableWithExports(
    Namespace *nsPtr,
    Tcl_HashTable *hash)
{
    Tcl_HashSearch search;
    Tcl_HashEntry *hPtr;

    if (nsPtr->exportPatternList == NULL) {
	return;
    }

    hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
    for (; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	int objc;
	Tcl_Obj **objv;
	char *nsCmdName = Tcl_GetHashKey(&nsPtr->cmdTable, hPtr);

	Tcl_ListObjGetElements(NULL, nsPtr->exportPatternList, &objc, &objv);
	while (objc--) {
	    if (Tcl_StringMatch(nsCmdName, Tcl_GetString(*objv++))) {
		int isNew;
		Tcl_HashEntry *exportPtr = Tcl_CreateHashEntry(hash,
			nsCmdName, &isNew);

		/*
		 * Remember, hash entries have a full reference to the
		 * substituted part of the command (as a list) as their
		 * content!
		 */

		if (isNew) {
		    Tcl_Obj *cmdObj, *cmdPrefixObj;

		    TclNewObj(cmdObj);
		    Tcl_AppendStringsToObj(cmdObj, nsPtr->fullName,
			    (nsPtr->parentPtr ? "::" : ""), nsCmdName, NULL);
		    cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
		    Tcl_SetHashValue(exportPtr, cmdPrefixObj);
		    Tcl_IncrRefCount(cmdPrefixObj);
		}
		break;
	    }
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Import --
 *

    Namespace *nsPtr,
    Tcl_HashEntry *hPtr,
    const char *cmdName,
    const char *pattern,
    Namespace *importNsPtr,
    int allowOverwrite)
{
    int objc, exported = 0;
    Tcl_Obj **objv;
    Tcl_HashEntry *found;

    /*
     * The command cmdName in the source namespace matches the pattern. Check
     * whether it was exported. If it wasn't, we ignore it.
     */

    if (importNsPtr->exportPatternList == NULL) {
	return TCL_OK;
    }

    Tcl_ListObjGetElements(NULL, importNsPtr->exportPatternList, &objc, &objv);
    while (!exported && objc--) {
	exported |= Tcl_StringMatch(cmdName, Tcl_GetString(*objv++));

    }
    if (!exported) {
	return TCL_OK;
    }

    /*
     * Unless there is a name clash, create an imported command in the current

static int
NamespaceExportCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Namespace *nsPtr;
    Tcl_Obj *dict, *value;
    int startSize, endSize, firstArg, i, changed = 0;
    int code = TCL_OK;

    if (objc < 1) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-clear? ?pattern pattern...?");
	return TCL_ERROR;
    }

    /*
     * If no pattern arguments are given, and "-clear" isn't specified, return
     * the namespace's current export pattern list.
     */

    nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    if (objc == 1) {

	if (nsPtr->exportPatternList) {

	    Tcl_SetObjResult(interp,
		    TclListObjCopy(NULL, nsPtr->exportPatternList));
	}
	return TCL_OK;
    }

    /*
     * Process the optional "-clear" argument.
     */

    firstArg = 1;
    if (strcmp("-clear", Tcl_GetString(objv[firstArg])) == 0) {
	if (nsPtr->exportPatternList) {
	    Tcl_DecrRefCount(nsPtr->exportPatternList);
	    nsPtr->exportPatternList = NULL;
	    changed = 1;
	}
	firstArg++;
    }

    /*
     * Add each pattern to the namespace's export pattern list.
     * Use a dict as a simple way to screen out duplicates.
     */

    dict = Tcl_NewDictObj();
    value = Tcl_NewObj();
    Tcl_IncrRefCount(value);
    if (nsPtr->exportPatternList) {
	int epc;
	Tcl_Obj **epv;

	Tcl_ListObjGetElements(NULL, nsPtr->exportPatternList, &epc, &epv);
	while (epc--) {
	    Tcl_DictObjPut(NULL, dict, *epv++, value);
	}
    }
    Tcl_DictObjSize(NULL, dict, &startSize);

    for (i = firstArg;  i < objc;  i++) {
	Namespace *exportNsPtr, *dummyPtr;
	const char *simplePattern, *pattern = Tcl_GetString(objv[i]);

	TclGetNamespaceForQualName(interp, pattern, nsPtr,
		TCL_NAMESPACE_ONLY, &exportNsPtr, &dummyPtr, &dummyPtr,
		&simplePattern);

	if ((exportNsPtr != nsPtr) || (strcmp(pattern, simplePattern) != 0)) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid export pattern"
		    " \"%s\": pattern can't specify a namespace", pattern));
	    Tcl_SetErrorCode(interp, "TCL", "EXPORT", "INVALID", NULL);
	    code = TCL_ERROR;
	    break;
	}

	Tcl_DictObjPut(NULL, dict, objv[i], value);
    }
    Tcl_DictObjSize(NULL, dict, &endSize);
    changed |= (endSize > startSize);

    if (endSize > startSize) {
	int done;
	Tcl_Obj *ep;
	Tcl_DictSearch search;

	if (nsPtr->exportPatternList == NULL) {
	    nsPtr->exportPatternList = Tcl_NewObj();
	    Tcl_IncrRefCount(nsPtr->exportPatternList);
	}

	i = 0;
	Tcl_DictObjFirst(NULL, dict, &search, &ep, NULL, &done);
	for (; !done; i++, Tcl_DictObjNext(&search, &ep, NULL, &done)) {
	    if (i < startSize) {
		continue;
	    }
	    Tcl_ListObjAppendElement(NULL, nsPtr->exportPatternList, ep);
	}
	Tcl_DictObjDone(&search);
    }
    Tcl_DecrRefCount(value);
    Tcl_DecrRefCount(dict);

    if (changed) {
	TclInvalidateNsCmdLookup(nsPtr);
    }
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * NamespaceForgetCmd --
 *

    Tcl_InitHashTable(tablePtr, TCL_ONE_WORD_KEYS);

    /*
     * The starts of commands represent target addresses.
     */

    for (i=0 ; i<envPtr->numCommands ; i++) {
	DefineTargetAddress(tablePtr, TclCmdStartAddress(envPtr, i));

    }

    /*
     * Find places where we should be careful about replacing instructions
     * because they are the targets of various types of jumps.
     */

    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
};

/* Set of parsing error messages */

static const char *parseErrorMsg[] = {
    "",
    "extra characters after close-quote",
    "extra characters after close-brace",
    "missing close-brace",
    "missing close-bracket",
    "missing )",
    "missing \"",
    "missing close-brace for variable name",
    "syntax error in expression",
    "bad number in expression"
};

/*
 * Prototypes for local functions defined in this file:
 */

static inline int	CommandComplete(const char *script, int numBytes);
static int		ParseBraces(Tcl_Interp *interp, const char *start,
			    int numBytes, Tcl_Parse *parsePtr, int flags,
			    const char **termPtr);
static int		ParseComment(const char *src, int numBytes,
			    Tcl_Parse *parsePtr);
void			ParseScript(const char *script, int numBytes,
			    int flags, Tcl_Parse *parsePtr);
static int		ParseTokens(const char *src, int numBytes, int mask,
			    int flags, Tcl_Parse *parsePtr);
static int		ParseWhiteSpace(const char *src, int numBytes,
			    int *incompletePtr, char *typePtr);

/*
 * Prototypes for the Tokens object type.
 */

static void             DupTokensInternalRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
static void             FreeTokensInternalRep(Tcl_Obj *objPtr);
static int              SetTokensFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void		UpdateStringOfTokens(Tcl_Obj *objPtr);

/*
 * The structure below defines the "tokens" Tcl object type.
 */

static Tcl_ObjType tokensType = {
    "tokens",                           /* name */
    FreeTokensInternalRep,              /* freeIntRepProc */
    DupTokensInternalRep,               /* dupIntRepProc */
    UpdateStringOfTokens,		/* updateStringProc */
    SetTokensFromAny                   /* setFromAnyProc */
};

/* Structure to hold the data of the "tokens" internal rep */
typedef struct TokenIntRep {
    int		refCount;
    Tcl_Obj *	scriptObjPtr;
    Tcl_Token *	tokenPtr;
    Tcl_Token *	lastTokenPtr;
} TokenIntRep;

/*
 *----------------------------------------------------------------------
 *
 * FreeTokensInternalRep --
 *
 *      Frees the resources associated with a tokens object's internal
 *      representation.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Frees the cached Tcl_Token array.
 *
 *----------------------------------------------------------------------
 */

static void
FreeTokensInternalRep(objPtr)
    Tcl_Obj *objPtr;
{
    TokenIntRep *tirPtr = objPtr->internalRep.otherValuePtr;

    if (tirPtr->refCount) {
	tirPtr->refCount--;
	
	if (tirPtr->refCount == 0) {
	    /* Only one holder left.
	     * If it's the original, break the reference cycle. */
	    if (tirPtr->scriptObjPtr == objPtr) {

		/* Make direct change to refCount.  Don't call
		 * Tcl_DecrRefCount() so we avoid freeing the value
		 * when dropping from refCount 1 to refCount 0.
		 */
		objPtr->refCount--;
		tirPtr->scriptObjPtr = NULL;
	    }
	}
	return;
    }

    if (tirPtr->scriptObjPtr) {
	Tcl_DecrRefCount(tirPtr->scriptObjPtr);
    }
    ckfree(tirPtr->tokenPtr);
    ckfree(tirPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * DupTokensInternalRep --
 *
 *      Do not copy the internal Tcl_Token array, because it contains
 *      pointers into the original string rep.  Instead, leave the copied
 *      Tcl_Obj untyped with only the string value.  If the new copied
 *      value gets used as a script, new parsing will be done to produce
 *      a new Tcl_Token array intrep tied to the copied string.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

static void
DupTokensInternalRep(srcPtr, dupPtr)
    Tcl_Obj *srcPtr;            /* Object with internal rep to copy. */
    Tcl_Obj *dupPtr;            /* Object with internal rep to set. */
{
    TokenIntRep *tirPtr = srcPtr->internalRep.otherValuePtr;

    if (tirPtr->refCount == 0) {
	tirPtr->scriptObjPtr = srcPtr;
	Tcl_IncrRefCount(srcPtr);
    }
    tirPtr->refCount++;
    dupPtr->internalRep.otherValuePtr = tirPtr;
    dupPtr->typePtr = &tokensType;
    return;
}

/*
 *----------------------------------------------------------------------
 *
 * SetTokensFromAny --
 *
 *      Generates an internal representation, an array of Tcl_Token's,
 *      by parsing the string representation as a Tcl script.
 *
 * Results:
 *      Returns TCL_OK.  (Parsing always succeeds, in the sense that
 *      a sequence of Tcl_Token's is always generated.  Parse errors
 *      get represented by a special Tcl_Token type.)
 *
 * Side effects:
 *      Frees the old internal representation.  Sets the first pointer
 *      of the twoPtrValue field of the internal rep to a (Tcl_Token *)
 *      pointing to an array of Tcl_Token's from the parse, and the
 *      second pointer to point to the last token in the array.
 *
 *----------------------------------------------------------------------
 */

static int
SetTokensFromAny (interp, objPtr)
    Tcl_Interp *interp;	/* Not used. */
    Tcl_Obj *objPtr;	/* Value for which to generate Tcl_Token array by
			 * parsing the string value */
{
    int numBytes;
    const char *script = Tcl_GetStringFromObj(objPtr, &numBytes);
    TokenIntRep *tirPtr = ckalloc(sizeof(TokenIntRep));

    /*
     * Free the old internal rep, parse the string as a Tcl script, and
     * save the Tcl_Token array as the new internal rep
     */

    TclFreeIntRep(objPtr);
    tirPtr->tokenPtr = TclParseScript(interp, script, numBytes, 0,
	    &(tirPtr->lastTokenPtr), NULL);
    tirPtr->scriptObjPtr = NULL;
    tirPtr->refCount = 0;
    objPtr->internalRep.otherValuePtr = tirPtr;
    objPtr->typePtr = &tokensType;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfTokens --
 *
 *      The Tcl_Obj returned by TclTokensCopy is pure -- it has no valid
 *	string rep.  When we have to have one, this routine generates it.
 *
 * Results:
 *      Returns TCL_OK.
 *
 * Side effects:
 *	Allocates new string rep to hold copy of the original string
 *	parsed to make the tokens.
 *
 *----------------------------------------------------------------------
 */

static void
UpdateStringOfTokens(
    Tcl_Obj *objPtr)
{
    TokenIntRep *tirPtr = objPtr->internalRep.otherValuePtr;
    int length;
    char *bytes;

    if (tirPtr->scriptObjPtr == NULL) {
	Tcl_Panic("Lost scriptObjPtr in tokens value");
    }
    bytes = Tcl_GetStringFromObj(tirPtr->scriptObjPtr, &length);
    TclInitStringRep(objPtr, bytes, length);
}

/*
 *----------------------------------------------------------------------
 *
 * TclTokensCopy --
 *
 *      Make a pure copy of a list value.  Cheap operation so caller can
 *	call TclGetTokensFromObj without fear of shimmering.
 *
 * Results:
 *      Returns pointer to new Tcl_Obj with refCount zero.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */
Tcl_Obj *
TclTokensCopy(
    Tcl_Obj *objPtr)
{
    Tcl_Obj *copyPtr;

    if (objPtr->typePtr != &tokensType) {
	SetTokensFromAny(NULL, objPtr);
    }

    TclNewObj(copyPtr);
    TclInvalidateStringRep(copyPtr);
    DupTokensInternalRep(objPtr, copyPtr);
    return copyPtr;
}

/*
 *-------------------------------------------------------------------------
 *
 * TclGetTokensFromObj --
 *
 *      Returns a Tcl_Token sequence derived from parsing a Tcl_Obj.
 *
 * Results:
 *      Parses the string rep of the Tcl_Obj, if not already done.
 *
 * Side effects:
 *      Initializes the table of defined object types "typeTable" with
 *      builtin object types defined in this file.
 *
 *-------------------------------------------------------------------------
 */

Tcl_Token *
TclGetTokensFromObj(objPtr,lastTokenPtrPtr)
    Tcl_Obj *objPtr;   		 /* Value to parse and return tokens for */
    Tcl_Token **lastTokenPtrPtr; /* If not NULL, fill with pointer to last
				  * token in the token array */
{
    TokenIntRep *tirPtr;

    if (objPtr->typePtr != &tokensType) {
	SetTokensFromAny(NULL, objPtr);
    }
    tirPtr = objPtr->internalRep.otherValuePtr;
    if (lastTokenPtrPtr != NULL) {
	*lastTokenPtrPtr = tirPtr->lastTokenPtr;
    }
    return tirPtr->tokenPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclParseScript --
 *
 * Results:
 *
 * Side effects:
 *
 *----------------------------------------------------------------------
 */

Tcl_Token *
TclParseScript(interp, script, numBytes, flags, lastTokenPtrPtr, termPtr)
    Tcl_Interp *interp;
    const char *script;		/* The string to parse */
    int numBytes;		/* Length of string in bytes */
    int flags;			/* Bit flags that control parsing details. */
    Tcl_Token **lastTokenPtrPtr;/* Return pointer to last token */
    const char **termPtr;	/* Return the terminating character in string */
{
    Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));
    Tcl_Token *result;

    if (numBytes < 0) {
	numBytes = strlen(script);
    }
    TclParseInit(NULL, script, numBytes, parsePtr);
    ParseScript(script, numBytes, flags, parsePtr);

    if (termPtr != NULL) {
	*termPtr = parsePtr->term;
    }
    /*
     * Note no call to Tcl_FreeParse().
     * We'll transfer the tokens to the caller.
     */
    if (parsePtr->tokenPtr != parsePtr->staticTokens) {
	result = ckrealloc(parsePtr->tokenPtr,
		parsePtr->numTokens * sizeof(Tcl_Token));
    } else {
	result = ckalloc(parsePtr->numTokens * sizeof(Tcl_Token));
	memcpy(result, parsePtr->tokenPtr, 
		(size_t) (parsePtr->numTokens * sizeof(Tcl_Token)));
    }

    if (lastTokenPtrPtr != NULL) {
	*lastTokenPtrPtr = &(result[parsePtr->numTokens - 1]);
    }
    TclStackFree(interp, parsePtr);
    return result;
}

void
ParseScript(script, numBytes, flags, parsePtr)
    const char *script;		/* The string to parse */
    int numBytes;		/* Length of string in bytes */
    int flags;			/* Bit flags that control parsing details. */
    Tcl_Parse *parsePtr;
{
    const char *p, *end;
    int nested = (flags & PARSE_NESTED);
    int scriptToken, numValidTokens;
    Tcl_Token *scriptTokenPtr;

    TclGrowParseTokenArray(parsePtr, 1);
    scriptToken = parsePtr->numTokens++;
    scriptTokenPtr = &parsePtr->tokenPtr[scriptToken];
    scriptTokenPtr->type = TCL_TOKEN_SCRIPT;
    scriptTokenPtr->start = script;
    scriptTokenPtr->size = numBytes;
    scriptTokenPtr->numComponents = 0;

    p = script;
    end = p + numBytes;
    numValidTokens = parsePtr->numTokens;

    while (p < end) {
	int cmdToken;
	Tcl_Token *cmdTokenPtr;

	TclGrowParseTokenArray(parsePtr, 1);
	cmdToken = parsePtr->numTokens++;

	parsePtr->errorType = TCL_PARSE_SUCCESS;
	parsePtr->term = parsePtr->end;
	if (TCL_OK != TclParseCommand(parsePtr->interp, p, (int) (end - p),
		flags | PARSE_APPEND | PARSE_USE_INTERNAL_TOKENS, parsePtr)) {
	    break;
	}

	p = parsePtr->commandStart + parsePtr->commandSize;

	/*
	 * Check for missing close-brace for nested script substitution.
	 * If close-brace is missing, blame it on the last command parsed,
	 * and do not add it to the token array.
	 */

	if (nested && (parsePtr->term >= end)) {
	    break;
	}

	cmdTokenPtr = &parsePtr->tokenPtr[cmdToken];
	cmdTokenPtr->type = TCL_TOKEN_CMD;
	cmdTokenPtr->start = parsePtr->commandStart;
	if (parsePtr->commandStart + parsePtr->commandSize == parsePtr->term) {
	    cmdTokenPtr->size = parsePtr->commandSize;
	} else {
	    cmdTokenPtr->size = parsePtr->commandSize - 1;
	}
	cmdTokenPtr->numComponents = parsePtr->numWords;

	scriptTokenPtr = &parsePtr->tokenPtr[scriptToken];
	scriptTokenPtr->numComponents++;	/* Another command parsed */
	numValidTokens = parsePtr->numTokens;

	if (nested && (parsePtr->term < end) && (*parsePtr->term == ']')) {
	    scriptTokenPtr->size = parsePtr->term - scriptTokenPtr->start;
	    break;
	}
    }
    /* Check all cases that indicate missing ] */
    if (nested && (p >= end) && ((parsePtr->term >= parsePtr->end)
	    || (*parsePtr->term != ']'))) {
	parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
	parsePtr->term = script - 1;
	parsePtr->incomplete = 1;
	if (parsePtr->interp != NULL) {
	    Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj(
		    parseErrorMsg[parsePtr->errorType], -1));
	}
    }

    parsePtr->numTokens = numValidTokens;

    if ((parsePtr->errorType != TCL_PARSE_SUCCESS)) {
	int errorToken;
	Tcl_Token *errorTokenPtr;

	TclGrowParseTokenArray(parsePtr, 1);
	errorToken = parsePtr->numTokens++;
	errorTokenPtr = &parsePtr->tokenPtr[errorToken];
	errorTokenPtr->type = TCL_TOKEN_ERROR;
	errorTokenPtr->start = parsePtr->commandStart;
	errorTokenPtr->size = parsePtr->term + 1 - parsePtr->commandStart;
	errorTokenPtr->numComponents = parsePtr->errorType;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclParseInit --
 *
 *	Initialize the fields of a Tcl_Parse struct.

 *	release any additional space that was allocated.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ParseCommand(
    Tcl_Interp *interp,		/* See TclParseCommand */
    const char *start,		/* See TclParseCommand */
    register int numBytes,	/* See TclParseCommand */
    int nested,			/* Non-zero means this is a nested command:
				 * close bracket should be considered
				 * a command terminator. If zero, then close
				 * bracket has no special meaning. */
    register Tcl_Parse *parsePtr)
    				/* See TclParseCommand */
{
    int code = TclParseCommand(interp, start, numBytes,
	    (nested != 0) ? PARSE_NESTED : 0, parsePtr);
    if (code == TCL_ERROR) {
	Tcl_FreeParse(parsePtr);
    }
    return code;
}

int
TclParseCommand(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting; if
				 * NULL, then no error message is provided. */
    const char *start,		/* First character of string containing one or
				 * more Tcl commands. */
    register int numBytes,	/* Total number of bytes in string. If < 0,
				 * the script consists of all bytes up to the
				 * first null character. */
    int flags,			/* Bit flags to control details of the parsing.
				 * Only the PARSE_NESTED flag has an effect

				 * here.  Other flags are passed along. */
    register Tcl_Parse *parsePtr)
				/* Structure to fill in with information about
				 * the parsed command; any previous
				 * information in the structure is ignored. */
{
    register const char *src;	/* Points to current character in the
				 * command. */
    char type;			/* Result returned by CHAR_TYPE(*src). */
    Tcl_Token *tokenPtr;	/* Pointer to token being filled in. */
    int wordIndex;		/* Index of word token for current word. */
    int terminators;		/* CHAR_TYPE bits that indicate the end of a
				 * command. */
    const char *termPtr;	/* Set by Tcl_ParseBraces/QuotedString to
				 * point to char after terminating one. */
    int scanned;
    int nested = (flags & PARSE_NESTED);
    int append = (flags & PARSE_APPEND);
    const char *commandStart;
    int numWords = 0;

    if ((start == NULL) && (numBytes != 0)) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "can't parse a NULL pointer", -1));
	}
	return TCL_ERROR;
    }
    if (numBytes < 0) {
	numBytes = strlen(start);
    }
    if (!append) {
	TclParseInit(interp, start, numBytes, parsePtr);
	parsePtr->commentStart = NULL;
	parsePtr->commentSize = 0;
	parsePtr->commandStart = NULL;
	parsePtr->commandSize = 0;
    }
    if (nested != 0) {
	terminators = TYPE_COMMAND_END | TYPE_CLOSE_BRACK;
    } else {
	terminators = TYPE_COMMAND_END;
    }

    /*

    }

    /*
     * The following loop parses the words of the command, one word in each
     * iteration through the loop.
     */

    commandStart = parsePtr->commandStart = src;
    while (1) {
	int expandWord = 0;

	/*
	 * Create the token for the word.
	 */

	if ((type & terminators) != 0) {
	    parsePtr->term = src;
	    src++;
	    break;
	}
	tokenPtr->start = src;
	parsePtr->numTokens++;
	numWords++;

	/*
	 * At this point the word can have one of four forms: something
	 * enclosed in quotes, something enclosed in braces, and expanding
	 * word, or an unquoted word (anything else).
	 */

    parseWord:
	if (*src == '"') {
	    if (TclParseQuotedString(interp, src, numBytes, parsePtr,
		    flags | PARSE_APPEND, &termPtr) != TCL_OK) {
		goto error;
	    }
	    src = termPtr;
	    numBytes = parsePtr->end - src;
	} else if (*src == '{') {
	    int expIdx = wordIndex + 1;
	    Tcl_Token *expPtr;

	    if (ParseBraces(interp, src, numBytes, parsePtr,
		    flags | PARSE_APPEND, &termPtr) != TCL_OK) {
		goto error;
	    }
	    src = termPtr;
	    numBytes = parsePtr->end - src;

	    /*
	     * Check whether the braces contained the word expansion prefix

	} else {
	    /*
	     * This is an unquoted word. Call ParseTokens and let it do all of
	     * the work.
	     */

	    if (ParseTokens(src, numBytes, TYPE_SPACE|terminators,
		    flags | TCL_SUBST_ALL, parsePtr) != TCL_OK) {
		goto error;
	    }
	    src = parsePtr->term;
	    numBytes = parsePtr->end - src;
	}

	/*

		    /*
		     * We are expanding a literal empty list. This means that
		     * the expanding word completely disappears, leaving no
		     * word generated this pass through the loop. Adjust
		     * accounting appropriately.
		     */

		    numWords--;
		    parsePtr->numTokens = wordIndex;
		} else {
		    /*
		     * Recalculate the number of Tcl_Tokens needed to store
		     * tokens representing the expanded list.
		     */

		    const char *listStart;
		    int growthNeeded = wordIndex + 2*elemCount
			    - parsePtr->numTokens;

		    numWords += elemCount - 1;
		    if (growthNeeded > 0) {
			TclGrowParseTokenArray(parsePtr, growthNeeded);
			tokenPtr = &parsePtr->tokenPtr[wordIndex];
		    }
		    parsePtr->numTokens = wordIndex + 2*elemCount;

		    /*