Tcl Source Code

2013-05-10  Donal K. Fellows  <[email protected]>

	Optimizations and general bytecode generation improvements.
	* generic/tclCompCmds.c (TclCompileAppendCmd, TclCompileLappendCmd):
	(TclCompileReturnCmd): Make these generate bytecode in more cases.
	(TclCompileListCmd): Make this able to push a literal when it can.
	* generic/tclCompile.c (TclSetByteCodeFromAny, PeepholeOptimize):
	Added checks to see if we can apply some simple cross-command-boundary
	optimizations, and defined a small number of such optimizations.
	(TclCompileScript): Added the special ability to compile the list
	command with expansion ([list {*}blah]) into bytecode that does not
	call an external command.

2013-05-06  Jan Nijtmans  <[email protected]>

	* generic/tclStubInit.c: Add support for Cygwin64, which has a 64-bit
	* generic/tclDecls.h: "long" type. Binary compatibility with win64
	requires that all stub entries use 32-bit long's, therefore the
	need for various wrapper functions/macros. For Tcl 9 a better
	solution is needed, but that cannot be done without introducing

/*-
 *- THINGS TO DO:
 *- More instructions:
 *-   done - alternate exit point (affects stack and exception range checking)
 *-   break and continue - if exception ranges can be sorted out.
 *-   foreach_start4, foreach_step4
 *-   returnImm, returnStk
 *-   expandStart, expandStkTop, invokeExpanded, listExpanded
 *-   dictFirst, dictNext, dictDone
 *-   dictUpdateStart, dictUpdateEnd
 *-   jumpTable testing
 *-   syntax (?)
 *-   returnCodeBranch
 */

					 | INST_LAPPEND_ARRAY4),2,	1},
    {"lappendArrayStk", ASSEM_1BYTE,	INST_LAPPEND_ARRAY_STK,	3,	1},
    {"lappendStk",	ASSEM_1BYTE,	INST_LAPPEND_STK,	2,	1},
    {"le",		ASSEM_1BYTE,	INST_LE,		2,	1},
    {"lindexMulti",	ASSEM_LINDEX_MULTI,
					INST_LIST_INDEX_MULTI,	INT_MIN,1},
    {"list",		ASSEM_LIST,	INST_LIST,		INT_MIN,1},
    {"listConcat",	ASSEM_1BYTE,	INST_LIST_CONCAT,	2,	1},
    {"listIn",		ASSEM_1BYTE,	INST_LIST_IN,		2,	1},
    {"listIndex",	ASSEM_1BYTE,	INST_LIST_INDEX,	2,	1},
    {"listIndexImm",	ASSEM_INDEX,	INST_LIST_INDEX_IMM,	1,	1},
    {"listLength",	ASSEM_1BYTE,	INST_LIST_LENGTH,	1,	1},
    {"listNotIn",	ASSEM_1BYTE,	INST_LIST_NOT_IN,	2,	1},
    {"load",		ASSEM_LVT,	(INST_LOAD_SCALAR1 << 8
					 | INST_LOAD_SCALAR4),	0,	1},

    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. */
{
    Tcl_Token *varTokenPtr, *valueTokenPtr;
    int simpleVarName, isScalar, localIndex, numWords, i;
    DefineLineInformation;	/* TIP #280 */

    numWords = parsePtr->numWords;
    if (numWords == 1) {
	return TCL_ERROR;
    } else if (numWords == 2) {
	/*
	 * append varName == set varName
	 */

	return TclCompileSetCmd(interp, parsePtr, cmdPtr, envPtr);
    } else if (numWords > 3) {
	/*
	 * APPEND instructions currently only handle one value, but we can
	 * handle some multi-value cases by stringing them together.
	 */


	goto appendMultiple;
    }

    /*
     * Decide if we can use a frame slot for the var/array name or if we need
     * to emit code to compute and push the name at runtime. We use a frame
     * slot (entry in the array of local vars) if we are compiling a procedure
     * body and if the name is simple text that does not include namespace

	    } else {
		Emit14Inst(INST_APPEND_ARRAY, localIndex, envPtr);
	    }
	}
    } else {
	TclEmitOpcode(INST_APPEND_STK, envPtr);
    }

    return TCL_OK;

  appendMultiple:
    /*
     * Can only handle the case where we are appending to a local scalar when
     * there are multiple values to append.  Fortunately, this is common.
     */

    if (envPtr->procPtr == NULL) {
	return TCL_ERROR;
    }
    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
    PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_ELEMENT,
	    &localIndex, &simpleVarName, &isScalar, 1);
    if (!isScalar || localIndex < 0) {
	return TCL_ERROR;
    }

    /*
     * Definitely appending to a local scalar; generate the words and append
     * them.
     */

    valueTokenPtr = TokenAfter(varTokenPtr);
    for (i = 2 ; i < numWords ; i++) {
	CompileWord(envPtr, valueTokenPtr, interp, i);
	valueTokenPtr = TokenAfter(valueTokenPtr);
    }
    TclEmitInstInt4(	  INST_REVERSE, numWords-2,		envPtr);
    for (i = 2 ; i < numWords ;) {
	Emit14Inst(	  INST_APPEND_SCALAR, localIndex,	envPtr);
	if (++i < numWords) {
	    TclEmitOpcode(INST_POP,				envPtr);
	}
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

    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. */
{
    Tcl_Token *varTokenPtr, *valueTokenPtr;
    int simpleVarName, isScalar, localIndex, numWords, i, fwd, offsetFwd;
    DefineLineInformation;	/* TIP #280 */

    /*
     * If we're not in a procedure, don't compile.
     */

    if (envPtr->procPtr == NULL) {
	return TCL_ERROR;
    }

    numWords = parsePtr->numWords;
    if (numWords == 1) {
	return TCL_ERROR;
    }
    if (numWords != 3) {
	/*
	 * LAPPEND instructions currently only handle one value, but we can
	 * handle some multi-value cases by stringing them together.
	 */


	goto lappendMultiple;
    }

    /*
     * Decide if we can use a frame slot for the var/array name or if we
     * need to emit code to compute and push the name at runtime. We use a
     * frame slot (entry in the array of local vars) if we are compiling a
     * procedure body and if the name is simple text that does not include

	if (localIndex < 0) {
	    TclEmitOpcode(	INST_LAPPEND_ARRAY_STK,		envPtr);
	} else {
	    Emit14Inst(		INST_LAPPEND_ARRAY, localIndex,	envPtr);
	}
    }

    return TCL_OK;

  lappendMultiple:
    /*
     * Can only handle the case where we are appending to a local scalar when
     * there are multiple values to append.  Fortunately, this is common.
     */

    if (envPtr->procPtr == NULL) {
	return TCL_ERROR;
    }
    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
    PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_ELEMENT,
	    &localIndex, &simpleVarName, &isScalar, 1);
    if (!isScalar || localIndex < 0) {
	return TCL_ERROR;
    }

    /*
     * Definitely appending to a local scalar; generate the words and append
     * them.
     */

    valueTokenPtr = TokenAfter(varTokenPtr);
    for (i = 2 ; i < numWords ; i++) {
	CompileWord(envPtr, valueTokenPtr, interp, i);
	valueTokenPtr = TokenAfter(valueTokenPtr);
    }
    TclEmitInstInt4(	  INST_LIST, numWords-2,		envPtr);
    TclEmitInstInt4(	  INST_EXIST_SCALAR, localIndex,	envPtr);
    offsetFwd = CurrentOffset(envPtr);
    TclEmitInstInt1(	  INST_JUMP_FALSE1, 0,			envPtr);
    Emit14Inst(		  INST_LOAD_SCALAR, localIndex,		envPtr);
    TclEmitInstInt4(	  INST_REVERSE, 2,			envPtr);
    TclEmitOpcode(	  INST_LIST_CONCAT,			envPtr);
    fwd = CurrentOffset(envPtr) - offsetFwd;
    TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1);
    Emit14Inst(		  INST_STORE_SCALAR, localIndex,	envPtr);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileLassignCmd --

    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *valueTokenPtr;
    int i, numWords;
    Tcl_Obj *listObj, *objPtr;








    if (parsePtr->numWords == 1) {
	/*
	 * [list] without arguments just pushes an empty object.
	 */

	PushLiteral(envPtr, "", 0);
	return TCL_OK;
    }

    /*
     * Test if all arguments are compile-time known. If they are, we can
     * implement with a simple push.
     */

    numWords = parsePtr->numWords;
    valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
    listObj = Tcl_NewObj();
    for (i = 1; i < numWords && listObj != NULL; i++) {
	objPtr = Tcl_NewObj();
	if (TclWordKnownAtCompileTime(valueTokenPtr, objPtr)) {
	    (void) Tcl_ListObjAppendElement(NULL, listObj, objPtr);
	} else {
	    Tcl_DecrRefCount(objPtr);
	    Tcl_DecrRefCount(listObj);
	    listObj = NULL;
	}
	valueTokenPtr = TokenAfter(valueTokenPtr);
    }
    if (listObj != NULL) {
	int len;
	const char *bytes = Tcl_GetStringFromObj(listObj, &len);

	PushLiteral(envPtr, bytes, len);
	Tcl_DecrRefCount(listObj);
	if (len > 0) {
	    /*
	     * Force list interpretation!
	     */

	    TclEmitOpcode(	INST_DUP,		envPtr);
	    TclEmitOpcode(	INST_LIST_LENGTH,	envPtr);
	    TclEmitOpcode(	INST_POP,		envPtr);
	}
	return TCL_OK;
    }

    /*
     * Push the all values onto the stack.
     */

    numWords = parsePtr->numWords;
    valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
    for (i = 1; i < numWords; i++) {
	CompileWord(envPtr, valueTokenPtr, interp, i);
	valueTokenPtr = TokenAfter(valueTokenPtr);
    }
    TclEmitInstInt4(	INST_LIST, numWords - 1,	envPtr);


    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileLlengthCmd --

     * objv array for merging into a return options dictionary.
     */

    for (objc = 0; objc < numOptionWords; objc++) {
	objv[objc] = Tcl_NewObj();
	Tcl_IncrRefCount(objv[objc]);
	if (!TclWordKnownAtCompileTime(wordTokenPtr, objv[objc])) {
	    /*
	     * Non-literal, so punt to run-time.
	     */


	    for (; objc>=0 ; objc--) {
		TclDecrRefCount(objv[objc]);
	    }
	    TclStackFree(interp, objv);
	    goto issueRuntimeReturn;
	}
	wordTokenPtr = TokenAfter(wordTokenPtr);
    }
    status = TclMergeReturnOptions(interp, objc, objv,
	    &returnOpts, &code, &level);

    while (--objc >= 0) {
	TclDecrRefCount(objv[objc]);
    }
    TclStackFree(interp, objv);
    if (TCL_ERROR == status) {
	/*
	 * Something was bogus in the return options. Clear the error message,

	    /*
	     * ... and there is no enclosing catch. Issue the maximally
	     * efficient exit instruction.
	     */

	    Tcl_DecrRefCount(returnOpts);
	    TclEmitOpcode(INST_DONE, envPtr);
	    envPtr->currStackDepth = savedStackDepth;
	    return TCL_OK;
	}
    }

    /* Optimize [return -level 0 $x]. */
    Tcl_DictObjSize(NULL, returnOpts, &size);
    if (size == 0 && level == 0 && code == TCL_OK) {
	Tcl_DecrRefCount(returnOpts);
	return TCL_OK;
    }

    /*
     * Could not use the optimization, so we push the return options dict, and
     * emit the INST_RETURN_IMM instruction with code and level as operands.
     */

    CompileReturnInternal(envPtr, INST_RETURN_IMM, code, level, returnOpts);
    envPtr->currStackDepth = savedStackDepth + 1;
    return TCL_OK;

  issueRuntimeReturn:
    /*
     * Assemble the option dictionary (as a list as that's good enough).
     */

    wordTokenPtr = TokenAfter(parsePtr->tokenPtr);
    for (objc=1 ; objc<=numOptionWords ; objc++) {
	CompileWord(envPtr, wordTokenPtr, interp, objc);
	wordTokenPtr = TokenAfter(wordTokenPtr);
    }
    TclEmitInstInt4(INST_LIST, numOptionWords, envPtr);

    /*
     * Push the result.
     */

    if (explicitResult) {
	CompileWord(envPtr, wordTokenPtr, interp, numWords-1);
    } else {
	PushLiteral(envPtr, "", 0);
    }

    /*
     * Issue the RETURN itself.
     */

    TclEmitOpcode(INST_RETURN_STK, envPtr);
    envPtr->currStackDepth = savedStackDepth + 1;
    return TCL_OK;
}

static void
CompileReturnInternal(
    CompileEnv *envPtr,
    unsigned char op,

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

/*
 * Table of all AuxData types.
 */

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

 * topmost stack elements.
 *
 * Note that the load, store, and incr instructions do not distinguish local
 * from global variables; the bytecode interpreter at runtime uses the
 * existence of a procedure call frame to distinguish these.
 */

const InstructionDesc const tclInstructionTable[] = {
    /* Name	      Bytes stackEffect #Opnds  Operand types */
    {"done",		  1,   -1,         0,	{OPERAND_NONE}},
	/* Finish ByteCode execution and return stktop (top stack item) */
    {"push1",		  2,   +1,         1,	{OPERAND_UINT1}},
	/* Push object at ByteCode objArray[op1] */
    {"push4",		  5,   +1,         1,	{OPERAND_UINT4}},
	/* Push object at ByteCode objArray[op4] */

    {"returnImm",	  9,   -1,         2,	{OPERAND_INT4, OPERAND_UINT4}},
	/* Compiled [return], code, level are operands; options and result
	 * are on the stack. */
    {"expon",		  1,   -1,	   0,	{OPERAND_NONE}},
	/* Binary exponentiation operator: push (stknext ** stktop) */

    /*
     * NOTE: the stack effects of expandStkTop, invokeExpanded and
     * listExpanded are wrong - but it cannot be done right at compile time,
     * the stack effect is only known at run time. The value for both
     * invokeExpanded and listExpanded are estimated better at compile time.
     * See the comments further down in this file, where INST_INVOKE_EXPANDED
     * and INST_LIST_EXPANDED are emitted.
     */
    {"expandStart",       1,    0,          0,	{OPERAND_NONE}},
	/* Start of command with {*} (expanded) arguments */
    {"expandStkTop",      5,    0,          1,	{OPERAND_UINT4}},
	/* Expand the list at stacktop: push its elements on the stack */
    {"invokeExpanded",    1,    0,          0,	{OPERAND_NONE}},
	/* Invoke the command marked by the last 'expandStart' */

	 * the stack. */

    {"invokeReplace",	 6,	INT_MIN,  2,	{OPERAND_UINT4,OPERAND_UINT1}},
	/* Invoke command named objv[0], replacing the first two words with
	 * the word at the top of the stack;
	 * <objc,objv> = <op4,top op4 after popping 1> */

    {"listConcat",	 1,	-1,	  0,	{OPERAND_NONE}},
	/* Concatenates the two lists at the top of the stack into a single
	 * list and pushes that resulting list onto the stack.
	 * Stack: ... list1 list2 => ... [lconcat list1 list2] */
    {"listExpanded",	 1,	0,	  0,	{OPERAND_NONE}},
	/* Construct a list from the words marked by the last 'expandStart' */

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

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 void		EnterCmdExtentData(CompileEnv *envPtr,
			    int cmdNumber, int numSrcBytes, int numCodeBytes);
static void		EnterCmdStartData(CompileEnv *envPtr,
			    int cmdNumber, 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);
static void		PeepholeOptimize(CompileEnv *envPtr);
#ifdef TCL_COMPILE_STATS
static void		RecordByteCodeStats(ByteCode *codePtr);
#endif /* TCL_COMPILE_STATS */
static void		RegisterAuxDataType(const AuxDataType *typePtr);
static int		SetByteCodeFromAny(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
static int		FormatInstruction(ByteCode *codePtr,

    ClientData clientData)	/* Hook procedure private data. */
{
    Interp *iPtr = (Interp *) interp;
    CompileEnv compEnv;		/* Compilation environment structure allocated
				 * in frame. */
    int length, result = TCL_OK;
    const char *stringPtr;
    Proc *procPtr = iPtr->compiledProcPtr;
    ContLineLoc *clLocPtr;

#ifdef TCL_COMPILE_DEBUG
    if (!traceInitialized) {
	if (Tcl_LinkVar(interp, "tcl_traceCompile",
		(char *) &tclTraceCompile, TCL_LINK_INT) != TCL_OK) {
	    Tcl_Panic("SetByteCodeFromAny: unable to create link for tcl_traceCompile variable");

    /*
     * Successful compilation. Add a "done" instruction at the end.
     */

    TclEmitOpcode(INST_DONE, &compEnv);

    /*
     * Check for optimizations!
     *
     * Test if the generated code is free of most hazards; if so, recompile
     * but with generation of INST_START_CMD disabled. This produces somewhat
     * faster code in some cases, and more compact code in more.
     */

    if (Tcl_GetMaster(interp) == NULL &&
	    !Tcl_LimitTypeEnabled(interp, TCL_LIMIT_COMMANDS|TCL_LIMIT_TIME)
	    && IsCompactibleCompileEnv(interp, &compEnv)) {
	TclFreeCompileEnv(&compEnv);
	iPtr->compiledProcPtr = procPtr;
	TclInitCompileEnv(interp, &compEnv, stringPtr, length,
		iPtr->invokeCmdFramePtr, iPtr->invokeWord);
	if (clLocPtr) {
	    compEnv.clLoc = clLocPtr;
	    compEnv.clNext = &compEnv.clLoc->loc[0];
	    Tcl_Preserve(compEnv.clLoc);
	}
	compEnv.atCmdStart = 2;		/* The disabling magic. */
	TclCompileScript(interp, stringPtr, length, &compEnv);
	TclEmitOpcode(INST_DONE, &compEnv);
    }

    /*
     * Apply some peephole optimizations that can cross specific/generic
     * instruction generator boundaries.
     */

    PeepholeOptimize(&compEnv);

    /*
     * Invoke the compilation hook procedure if one exists.
     */

    if (hookProc) {
	result = hookProc(interp, &compEnv, clientData);
    }

    if (codePtr->localCachePtr && (--codePtr->localCachePtr->refCount == 0)) {
	TclFreeLocalCache(interp, codePtr->localCachePtr);
    }

    TclHandleRelease(codePtr->interpHandle);
    ckfree(codePtr);
}

/*
 * ---------------------------------------------------------------------
 *
 * IsCompactibleCompileEnv --
 *
 *	Checks to see if we may apply some basic compaction optimizations to a
 *	piece of bytecode. Idempotent.
 *
 * ---------------------------------------------------------------------
 */

static int
IsCompactibleCompileEnv(
    Tcl_Interp *interp,
    CompileEnv *envPtr)
{
    unsigned char *pc;
    int size;

    /*
     * Special: procedures in the '::tcl' namespace (or its children) are
     * considered to be well-behaved and so can have compaction applied even
     * if it would otherwise be invalid.
     */

    if (envPtr->procPtr != NULL && envPtr->procPtr->cmdPtr != NULL
	    && envPtr->procPtr->cmdPtr->nsPtr != NULL) {
	Namespace *nsPtr = envPtr->procPtr->cmdPtr->nsPtr;

	if (strcmp(nsPtr->fullName, "::tcl") == 0
		|| strncmp(nsPtr->fullName, "::tcl::", 7) == 0) {
	    return 1;
	}
    }

    /*
     * Go through and ensure that no operation involved can cause a desired
     * change of bytecode sequence during running. This comes down to ensuring
     * that there are no mapped variables (due to traces) or calls to external
     * commands (traces, [uplevel] trickery). This is actually a very
     * conservative check; it turns down a lot of code that is OK in practice.
     */

    for (pc = envPtr->codeStart ; pc < envPtr->codeNext ; pc += size) {
	switch (*pc) {
	    /* Invokes */
	case INST_INVOKE_STK1:
	case INST_INVOKE_STK4:
	case INST_INVOKE_EXPANDED:
	case INST_INVOKE_REPLACE:
	    return 0;
	    /* Runtime evals */
	case INST_EVAL_STK:
	case INST_EXPR_STK:
	case INST_YIELD:
	    return 0;
	    /* Upvars */
	case INST_UPVAR:
	case INST_NSUPVAR:
	case INST_VARIABLE:
	    return 0;
	}
	size = tclInstructionTable[*pc].numBytes;
	assert (size > 0);
    }

    return 1;
}

/*
 * ----------------------------------------------------------------------
 *
 * PeepholeOptimize --
 *
 *	A very simple peephole optimizer for bytecode.
 *
 * ----------------------------------------------------------------------
 */

static void
PeepholeOptimize(
    CompileEnv *envPtr)
{
    unsigned char *pc, *prev1 = NULL, *prev2 = NULL, *target;
    int size, isNew;
    Tcl_HashTable targets;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch hSearch;

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

    Tcl_InitHashTable(&targets, TCL_ONE_WORD_KEYS);
    for (pc = envPtr->codeStart ; pc < envPtr->codeNext ; pc += size) {
	size = tclInstructionTable[*pc].numBytes;
	switch (*pc) {
	case INST_JUMP1:
	case INST_JUMP_TRUE1:
	case INST_JUMP_FALSE1:
	    target = pc + TclGetInt1AtPtr(pc+1);
	    goto storeTarget;
	case INST_JUMP4:
	case INST_JUMP_TRUE4:
	case INST_JUMP_FALSE4:
	    target = pc + TclGetInt4AtPtr(pc+1);
	    goto storeTarget;
	case INST_BEGIN_CATCH4:
	    target = envPtr->codeStart + envPtr->exceptArrayPtr[
		    TclGetUInt4AtPtr(pc+1)].codeOffset;
	storeTarget:
	    (void) Tcl_CreateHashEntry(&targets, (void *) target, &isNew);
	    break;
	case INST_JUMP_TABLE:
	    hPtr = Tcl_FirstHashEntry(
		    &JUMPTABLEINFO(envPtr, pc+1)->hashTable, &hSearch);
	    for (; hPtr ; hPtr = Tcl_NextHashEntry(&hSearch)) {
		target = pc + (int) Tcl_GetHashValue(hPtr);
		(void) Tcl_CreateHashEntry(&targets, (void *) target, &isNew);
	    }
	    break;
	}
    }

    /*
     * Replace PUSH/POP sequences (when non-hazardous) with NOPs.
     */

    (void) Tcl_CreateHashEntry(&targets, (void *) pc, &isNew);
    for (pc = envPtr->codeStart ; pc < envPtr->codeNext ; pc += size) {
	int blank = 0, i;

	size = tclInstructionTable[*pc].numBytes;
	prev2 = prev1;
	prev1 = pc;
	if (Tcl_FindHashEntry(&targets, (void *) (pc + size))) {
	    continue;
	}
	switch (*pc) {
	case INST_PUSH1:
	    while (*(pc+size) == INST_NOP) {
		size++;
	    }
	    if (*(pc+size) == INST_POP) {
		blank = size + 1;
	    } else if (*(pc+size) == INST_CONCAT1
		    && TclGetUInt1AtPtr(pc + size + 1) == 2) {
		Tcl_Obj *litPtr = TclFetchLiteral(envPtr,
			TclGetUInt1AtPtr(pc + 1));
		int numBytes;

		(void) Tcl_GetStringFromObj(litPtr, &numBytes);
		if (numBytes == 0) {
		    blank = size + 2;
		}
	    }
	    break;
	case INST_PUSH4:
	    while (*(pc+size) == INST_NOP) {
		size++;
	    }
	    if (*(pc+size) == INST_POP) {
		blank = size + 1;
	    } else if (*(pc+size) == INST_CONCAT1
		    && TclGetUInt1AtPtr(pc + size + 1) == 2) {
		Tcl_Obj *litPtr = TclFetchLiteral(envPtr,
			TclGetUInt4AtPtr(pc + 1));
		int numBytes;

		(void) Tcl_GetStringFromObj(litPtr, &numBytes);
		if (numBytes == 0) {
		    blank = size + 2;
		}
	    }
	    break;
	}
	if (blank > 0) {
	    for (i=0 ; i<blank ; i++) {
		*(pc + i) = INST_NOP;
	    }
	    size = blank;
	}
    }

    /*
     * Trim a trailing double DONE.
     */

    if (prev1 && prev2 && *prev1 == INST_DONE && *prev2 == INST_DONE
	    && !Tcl_FindHashEntry(&targets, (void *) prev1)) {
	envPtr->codeNext--;
    }
    Tcl_DeleteHashTable(&targets);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SubstObj --
 *
 *	This function performs the substitutions specified on the given string

    const char *stringPtr,	/* The source string to be compiled. */
    int numBytes,		/* Number of bytes in source string. */
    const CmdFrame *invoker,	/* Location context invoking the bcc */
    int word)			/* Index of the word in that context getting
				 * compiled */
{
    Interp *iPtr = (Interp *) interp;

    assert(tclInstructionTable[LAST_INST_OPCODE+1].name == NULL);

    envPtr->iPtr = iPtr;
    envPtr->source = stringPtr;
    envPtr->numSrcBytes = numBytes;
    envPtr->procPtr = iPtr->compiledProcPtr;
    iPtr->compiledProcPtr = NULL;
    envPtr->numCommands = 0;

	TclAdvanceLines(&cmdLine, p, parsePtr->commandStart);
	TclAdvanceContinuations(&cmdLine, &clNext,
		parsePtr->commandStart - envPtr->source);

	if (parsePtr->numWords > 0) {
	    int expand = 0;	/* Set if there are dynamic expansions to
				 * handle */
	    int expandIgnoredWords = 0;
				/* The number of *apparent* words that we are
				 * generating code from directly during
				 * expansion processing. For [list {*}blah]
				 * expansion, we set this to one because we
				 * ignore the first word and generate code
				 * directly. */

	    /*
	     * If not the first command, pop the previous command's result
	     * and, if we're compiling a top level command, update the last
	     * command's code size to account for the pop instruction.
	     */

	     * words.
	     */

	    for (wordIdx = 0, tokenPtr = parsePtr->tokenPtr;
		    wordIdx < parsePtr->numWords;
		    wordIdx++, tokenPtr += tokenPtr->numComponents + 1) {
		if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
		    expand = INST_INVOKE_EXPANDED;
		    break;
		}
	    }

	    envPtr->numCommands++;
	    currCmdIndex = envPtr->numCommands - 1;
	    lastTopLevelCmdIndex = currCmdIndex;

			 * case. [Bug 1752146]
			 *
			 * Note that the environment is initialised with
			 * atCmdStart=1 to avoid emitting ISC for the first
			 * command.
			 */

			if (envPtr->atCmdStart == 1) {
			    if (savedCodeNext != 0) {
				/*
				 * Increase the number of commands being
				 * started at the current point. Note that
				 * this depends on the exact layout of the
				 * INST_START_CMD's operands, so be careful!
				 */

				unsigned char *fixPtr = envPtr->codeNext - 4;

				TclStoreInt4AtPtr(TclGetUInt4AtPtr(fixPtr)+1,
					fixPtr);
			    }
			} else if (envPtr->atCmdStart == 0) {
			    TclEmitInstInt4(INST_START_CMD, 0, envPtr);
			    TclEmitInt4(1, envPtr);
			    update = 1;
			}

			code = cmdPtr->compileProc(interp, parsePtr, cmdPtr,
				envPtr);

					- envPtr->codeStart - savedCodeNext;

				TclStoreInt4AtPtr(fixLen, fixPtr);
			    }
			    goto finishCommand;
			}

			if (envPtr->atCmdStart == 1 && savedCodeNext != 0) {
			    /*
			     * Decrease the number of commands being started
			     * at the current point. Note that this depends on
			     * the exact layout of the INST_START_CMD's
			     * operands, so be careful!
			     */

		    objIndex = TclRegisterNewCmdLiteral(envPtr,
			    tokenPtr[1].start, tokenPtr[1].size);
		    if (cmdPtr != NULL) {
			TclSetCmdNameObj(interp,
				TclFetchLiteral(envPtr, objIndex), cmdPtr);
		    }
		} else {
		    if (wordIdx == 0 && expand) {
			TclDStringClear(&ds);
			TclDStringAppendToken(&ds, &tokenPtr[1]);
			cmdPtr = (Command *) Tcl_FindCommand(interp,
				Tcl_DStringValue(&ds),
				(Tcl_Namespace *) cmdNsPtr, /*flags*/ 0);
			if ((cmdPtr != NULL) &&
				(cmdPtr->compileProc == TclCompileListCmd)) {
			    /*
			     * Special case! [list] command can be expanded
			     * directly provided the first word is not the
			     * expanded one.
			     */

			    expand = INST_LIST_EXPANDED;
			    expandIgnoredWords = 1;
			    continue;
			}
		    }

		    /*
		     * Simple argument word of a command. We reach this if and
		     * only if the command word was not compiled for whatever
		     * reason. Register the literal's location for use by
		     * uplevel, etc. commands, should they encounter it
		     * unmodified. We care only if the we are in a context
		     * which already allows absolute counting.

		 * The end effect of this command's invocation is that all the
		 * words of the command are popped from the stack, and the
		 * result is pushed: the stack top changes by (1-wordIdx).
		 *
		 * Note that the estimates are not correct while the command
		 * is being prepared and run, INST_EXPAND_STKTOP is not
		 * stack-neutral in general.
		 *
		 * The opcodes that may be issued here (both assumed to be
		 * non-zero) are INST_INVOKE_EXPANDED and INST_LIST_EXPANDED.
		 */

		TclEmitOpcode(expand, envPtr);
		TclAdjustStackDepth(1 + expandIgnoredWords - wordIdx, envPtr);
	    } else if (wordIdx > 0) {
		/*
		 * Save PC -> command map for the TclArgumentBC* functions.
		 */

		int isnew;
		Tcl_HashEntry *hePtr = Tcl_CreateHashEntry(&eclPtr->litInfo,

     * The table mutex must already be held before this routine is invoked.
     */

    auxDataTypeTableInitialized = 1;
    Tcl_InitHashTable(&auxDataTypeTable, TCL_STRING_KEYS);

    /*
     * There are only three AuxData types at this time, so register them here.
     */

    RegisterAuxDataType(&tclForeachInfoType);
    RegisterAuxDataType(&tclJumptableInfoType);
    RegisterAuxDataType(&tclDictUpdateInfoType);
}


				 * '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
				 * should be issued; they should never be
				 * issued repeatedly, as that is significantly
				 * inefficient. If set to 2, that instruction
				 * should not be issued at all (by the generic
				 * part of the command compiler). */
    ContLineLoc *clLoc;		/* If not NULL, the table holding the
				 * locations of the invisible continuation
				 * lines in the input script, to adjust the
				 * line counter. */
    int *clNext;		/* If not NULL, it refers to the next slot in
				 * clLoc to check for an invisible
				 * continuation line. */

#define INST_ARRAY_EXISTS_STK		159
#define INST_ARRAY_EXISTS_IMM		160
#define INST_ARRAY_MAKE_STK		161
#define INST_ARRAY_MAKE_IMM		162

#define INST_INVOKE_REPLACE		163

#define INST_LIST_CONCAT		164
#define INST_LIST_EXPANDED		165

/* The last opcode */
#define LAST_INST_OPCODE		165

/*
 * Table describing the Tcl bytecode instructions: their name (for displaying
 * code), total number of code bytes required (including operand bytes), and a
 * description of the type of each operand. These operand types include signed
 * and unsigned integers of length one and four bytes. The unsigned integers
 * are used for indexes or for, e.g., the count of objects to push in a "push"

				 * actual size of this field will be large
				 * enough to numVars indexes. THIS MUST BE THE
				 * LAST FIELD IN THE STRUCTURE! */
} ForeachInfo;

MODULE_SCOPE const AuxDataType tclForeachInfoType;

#define FOREACHINFO(envPtr, index) \
    ((ForeachInfo*)((envPtr)->auxDataArrayPtr[TclGetUInt4AtPtr(index)].clientData))

/*
 * 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*)((envPtr)->auxDataArrayPtr[TclGetUInt4AtPtr(index)].clientData))

/*
 * 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*)((envPtr)->auxDataArrayPtr[TclGetUInt4AtPtr(index)].clientData))

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

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

	    if (delta == INT_MIN) {				\
		delta = 1 - (i);				\
	    }							\
	    TclAdjustStackDepth(delta, envPtr);			\
	}							\
    } while (0)

/*
 * Macros used to update the flag that indicates if we are at the start of a
 * command, based on whether the opcode is INST_START_COMMAND.
 *
 * void TclUpdateAtCmdStart(unsigned char op, CompileEnv *envPtr);
 */

#define TclUpdateAtCmdStart(op, envPtr) \
    if ((envPtr)->atCmdStart < 2) {				     \
	(envPtr)->atCmdStart = ((op) == INST_START_CMD ? 1 : 0);     \
    }

/*
 * Macro to emit an opcode byte into a CompileEnv's code array. The ANSI C
 * "prototype" for this macro is:
 *
 * void TclEmitOpcode(unsigned char op, CompileEnv *envPtr);
 */

#define TclEmitOpcode(op, envPtr) \
    do {							\
	if ((envPtr)->codeNext == (envPtr)->codeEnd) {		\
	    TclExpandCodeArray(envPtr);				\
	}							\
	*(envPtr)->codeNext++ = (unsigned char) (op);		\
	TclUpdateAtCmdStart(op, envPtr);			\
	TclUpdateStackReqs(op, 0, envPtr);			\
    } while (0)

/*
 * Macros to emit an integer operand. The ANSI C "prototype" for these macros
 * are:
 *

#define TclEmitInstInt1(op, i, envPtr) \
    do {								\
	if (((envPtr)->codeNext + 2) > (envPtr)->codeEnd) {		\
	    TclExpandCodeArray(envPtr);					\
	}								\
	*(envPtr)->codeNext++ = (unsigned char) (op);			\
	*(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i));	\
	TclUpdateAtCmdStart(op, envPtr);				\
	TclUpdateStackReqs(op, i, envPtr);				\
    } while (0)

#define TclEmitInstInt4(op, i, envPtr) \
    do {							\
	if (((envPtr)->codeNext + 5) > (envPtr)->codeEnd) {	\
	    TclExpandCodeArray(envPtr);				\
	}							\
	*(envPtr)->codeNext++ = (unsigned char) (op);		\
	*(envPtr)->codeNext++ =					\
		(unsigned char) ((unsigned int) (i) >> 24);	\
	*(envPtr)->codeNext++ =					\
		(unsigned char) ((unsigned int) (i) >> 16);	\
	*(envPtr)->codeNext++ =					\
		(unsigned char) ((unsigned int) (i) >>  8);	\
	*(envPtr)->codeNext++ =					\
		(unsigned char) ((unsigned int) (i)      );	\
	TclUpdateAtCmdStart(op, envPtr);			\
	TclUpdateStackReqs(op, i, envPtr);			\
    } while (0)

/*
 * Macro to push a Tcl object onto the Tcl evaluation stack. It emits the
 * object's one or four byte array index into the CompileEnv's code array.
 * These support, respectively, a maximum of 256 (2**8) and 2**32 objects in a

	    checkInterp = 0;
	    if ((codePtr->compileEpoch != iPtr->compileEpoch)
		    || (codePtr->nsEpoch != iPtr->varFramePtr->nsPtr->resolverEpoch)) {
		goto instStartCmdFailed;
	    }
	}
	inst = *(pc += 9);
	goto peepholeStart;
    } else if (inst == INST_NOP) {
#ifndef TCL_COMPILE_DEBUG
	while (inst == INST_NOP)
#endif
	{
	    inst = *++pc;
	}
	goto peepholeStart;
    }
    
    switch (inst) {
    case INST_SYNTAX:
    case INST_RETURN_IMM: {
	int code = TclGetInt4AtPtr(pc+1);

	goto processExceptionReturn;
    }

    case INST_RETURN_STK:
	TRACE(("=> "));
	objResultPtr = POP_OBJECT();
	result = Tcl_SetReturnOptions(interp, OBJ_AT_TOS);
	if (result == TCL_OK) {
	    Tcl_DecrRefCount(OBJ_AT_TOS);
	    OBJ_AT_TOS = objResultPtr;

	    TRACE_APPEND(("continuing to next instruction (result=\"%.30s\")",
		    O2S(objResultPtr)));
	    NEXT_INST_F(1, 0, 0);
	} else if (result == TCL_ERROR) {
	    /*
	     * BEWARE! Must do this in this order, because an error in the
	     * option dictionary overrides the result (and can be verified by
	     * test).
	     */

	    Tcl_SetObjResult(interp, objResultPtr);
	    Tcl_SetReturnOptions(interp, OBJ_AT_TOS);
	    Tcl_DecrRefCount(OBJ_AT_TOS);
	    OBJ_AT_TOS = objResultPtr;
	} else {
	    Tcl_DecrRefCount(OBJ_AT_TOS);
	    OBJ_AT_TOS = objResultPtr;
	    Tcl_SetObjResult(interp, objResultPtr);
	}
	cleanup = 1;
	goto processExceptionReturn;

    case INST_YIELD: {
	CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;

	TRACE(("%.30s => ", O2S(OBJ_AT_TOS)));

	TRACE_WITH_OBJ(("%u => ", TclGetUInt4AtPtr(pc+1)), objResultPtr);
	NEXT_INST_F(5, 0, 1);

    case INST_POP:
	TRACE_WITH_OBJ(("=> discarding "), OBJ_AT_TOS);
	objPtr = POP_OBJECT();
	TclDecrRefCount(objPtr);



	NEXT_INST_F(1, 0, 0);

    case INST_DUP:
	objResultPtr = OBJ_AT_TOS;
	TRACE_WITH_OBJ(("=> "), objResultPtr);
	NEXT_INST_F(1, 0, 1);

	 * decrement their ref counts.
	 */

	opnd = TclGetUInt4AtPtr(pc+1);
	objResultPtr = Tcl_NewListObj(opnd, &OBJ_AT_DEPTH(opnd-1));
	TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
	NEXT_INST_V(5, opnd, 1);

    case INST_LIST_EXPANDED:
	CLANG_ASSERT(auxObjList);
	objc = CURR_DEPTH - auxObjList->internalRep.ptrAndLongRep.value;
	POP_TAUX_OBJ();
	objResultPtr = Tcl_NewListObj(objc, &OBJ_AT_DEPTH(objc-1));
	TRACE_WITH_OBJ(("(%u) => ", objc), objResultPtr);
	while (objc--) {
	    valuePtr = POP_OBJECT();
	    TclDecrRefCount(valuePtr);
	}
	NEXT_INST_F(1, 0, 1);

    case INST_LIST_LENGTH:
	valuePtr = OBJ_AT_TOS;
	if (TclListObjLength(interp, valuePtr, &length) != TCL_OK) {
	    TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)),
		    Tcl_GetObjResult(interp));
	    goto gotError;

	    NEXT_INST_F((match ? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
	case INST_JUMP_TRUE4:
	    NEXT_INST_F((match ? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
	}
#endif
	objResultPtr = TCONST(match);
	NEXT_INST_F(0, 2, 1);

    case INST_LIST_CONCAT:
	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;
	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
	if (Tcl_IsShared(valuePtr)) {
	    objResultPtr = Tcl_DuplicateObj(valuePtr);
	    if (Tcl_ListObjAppendList(interp, objResultPtr,
		    value2Ptr) != TCL_OK) {
		TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
		TclDecrRefCount(objResultPtr);
		goto gotError;
	    }
	    TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
	    NEXT_INST_F(1, 2, 1);
	} else {
	    if (Tcl_ListObjAppendList(interp, valuePtr, value2Ptr) != TCL_OK){
		TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
		goto gotError;
	    }
	    TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 1, 0);
	}

    /*
     *	   End of INST_LIST and related instructions.
     * -----------------------------------------------------------------
     *	   Start of string-related instructions.
     */