Tcl Source Code

2011-10-11  Jan Nijtmans  <[email protected]>

	* win/tclWinFile.c:    [Bug 2935503] Incorrect mode field
	returned by file stat command

2011-10-09  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmds.c (TclCompileDictWithCmd): Corrected handling of
	qualified names, and added spacial cases for empty bodies (used when
	[dict with] is just used for extracting variables).

2011-10-07  Jan Nijtmans  <[email protected]>

	* generic/tcl.h:        Fix gcc warnings (discovered with
	* generic/tclIORChan.c: latest mingw, based on gcc 4.6.1)
	* tests/env.test:       Fix env.test, when running
	under wine 1.3

2011-10-06  Donal K. Fellows  <[email protected]>

	* generic/tclDictObj.c (TclDictWithInit, TclDictWithFinish):
	* generic/tclCompCmds.c (TclCompileDictWithCmd): Experimental
	compilation for the [dict with] subcommand, using parts factored out
	from the interpreted version of the command.

2011-10-05  Jan Nijtmans  <[email protected]>

	* win/tclWinInt.h:   Remove tclWinProcs, as it is no longer
	* win/tclWin32Dll.c: being used.

2011-10-03  Venkat Iyer <[email protected]>

/*
 * Shorthand for commonly used argTable entries.
 */

#define TCL_ARGV_AUTO_HELP \
    {TCL_ARGV_HELP,	"-help",	NULL,	NULL, \
	    "Print summary of command-line options and abort", NULL}
#define TCL_ARGV_AUTO_REST \
    {TCL_ARGV_REST,	"--",		NULL,	NULL, \
	    "Marks the end of the options", NULL}
#define TCL_ARGV_TABLE_END \
    {TCL_ARGV_END, NULL, NULL, NULL, NULL, NULL}

/*
 *----------------------------------------------------------------------------
 * Definitions needed for Tcl_Zlib routines. [TIP #234]
 *
 * Constants for the format flags describing what sort of data format is
 * desired/expected for the Tcl_ZlibDeflate, Tcl_ZlibInflate and

					INST_BEGIN_CATCH4,	0,	0},
    {"bitand",		ASSEM_1BYTE,	INST_BITAND,		2,	1},
    {"bitnot",		ASSEM_1BYTE,	INST_BITNOT,		1,	1},
    {"bitor",		ASSEM_1BYTE,	INST_BITOR,		2,	1},
    {"bitxor",		ASSEM_1BYTE,	INST_BITXOR,		2,	1},
    {"concat",		ASSEM_CONCAT1,	INST_CONCAT1,		INT_MIN,1},
    {"dictAppend",	ASSEM_LVT4,	INST_DICT_APPEND,	2,	1},
    {"dictExpand",	ASSEM_1BYTE,	INST_DICT_EXPAND,	3,	1},
    {"dictGet",		ASSEM_DICT_GET, INST_DICT_GET,		INT_MIN,1},
    {"dictIncrImm",	ASSEM_SINT4_LVT4,
					INST_DICT_INCR_IMM,	1,	1},
    {"dictLappend",	ASSEM_LVT4,	INST_DICT_LAPPEND,	2,	1},
    {"dictRecombineStk",ASSEM_1BYTE,	INST_DICT_RECOMBINE_STK,3,	0},
    {"dictRecombineImm",ASSEM_LVT4,	INST_DICT_RECOMBINE_IMM,2,	0},
    {"dictSet",		ASSEM_DICT_SET, INST_DICT_SET,		INT_MIN,1},
    {"dictUnset",	ASSEM_DICT_UNSET,
					INST_DICT_UNSET,	INT_MIN,1},
    {"div",		ASSEM_1BYTE,	INST_DIV,		2,	1},
    {"dup",		ASSEM_1BYTE,	INST_DUP,		1,	2},
    {"endCatch",	ASSEM_END_CATCH,INST_END_CATCH,		0,	0},
    {"eq",		ASSEM_1BYTE,	INST_EQ,		2,	1},

    envPtr->clNext = mapPtr->loc[eclIndex].next[(word)]

#define PushVarNameWord(i,v,e,f,l,s,sc,word) \
    PushVarName(i,v,e,f,l,s,sc,						\
	    mapPtr->loc[eclIndex].line[(word)],				\
	    mapPtr->loc[eclIndex].next[(word)])

/*
 * Often want to issue one of two versions of an instruction based on whether
 * the argument will fit in a single byte or not. This makes it much clearer.
 */

#define Emit14Inst(nm,idx,envPtr) \
    if (idx <= 255) {							\
	TclEmitInstInt1(nm##1,idx,envPtr);				\
    } else {								\
	TclEmitInstInt4(nm##4,idx,envPtr);				\
    }

/*
 * Flags bits used by PushVarName.
 */

#define TCL_NO_LARGE_INDEX 1	/* Do not return localIndex value > 255 */

/*

     * Emit instructions to set/get the variable.
     */

    if (simpleVarName) {
	if (isScalar) {
	    if (localIndex < 0) {
		TclEmitOpcode(INST_APPEND_STK, envPtr);


	    } else {
		Emit14Inst(INST_APPEND_SCALAR, localIndex, envPtr);
	    }
	} else {
	    if (localIndex < 0) {
		TclEmitOpcode(INST_APPEND_ARRAY_STK, envPtr);


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

    return TCL_OK;

     * The reason for duplicating the script is that EVAL_STK would otherwise
     * begin by undeflowing the stack below the mark set by BEGIN_CATCH4.
     */

    SetLineInformation(1);
    if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	savedStackDepth = envPtr->currStackDepth;
	TclEmitInstInt4(	INST_BEGIN_CATCH4, range,	envPtr);
	ExceptionRangeStarts(envPtr, range);
	CompileBody(envPtr, cmdTokenPtr, interp);
    } else {
	CompileTokens(envPtr, cmdTokenPtr, interp);
	savedStackDepth = envPtr->currStackDepth;
	TclEmitInstInt4(	INST_BEGIN_CATCH4, range,	envPtr);
	ExceptionRangeStarts(envPtr, range);
	TclEmitOpcode(		INST_DUP,			envPtr);
	TclEmitOpcode(		INST_EVAL_STK,			envPtr);
    }
    /* Stack at this point:
     *    nonsimple:  script <mark> result
     *    simple:            <mark> result
     */

    /*

     * Emit the "error case" epilogue. Push the interpreter result
     * and the return code.
     */

    envPtr->currStackDepth = savedStackDepth;
    ExceptionRangeTarget(envPtr, range, catchOffset);
    /* Stack at this point:  ?script? */
    TclEmitOpcode(		INST_PUSH_RESULT,		envPtr);
    TclEmitOpcode(		INST_PUSH_RETURN_CODE,		envPtr);

    /*
     * Update the target of the jump after the "no errors" code. 
     */

    /* Stack at this point: ?script? result returnCode */
    if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
	Tcl_Panic("TclCompileCatchCmd: bad jump distance %d",
		(int)(CurrentOffset(envPtr) - jumpFixup.codeOffset));
    }

    /* Push the return options if the caller wants them */

    if (optsIndex != -1) {
	TclEmitOpcode(		INST_PUSH_RETURN_OPTIONS,	envPtr);
    }

    /*
     * End the catch
     */

    ExceptionRangeEnds(envPtr, range);
    TclEmitOpcode(		INST_END_CATCH,			envPtr);

    /*
     * At this point, the top of the stack is inconveniently ordered:
     *		?script? result returnCode ?returnOptions?
     * Reverse the stack to bring the result to the top.
     */

    if (optsIndex != -1) {
	TclEmitInstInt4(	INST_REVERSE, 3,		envPtr);
    } else {
	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
    }

    /*
     * Store the result if requested, and remove it from the stack
     */

    if (resultIndex != -1) {

	Emit14Inst(		INST_STORE_SCALAR, resultIndex,	envPtr);


    }

    TclEmitOpcode(		INST_POP,			envPtr);

    /*
     * Stack is now ?script? ?returnOptions? returnCode.
     * If the options dict has been requested, it is buried on the stack
     * under the return code. Reverse the stack to bring it to the top,
     * store it and remove it from the stack.
     */

    if (optsIndex != -1) {
	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);

	Emit14Inst(		INST_STORE_SCALAR, optsIndex,	envPtr);



	TclEmitOpcode(		INST_POP,			envPtr);
    }

    /* 
     * Stack is now ?script? result. Get rid of the subst'ed script
     * if it's hanging arond.
     */

    if (cmdTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
	TclEmitOpcode(		INST_POP,			envPtr);
    }

    /* 
     * Result of all this, on either branch, should have been to leave
     * one operand -- the return code -- on the stack.
     */

     * fixed-sized jumps. That simplifies things a lot!
     *
     * First up, get the dictionary and start the iteration. No catching of
     * errors at this point.
     */

    CompileWord(envPtr, dictTokenPtr, interp, 3);
    TclEmitInstInt4(	INST_DICT_FIRST, infoIndex,		envPtr);
    emptyTargetOffset = CurrentOffset(envPtr);
    TclEmitInstInt4(	INST_JUMP_TRUE4, 0,			envPtr);

    /*
     * Now we catch errors from here on so that we can finalize the search
     * started by Tcl_DictObjFirst above.
     */

    catchRange = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
    TclEmitInstInt4(	INST_BEGIN_CATCH4, catchRange,		envPtr);
    ExceptionRangeStarts(envPtr, catchRange);

    /*
     * Inside the iteration, write the loop variables.
     */

    bodyTargetOffset = CurrentOffset(envPtr);
    Emit14Inst(		INST_STORE_SCALAR, keyVarIndex,		envPtr);
    TclEmitOpcode(	INST_POP,				envPtr);
    Emit14Inst(		INST_STORE_SCALAR, valueVarIndex,	envPtr);
    TclEmitOpcode(	INST_POP,				envPtr);

    /*
     * Set up the loop exception targets.
     */

    loopRange = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE);
    ExceptionRangeStarts(envPtr, loopRange);

    /*
     * Compile the loop body itself. It should be stack-neutral.
     */

    SetLineInformation(4);
    CompileBody(envPtr, bodyTokenPtr, interp);
    TclEmitOpcode(	INST_POP,				envPtr);

    /*
     * Both exception target ranges (error and loop) end here.
     */

    ExceptionRangeEnds(envPtr, loopRange);
    ExceptionRangeEnds(envPtr, catchRange);

    /*
     * Continue (or just normally process) by getting the next pair of items
     * from the dictionary and jumping back to the code to write them into
     * variables if there is another pair.
     */

    ExceptionRangeTarget(envPtr, loopRange, continueOffset);
    TclEmitInstInt4(	INST_DICT_NEXT, infoIndex,		envPtr);
    jumpDisplacement = bodyTargetOffset - CurrentOffset(envPtr);
    TclEmitInstInt4(	INST_JUMP_FALSE4, jumpDisplacement,	envPtr);
    TclEmitOpcode(	INST_POP,				envPtr);
    TclEmitOpcode(	INST_POP,				envPtr);

    /*
     * Now do the final cleanup for the no-error case (this is where we break
     * out of the loop to) by force-terminating the iteration (if not already
     * terminated), ditching the exception info and jumping to the last
     * instruction for this command. In theory, this could be done using the
     * "finally" clause (next generated) but this is faster.
     */

    ExceptionRangeTarget(envPtr, loopRange, breakOffset);
    TclEmitInstInt1(	INST_UNSET_SCALAR, 0,			envPtr);
    TclEmitInt4(	infoIndex,				envPtr);
    TclEmitOpcode(	INST_END_CATCH,				envPtr);
    endTargetOffset = CurrentOffset(envPtr);
    TclEmitInstInt4(	INST_JUMP4, 0,				envPtr);

    /*
     * Error handler "finally" clause, which force-terminates the iteration
     * and rethrows the error.
     */

    ExceptionRangeTarget(envPtr, catchRange, catchOffset);
    TclEmitOpcode(	INST_PUSH_RETURN_OPTIONS,		envPtr);
    TclEmitOpcode(	INST_PUSH_RESULT,			envPtr);
    TclEmitInstInt1(	INST_UNSET_SCALAR, 0,			envPtr);
    TclEmitInt4(	infoIndex,				envPtr);
    TclEmitOpcode(	INST_END_CATCH,				envPtr);
    TclEmitOpcode(	INST_RETURN_STK,			envPtr);

    /*
     * Otherwise we're done (the jump after the DICT_FIRST points here) and we
     * need to pop the bogus key/value pair (pushed to keep stack calculations
     * easy!) Note that we skip the END_CATCH. [Bug 1382528]
     */

    envPtr->currStackDepth = savedStackDepth+2;
    jumpDisplacement = CurrentOffset(envPtr) - emptyTargetOffset;
    TclUpdateInstInt4AtPc(INST_JUMP_TRUE4, jumpDisplacement,
	    envPtr->codeStart + emptyTargetOffset);
    TclEmitOpcode(	INST_POP,				envPtr);
    TclEmitOpcode(	INST_POP,				envPtr);
    TclEmitInstInt1(	INST_UNSET_SCALAR, 0,			envPtr);
    TclEmitInt4(	infoIndex,				envPtr);

    /*
     * Final stage of the command (normal case) is that we push an empty
     * object. This is done last to promote peephole optimization when it's
     * dropped immediately.
     */

     */

    infoIndex = TclCreateAuxData(duiPtr, &tclDictUpdateInfoType, envPtr);

    for (i=0 ; i<numVars ; i++) {
	CompileWord(envPtr, keyTokenPtrs[i], interp, i);
    }
    TclEmitInstInt4(	INST_LIST, numVars,			envPtr);
    TclEmitInstInt4(	INST_DICT_UPDATE_START, dictIndex,	envPtr);
    TclEmitInt4(	infoIndex,				envPtr);

    range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
    TclEmitInstInt4(	INST_BEGIN_CATCH4, range,		envPtr);

    ExceptionRangeStarts(envPtr, range);
    envPtr->currStackDepth++;
    CompileBody(envPtr, bodyTokenPtr, interp);
    envPtr->currStackDepth = savedStackDepth;
    ExceptionRangeEnds(envPtr, range);

    /*
     * Normal termination code: the stack has the key list below the result of
     * the body evaluation: swap them and finish the update code.
     */

    TclEmitOpcode(	INST_END_CATCH,				envPtr);
    TclEmitInstInt4(	INST_REVERSE, 2,			envPtr);
    TclEmitInstInt4(	INST_DICT_UPDATE_END, dictIndex,	envPtr);
    TclEmitInt4(	infoIndex,				envPtr);

    /*
     * Jump around the exceptional termination code.
     */

    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);

    /*
     * Termination code for non-ok returns: stash the result and return
     * options in the stack, bring up the key list, finish the update code,
     * and finally return with the catched return data
     */

    ExceptionRangeTarget(envPtr, range, catchOffset);
    TclEmitOpcode(	INST_PUSH_RESULT,			envPtr);
    TclEmitOpcode(	INST_PUSH_RETURN_OPTIONS,		envPtr);
    TclEmitOpcode(	INST_END_CATCH,				envPtr);
    TclEmitInstInt4(	INST_REVERSE, 3,			envPtr);

    TclEmitInstInt4(	INST_DICT_UPDATE_END, dictIndex,	envPtr);
    TclEmitInt4(	infoIndex,				envPtr);
    TclEmitOpcode(	INST_RETURN_STK,			envPtr);

    if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
	Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d",
		(int) (CurrentOffset(envPtr) - jumpFixup.codeOffset));
    }
    TclStackFree(interp, keyTokenPtrs);
    return TCL_OK;

    }
    dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, envPtr);
    if (dictVarIndex < 0) {
	return TCL_ERROR;
    }
    CompileWord(envPtr, keyTokenPtr, interp, 3);
    CompileWord(envPtr, valueTokenPtr, interp, 4);
    TclEmitInstInt4(	INST_DICT_LAPPEND, dictVarIndex,	envPtr);
    return TCL_OK;
}

int
TclCompileDictWithCmd(
    Tcl_Interp *interp,		/* Used for looking up stuff. */
    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. */
{
    DefineLineInformation;	/* TIP #280 */
    int i, range, varNameTmp, pathTmp, keysTmp, gotPath, dictVar = -1;
    int bodyIsEmpty = 1;
    Tcl_Token *varTokenPtr, *tokenPtr;
    int savedStackDepth = envPtr->currStackDepth;
    JumpFixup jumpFixup;
    const char *ptr, *end;

    /*
     * There must be at least one argument after the command.
     */

    if (parsePtr->numWords < 3) {
	return TCL_ERROR;
    }

    /*
     * Parse the command (trivially). Expect the following:
     *   dict with <any (varName)> ?<any> ...? <literal>
     */

    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
    tokenPtr = TokenAfter(varTokenPtr);
    for (i=3 ; i<parsePtr->numWords ; i++) {
	tokenPtr = TokenAfter(tokenPtr);
    }
    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	return TCL_ERROR;
    }

    /*
     * Test if the last word is an empty script; if so, we can compile it in
     * all cases, but if it is non-empty we need local variable table entries
     * to hold the temporary variables (used to keep stack usage simple).
     */

    for (ptr=tokenPtr[1].start,end=ptr+tokenPtr[1].size ; ptr!=end ; ptr++) {
	if (*ptr!=' ' && *ptr!='\t' && *ptr!='\n' && *ptr!='\r') {
	    if (envPtr->procPtr == NULL) {
		return TCL_ERROR;
	    }
	    bodyIsEmpty = 0;
	    break;
	}
    }

    /*
     * Determine if we're manipulating a dict in a simple local variable.
     */

    gotPath = (parsePtr->numWords > 3);
    if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD &&
	    TclIsLocalScalar(varTokenPtr[1].start, varTokenPtr[1].size)) {
	dictVar = TclFindCompiledLocal(varTokenPtr[1].start,
		varTokenPtr[1].size, 1, envPtr);
    }

    /*
     * Special case: an empty body means we definitely have no need to issue
     * try-finally style code or to allocate local variable table entries for
     * storing temporaries. Still need to do both INST_DICT_EXPAND and
     * INST_DICT_RECOMBINE_* though, because we can't determine if we're free
     * of traces.
     */

    if (bodyIsEmpty) {
	if (dictVar >= 0) {
	    if (gotPath) {
		/*
		 * Case: Path into dict in LVT with empty body.
		 */

		tokenPtr = TokenAfter(varTokenPtr);
		for (i=2 ; i<parsePtr->numWords-1 ; i++) {
		    CompileWord(envPtr, tokenPtr, interp, i-1);
		    tokenPtr = TokenAfter(tokenPtr);
		}
		TclEmitInstInt4(INST_LIST, parsePtr->numWords-3,envPtr);
		Emit14Inst(	INST_LOAD_SCALAR, dictVar,	envPtr);
		TclEmitInstInt4(INST_OVER, 1,			envPtr);
		TclEmitOpcode(	INST_DICT_EXPAND,		envPtr);
		TclEmitInstInt4(INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
		PushLiteral(envPtr, "", 0);
	    } else {
		/*
		 * Case: Direct dict in LVT with empty body.
		 */

		PushLiteral(envPtr, "", 0);
		Emit14Inst(	INST_LOAD_SCALAR, dictVar,	envPtr);
		PushLiteral(envPtr, "", 0);
		TclEmitOpcode(	INST_DICT_EXPAND,		envPtr);
		TclEmitInstInt4(INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
		PushLiteral(envPtr, "", 0);
	    }
	} else {
	    if (gotPath) {
		/*
		 * Case: Path into dict in non-simple var with empty body.
		 */

		tokenPtr = varTokenPtr;
		for (i=1 ; i<parsePtr->numWords-1 ; i++) {
		    CompileWord(envPtr, tokenPtr, interp, i-1);
		    tokenPtr = TokenAfter(tokenPtr);
		}
		TclEmitInstInt4(INST_LIST, parsePtr->numWords-3,envPtr);
		TclEmitInstInt4(INST_OVER, 1,			envPtr);
		TclEmitOpcode(	INST_LOAD_STK,			envPtr);
		TclEmitInstInt4(INST_OVER, 1,			envPtr);
		TclEmitOpcode(	INST_DICT_EXPAND,		envPtr);
		TclEmitOpcode(	INST_DICT_RECOMBINE_STK,	envPtr);
		PushLiteral(envPtr, "", 0);
	    } else {
		/*
		 * Case: Direct dict in non-simple var with empty body.
		 */

		CompileWord(envPtr, varTokenPtr, interp, 0);
		TclEmitOpcode(	INST_DUP,			envPtr);
		TclEmitOpcode(	INST_LOAD_STK,			envPtr);
		PushLiteral(envPtr, "", 0);
		TclEmitOpcode(	INST_DICT_EXPAND,		envPtr);
		PushLiteral(envPtr, "", 0);
		TclEmitInstInt4(INST_REVERSE, 2,		envPtr);
		TclEmitOpcode(	INST_DICT_RECOMBINE_STK,	envPtr);
		PushLiteral(envPtr, "", 0);
	    }
	}
	return TCL_OK;
    }

    /*
     * OK, we have a non-trivial body. This means that the focus is on
     * generating a try-finally structure where the INST_DICT_RECOMBINE_* goes
     * in the 'finally' clause.
     *
     * Start by allocating local (unnamed, untraced) working variables.
     */

    if (dictVar == -1) {
	varNameTmp = TclFindCompiledLocal(NULL, 0, 1, envPtr);
    } else {
	varNameTmp = -1;
    }
    if (gotPath) {
	pathTmp = TclFindCompiledLocal(NULL, 0, 1, envPtr);
    } else {
	pathTmp = -1;
    }
    keysTmp = TclFindCompiledLocal(NULL, 0, 1, envPtr);

    /*
     * Issue instructions. First, the part to expand the dictionary.
     */

    if (varNameTmp > -1) {
	CompileWord(envPtr, varTokenPtr, interp, 0);
	Emit14Inst(		INST_STORE_SCALAR, varNameTmp,	envPtr);
    }
    tokenPtr = TokenAfter(varTokenPtr);
    if (gotPath) {
	for (i=2 ; i<parsePtr->numWords-1 ; i++) {
	    CompileWord(envPtr, tokenPtr, interp, i-1);
	    tokenPtr = TokenAfter(tokenPtr);
	}
	TclEmitInstInt4(	INST_LIST, parsePtr->numWords-3,envPtr);
	Emit14Inst(		INST_STORE_SCALAR, pathTmp,	envPtr);
	TclEmitOpcode(		INST_POP,			envPtr);
    }
    if (dictVar == -1) {
	TclEmitOpcode(		INST_LOAD_STK,			envPtr);
    } else {
	Emit14Inst(		INST_LOAD_SCALAR, dictVar,	envPtr);
    }
    if (gotPath) {
	Emit14Inst(		INST_LOAD_SCALAR, pathTmp,	envPtr);
    } else {
	PushLiteral(envPtr, "", 0);
    }
    TclEmitOpcode(		INST_DICT_EXPAND,		envPtr);
    Emit14Inst(			INST_STORE_SCALAR, keysTmp,	envPtr);
    TclEmitOpcode(		INST_POP,			envPtr);

    /*
     * Now the body of the [dict with].
     */

    range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
    TclEmitInstInt4(		INST_BEGIN_CATCH4, range,	envPtr);

    ExceptionRangeStarts(envPtr, range);
    envPtr->currStackDepth++;
    SetLineInformation(parsePtr->numWords-1);
    CompileBody(envPtr, tokenPtr, interp);
    envPtr->currStackDepth = savedStackDepth;
    ExceptionRangeEnds(envPtr, range);

    /*
     * Now fold the results back into the dictionary in the OK case.
     */

    TclEmitOpcode(		INST_END_CATCH,			envPtr);
    if (varNameTmp > -1) {
	Emit14Inst(		INST_LOAD_SCALAR, varNameTmp,	envPtr);
    }
    if (gotPath) {
	Emit14Inst(		INST_LOAD_SCALAR, pathTmp,	envPtr);
    } else {
	PushLiteral(envPtr, "", 0);
    }
    Emit14Inst(			INST_LOAD_SCALAR, keysTmp,	envPtr);
    if (dictVar == -1) {
	TclEmitOpcode(		INST_DICT_RECOMBINE_STK,	envPtr);
    } else {
	TclEmitInstInt4(	INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
    }
    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);

    /*
     * Now fold the results back into the dictionary in the exception case.
     */

    ExceptionRangeTarget(envPtr, range, catchOffset);
    TclEmitOpcode(		INST_PUSH_RETURN_OPTIONS,	envPtr);
    TclEmitOpcode(		INST_PUSH_RESULT,		envPtr);
    TclEmitOpcode(		INST_END_CATCH,			envPtr);
    if (varNameTmp > -1) {
	Emit14Inst(		INST_LOAD_SCALAR, varNameTmp,	envPtr);
    }
    if (parsePtr->numWords > 3) {
	Emit14Inst(		INST_LOAD_SCALAR, pathTmp,	envPtr);
    } else {
	PushLiteral(envPtr, "", 0);
    }
    Emit14Inst(			INST_LOAD_SCALAR, keysTmp,	envPtr);
    if (dictVar == -1) {
	TclEmitOpcode(		INST_DICT_RECOMBINE_STK,	envPtr);
    } else {
	TclEmitInstInt4(	INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
    }
    TclEmitOpcode(		INST_RETURN_STK,		envPtr);

    /*
     * Prepare for the start of the next command.
     */

    if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
	Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d",
		(int) (CurrentOffset(envPtr) - jumpFixup.codeOffset));
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * DupDictUpdateInfo, FreeDictUpdateInfo --

    for (i = 0, tokenPtr = parsePtr->tokenPtr;
	    i < numWords-1;
	    i++, tokenPtr = TokenAfter(tokenPtr)) {
	if ((i%2 == 0) && (i > 0)) {
	    SetLineInformation(i);
	    CompileTokens(envPtr, tokenPtr, interp);
	    tempVar = (firstValueTemp + loopIndex);

	    Emit14Inst(		INST_STORE_SCALAR, tempVar,	envPtr);



	    TclEmitOpcode(	INST_POP,			envPtr);
	    loopIndex++;
	}
    }

    /*
     * Initialize the temporary var that holds the count of loop iterations.
     */

    TclEmitInstInt4(		INST_FOREACH_START4, infoIndex,	envPtr);

    /*
     * Top of loop code: assign each loop variable and check whether
     * to terminate the loop.
     */

    ExceptionRangeTarget(envPtr, range, continueOffset);
    TclEmitInstInt4(		INST_FOREACH_STEP4, infoIndex,	envPtr);
    TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);

    /*
     * Inline compile the loop body.
     */

    SetLineInformation(bodyIndex);
    ExceptionRangeStarts(envPtr, range);
    CompileBody(envPtr, bodyTokenPtr, interp);
    ExceptionRangeEnds(envPtr, range);
    envPtr->currStackDepth = savedStackDepth + 1;
    TclEmitOpcode(		INST_POP,			envPtr);

    /*
     * Jump back to the test at the top of the loop. Generate a 4 byte jump if
     * the distance to the test is > 120 bytes. This is conservative and
     * ensures that we won't have to replace this jump if we later need to
     * replace the ifFalse jump with a 4 byte jump.
     */

	localIndex = IndexTailVarIfKnown(interp, varTokenPtr, envPtr);

	if (localIndex < 0) {
	    return TCL_ERROR;
	}

	CompileWord(envPtr, varTokenPtr, interp, 1);
	TclEmitInstInt4(	INST_NSUPVAR, localIndex,	envPtr);
    }

    /*
     * Pop the namespace, and set the result to empty
     */

    TclEmitOpcode(		INST_POP,			envPtr);
    PushLiteral(envPtr, "", 0);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

	haveImmValue = 1;
    }

    /*
     * Emit the instruction to increment the variable.
     */

    if (!simpleVarName) {
	if (haveImmValue) {
	    TclEmitInstInt1(	INST_INCR_STK_IMM, immValue,	envPtr);
	} else {
	    TclEmitOpcode(	INST_INCR_STK,			envPtr);
	}
    } else if (isScalar) {	/* Simple scalar variable. */
	if (localIndex >= 0) {
	    if (haveImmValue) {
		TclEmitInstInt1(INST_INCR_SCALAR1_IMM, localIndex, envPtr);
		TclEmitInt1(immValue, envPtr);
	    } else {
		TclEmitInstInt1(INST_INCR_SCALAR1, localIndex,	envPtr);
	    }
	} else {
	    if (haveImmValue) {
		TclEmitInstInt1(INST_INCR_SCALAR_STK_IMM, immValue, envPtr);
	    } else {
		TclEmitOpcode(	INST_INCR_SCALAR_STK,		envPtr);
	    }
	}
    } else {			/* Simple array variable. */
	if (localIndex >= 0) {
	    if (haveImmValue) {
		TclEmitInstInt1(INST_INCR_ARRAY1_IMM, localIndex, envPtr);
		TclEmitInt1(immValue, envPtr);
	    } else {
		TclEmitInstInt1(INST_INCR_ARRAY1, localIndex,	envPtr);
	    }
	} else {
	    if (haveImmValue) {
		TclEmitInstInt1(INST_INCR_ARRAY_STK_IMM, immValue, envPtr);
	    } else {
		TclEmitOpcode(	INST_INCR_ARRAY_STK,		envPtr);
	    }







	}
    }

    return TCL_OK;
}

/*

    PushVarNameWord(interp, tokenPtr, envPtr, 0, &localIndex,
	    &simpleVarName, &isScalar, 1);

    /*
     * Emit instruction to check the variable for existence.
     */

    if (!simpleVarName) {
	TclEmitOpcode(		INST_EXIST_STK,			envPtr);
    } else if (isScalar) {
	if (localIndex < 0) {
	    TclEmitOpcode(	INST_EXIST_STK,			envPtr);
	} else {
	    TclEmitInstInt4(	INST_EXIST_SCALAR, localIndex,	envPtr);
	}
    } else {
	if (localIndex < 0) {
	    TclEmitOpcode(	INST_EXIST_ARRAY_STK,		envPtr);
	} else {
	    TclEmitInstInt4(	INST_EXIST_ARRAY, localIndex,	envPtr);
	}



    }

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

     */

    /*
     * The *_STK opcodes should be refactored to make better use of existing
     * LOAD/STORE instructions.
     */

    if (!simpleVarName) {
	TclEmitOpcode(		INST_LAPPEND_STK,		envPtr);
    } else if (isScalar) {
	if (localIndex < 0) {
	    TclEmitOpcode(	INST_LAPPEND_STK,		envPtr);


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


	} else {
	    Emit14Inst(		INST_LAPPEND_ARRAY, localIndex,	envPtr);
	}



    }

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

		&simpleVarName, &isScalar, idx+2);

	/*
	 * Emit instructions to get the idx'th item out of the list value on
	 * the stack and assign it to the variable.
	 */

	if (!simpleVarName) {
	    TclEmitInstInt4(	INST_OVER, 1,			envPtr);
	    TclEmitInstInt4(	INST_LIST_INDEX_IMM, idx,	envPtr);
	    TclEmitOpcode(	INST_STORE_STK,			envPtr);
	    TclEmitOpcode(	INST_POP,			envPtr);
	} else if (isScalar) {
	    if (localIndex >= 0) {
		TclEmitOpcode(	INST_DUP,			envPtr);
		TclEmitInstInt4(INST_LIST_INDEX_IMM, idx,	envPtr);

		Emit14Inst(	INST_STORE_SCALAR, localIndex,	envPtr);

		TclEmitOpcode(	INST_POP,			envPtr);

	    } else {
		TclEmitInstInt4(INST_OVER, 1,			envPtr);
		TclEmitInstInt4(INST_LIST_INDEX_IMM, idx,	envPtr);
		TclEmitOpcode(	INST_STORE_SCALAR_STK,		envPtr);
		TclEmitOpcode(	INST_POP,			envPtr);
	    }
	} else {
	    if (localIndex >= 0) {
		TclEmitInstInt4(INST_OVER, 1,			envPtr);
		TclEmitInstInt4(INST_LIST_INDEX_IMM, idx,	envPtr);

		Emit14Inst(	INST_STORE_ARRAY, localIndex,	envPtr);

		TclEmitOpcode(	INST_POP,			envPtr);

	    } else {
		TclEmitInstInt4(INST_OVER, 2,			envPtr);
		TclEmitInstInt4(INST_LIST_INDEX_IMM, idx,	envPtr);
		TclEmitOpcode(	INST_STORE_ARRAY_STK,		envPtr);
		TclEmitOpcode(	INST_POP,			envPtr);
	    }
	}






    }

    /*
     * Generate code to leave the rest of the list on the stack.
     */

    TclEmitInstInt4(		INST_LIST_RANGE_IMM, idx,	envPtr);
    TclEmitInt4(		-2 /* == "end" */,		envPtr);

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

	     * construct:
	     *	 lindex <arbitraryValue> <posInt>
	     * This is best compiled as a push of the arbitrary value followed
	     * by an "immediate lindex" which is the most efficient variety.
	     */

	    CompileWord(envPtr, valTokenPtr, interp, 1);
	    TclEmitInstInt4(	INST_LIST_INDEX_IMM, idx,	envPtr);
	    return TCL_OK;
	}

	/*
	 * If the conversion failed or the value was negative, we just keep on
	 * going with the more complex compilation.
	 */

    /*
     * Emit INST_LIST_INDEX if objc==3, or INST_LIST_INDEX_MULTI if there are
     * multiple index args.
     */

    if (numWords == 3) {
	TclEmitOpcode(		INST_LIST_INDEX,		envPtr);
    } else {
	TclEmitInstInt4(	INST_LIST_INDEX_MULTI, numWords-1, envPtr);
    }

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

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

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

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

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

	PushLiteral(envPtr, "", 0);
    } else {
	/*
	 * 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;
}

/*
 *----------------------------------------------------------------------

    if (parsePtr->numWords != 2) {
	return TCL_ERROR;
    }
    varTokenPtr = TokenAfter(parsePtr->tokenPtr);

    CompileWord(envPtr, varTokenPtr, interp, 1);
    TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileLsetCmd --

    if (!simpleVarName || localIndex < 0) {
	if (!simpleVarName || isScalar) {
	    tempDepth = parsePtr->numWords - 2;
	} else {
	    tempDepth = parsePtr->numWords - 1;
	}
	TclEmitInstInt4(	INST_OVER, tempDepth,		envPtr);
    }

    /*
     * Duplicate an array index if one's been pushed.
     */

    if (simpleVarName && !isScalar) {
	if (localIndex < 0) {
	    tempDepth = parsePtr->numWords - 1;
	} else {
	    tempDepth = parsePtr->numWords - 2;
	}
	TclEmitInstInt4(	INST_OVER, tempDepth,		envPtr);
    }

    /*
     * Emit code to load the variable's value.
     */

    if (!simpleVarName) {
	TclEmitOpcode(		INST_LOAD_STK,			envPtr);
    } else if (isScalar) {
	if (localIndex < 0) {
	    TclEmitOpcode(	INST_LOAD_SCALAR_STK,		envPtr);


	} else {
	    Emit14Inst(		INST_LOAD_SCALAR, localIndex,	envPtr);
	}
    } else {
	if (localIndex < 0) {
	    TclEmitOpcode(	INST_LOAD_ARRAY_STK,		envPtr);


	} else {
	    Emit14Inst(		INST_LOAD_ARRAY, localIndex,	envPtr);
	}
    }

    /*
     * Emit the correct variety of 'lset' instruction.
     */

    if (parsePtr->numWords == 4) {
	TclEmitOpcode(		INST_LSET_LIST,			envPtr);
    } else {
	TclEmitInstInt4(	INST_LSET_FLAT, parsePtr->numWords-1, envPtr);
    }

    /*
     * Emit code to put the value back in the variable.
     */

    if (!simpleVarName) {
	TclEmitOpcode(		INST_STORE_STK,			envPtr);
    } else if (isScalar) {
	if (localIndex < 0) {
	    TclEmitOpcode(	INST_STORE_SCALAR_STK,		envPtr);


	} else {
	    Emit14Inst(		INST_STORE_SCALAR, localIndex,	envPtr);
	}
    } else {
	if (localIndex < 0) {
	    TclEmitOpcode(	INST_STORE_ARRAY_STK,		envPtr);


	} else {
	    Emit14Inst(		INST_STORE_ARRAY, localIndex,	envPtr);
	}
    }

    return TCL_OK;
}

/*

	CompileWord(envPtr, otherTokenPtr, interp, 1);
	PushVarNameWord(interp, localTokenPtr, envPtr, 0,
		&localIndex, &simpleVarName, &isScalar, 1);

	if ((localIndex < 0) || !isScalar) {
	    return TCL_ERROR;
	}
	TclEmitInstInt4(	INST_NSUPVAR, localIndex,	envPtr);
    }

    /*
     * Pop the namespace, and set the result to empty
     */

    TclEmitOpcode(		INST_POP,			envPtr);
    PushLiteral(envPtr, "", 0);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

     */

    varTokenPtr = TokenAfter(varTokenPtr);
    CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-1);

    if (simple) {
	if (exact && !nocase) {
	    TclEmitOpcode(	INST_STR_EQ,			envPtr);
	} else {
	    TclEmitInstInt1(	INST_STR_MATCH, nocase,		envPtr);
	}
    } else {
	/*
	 * Pass correct RE compile flags.  We use only Int1 (8-bit), but
	 * that handles all the flags we want to pass.
	 * Don't use TCL_REG_NOSUB as we may have backrefs.
	 */

	int cflags = TCL_REG_ADVANCED | (nocase ? TCL_REG_NOCASE : 0);

	TclEmitInstInt1(	INST_REGEXP, cflags,		envPtr);
    }

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

    Tcl_Obj *msg = Tcl_GetObjResult(interp);
    int numBytes;
    const char *bytes = TclGetStringFromObj(msg, &numBytes);

    TclErrorStackResetIf(interp, bytes, numBytes);
    TclEmitPush(TclRegisterNewLiteral(envPtr, bytes, numBytes), envPtr);
    CompileReturnInternal(envPtr, INST_SYNTAX, TCL_ERROR, 0,
	    TclNoErrorStack(interp, Tcl_GetReturnOptions(interp, TCL_ERROR)));
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileUpvarCmd --
 *

	CompileWord(envPtr, otherTokenPtr, interp, 1);
	PushVarNameWord(interp, localTokenPtr, envPtr, 0,
		&localIndex, &simpleVarName, &isScalar, 1);

	if ((localIndex < 0) || !isScalar) {
	    return TCL_ERROR;
	}
	TclEmitInstInt4(	INST_UPVAR, localIndex,		envPtr);
    }

    /*
     * Pop the frame index, and set the result to empty
     */

    TclEmitOpcode(		INST_POP,			envPtr);
    PushLiteral(envPtr, "", 0);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

	localIndex = IndexTailVarIfKnown(interp, varTokenPtr, envPtr);

	if (localIndex < 0) {
	    return TCL_ERROR;
	}

	CompileWord(envPtr, varTokenPtr, interp, 1);
	TclEmitInstInt4(	INST_VARIABLE, localIndex,	envPtr);

	if (i != numWords) {
	    /*
	     * A value has been given: set the variable, pop the value
	     */

	    CompileWord(envPtr, valueTokenPtr, interp, 1);

	    Emit14Inst(		INST_STORE_SCALAR, localIndex,	envPtr);



	    TclEmitOpcode(	INST_POP,			envPtr);
	}
    }

    /*
     * Set the result to empty
     */

#define INCOMPLETE	4	/* A parse error. Used only when the single
				 * "=" is encountered.  */
#define INVALID		5	/* A parse error. Used when any punctuation
				 * appears that's not a supported operator. */

/* Leaf lexemes */

#define NUMBER		(LEAF | 1)
				/* For literal numbers */
#define SCRIPT		(LEAF | 2)
				/* Script substitution; [foo] */
#define BOOLEAN		(LEAF | BAREWORD)
				/* For literal booleans */
#define BRACED		(LEAF | 4)
				/* Braced string; {foo bar} */
#define VARIABLE	(LEAF | 5)
				/* Variable substitution; $x */
#define QUOTED		(LEAF | 6)
				/* Quoted string; "foo $bar [soom]" */
#define EMPTY		(LEAF | 7)
				/* Used only for an empty argument list to a
				 * function. Represents the empty string

				 * within parens in the expression: rand() */

/* Unary operator lexemes */

#define UNARY_PLUS	(UNARY | PLUS)
#define UNARY_MINUS	(UNARY | MINUS)
#define FUNCTION	(UNARY | BAREWORD)
				/* This is a bit of "creative interpretation"
				 * on the part of the parser. A function call
				 * is parsed into the parse tree according to
				 * the perspective that the function name is a
				 * unary operator and its argument list,
				 * enclosed in parens, is its operand. The

				 * additional requirements not implied
				 * generally by treatment as a unary operator
				 * -- for example, the requirement that the
				 * operand be enclosed in parens -- are hard
				 * coded in the relevant portions of
				 * ParseExpr(). We trade off the need to

				 * include such exceptional handling in the
				 * code against the need we would otherwise
				 * have for more lexeme categories. */
#define START		(UNARY | 4)
				/* This lexeme isn't parsed from the
				 * expression text at all. It represents the

				 * start of the expression and sits at the
				 * root of the parse tree where it serves as
				 * the start/end point of traversals. */

#define OPEN_PAREN	(UNARY | 5)
				/* Another bit of creative interpretation,
				 * where we treat "(" as a unary operator with
				 * the sub-expression between it and its
				 * matching ")" as its operand. See
				 * CLOSE_PAREN below. */
#define NOT		(UNARY | 6)
#define BIT_NOT		(UNARY | 7)

/* Binary operator lexemes */

#define BINARY_PLUS	(BINARY |  PLUS)
#define BINARY_MINUS	(BINARY |  MINUS)
#define COMMA		(BINARY |  3)
				/* The "," operator is a low precedence binary
				 * operator that separates the arguments in a
				 * function call. The additional constraint
				 * that this operator can only legally appear

				 * at the right places within a function call
				 * argument list are hard coded within
				 * ParseExpr().  */
#define MULT		(BINARY |  4)
#define DIVIDE		(BINARY |  5)
#define MOD		(BINARY |  6)
#define LESS		(BINARY |  7)
#define GREATER		(BINARY |  8)
#define BIT_AND		(BINARY |  9)
#define BIT_XOR		(BINARY | 10)
#define BIT_OR		(BINARY | 11)
#define QUESTION	(BINARY | 12)
				/* These two lexemes make up the */
#define COLON		(BINARY | 13)
				/* ternary conditional operator, $x ? $y : $z.
				 * We treat them as two binary operators to
				 * avoid another lexeme category, and code the
				 * additional constraints directly in
				 * ParseExpr(). For instance, the right
				 * operand of a "?" operator must be a ":"
				 * operator. */
#define LEFT_SHIFT	(BINARY | 14)
#define RIGHT_SHIFT	(BINARY | 15)
#define LEQ		(BINARY | 16)
#define GEQ		(BINARY | 17)
#define EQUAL		(BINARY | 18)
#define NEQ		(BINARY | 19)
#define AND		(BINARY | 20)
#define OR		(BINARY | 21)
#define STREQ		(BINARY | 22)
#define STRNEQ		(BINARY | 23)
#define EXPON		(BINARY | 24)
				/* Unlike the other binary operators, EXPON is
				 * right associative and this distinction is

				 * coded directly in ParseExpr(). */
#define IN_LIST		(BINARY | 25)
#define NOT_IN_LIST	(BINARY | 26)
#define CLOSE_PAREN	(BINARY | 27)
				/* By categorizing the CLOSE_PAREN lexeme as a
				 * BINARY operator, the normal parsing rules
				 * for binary operators assure that a close
				 * paren will not directly follow another
				 * operator, and the machinery already in
				 * place to connect operands to operators
				 * according to precedence performs most of

				 * the work of matching open and close parens
				 * for us. In the end though, a close paren is
				 * not really a binary operator, and some

				 * special coding in ParseExpr() make sure we
				 * never put an actual CLOSE_PAREN node in the
				 * parse tree. The sub-expression between
				 * parens becomes the single argument of the

				 * matching OPEN_PAREN unary operator. */
#define END		(BINARY | 28)
				/* This lexeme represents the end of the
				 * string being parsed. Treating it as a
				 * binary operator follows the same logic as

				 * the CLOSE_PAREN lexeme and END pairs with
				 * START, in the same way that CLOSE_PAREN
				 * pairs with OPEN_PAREN. */

/*
 * When ParseExpr() builds the parse tree it must choose which operands to
 * connect to which operators.  This is done according to operator precedence.
 * The greater an operator's precedence the greater claim it has to link to an
 * available operand.  The Precedence enumeration lists the precedence values
 * used by Tcl expression operators, from lowest to highest claim.  Each
 * precedence level is commented with the operators that hold that precedence.

 */

enum Precedence {
    PREC_END = 1,	/* END */
    PREC_START,		/* START */
    PREC_CLOSE_PAREN,	/* ")" */
    PREC_OPEN_PAREN,	/* "(" */

    PREC_ADD,		/* "+", "-" */
    PREC_MULT,		/* "*", "/", "%" */
    PREC_EXPON,		/* "**" */
    PREC_UNARY		/* "+", "-", FUNCTION, "!", "~" */
};

/*
 * Here the same information contained in the comments above is stored in
 * inverted form, so that given a lexeme, one can quickly look up its
 * precedence value.
 */

static const unsigned char prec[] = {
    /* Non-operator lexemes */
    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,

				 * moment. OT_EMPTY is a nonsense value used
				 * only to silence compiler warnings. During a
				 * parse, complete will always hold an index
				 * or an OperandTypes value pointing to an
				 * actual leaf at the time the complete tree
				 * is needed. */

    /*
     * These variables control generation of the error message.
     */

    Tcl_Obj *msg = NULL;	/* The error message. */
    Tcl_Obj *post = NULL;	/* In a few cases, an additional postscript
				 * for the error message, supplying more
				 * information after the error msg and
				 * location have been reported. */
    const char *errCode = NULL;	/* The detail word of the errorCode list, or
				 * NULL to indicate that no changes to the

		    lexeme |= UNARY;
		} else {
		    lexeme |= BINARY;
		}
	    }
	}	/* Uncategorized lexemes */

	/*
	 * Handle lexeme based on its category.
	 */

	switch (NODE_TYPE & lexeme) {
	case LEAF: {
	    /*
	     * Each LEAF results in either a literal getting appended to the
	     * litList, or a sequence of Tcl_Tokens representing a Tcl word
	     * getting appended to the parsePtr->tokens. No OpNode is filled
	     * for this lexeme.
	     */


	    Tcl_Token *tokenPtr;
	    const char *end = start;
	    int wordIndex;
	    int code = TCL_OK;

	    /*
	     * A leaf operand appearing just after something that's not an
	     * operator is a syntax error.
	     */

	    if (NotOperator(lastParsed)) {
		msg = Tcl_ObjPrintf("missing operator at %s", mark);
		errCode = "MISSING";
		scanned = 0;
		insertMark = 1;

		/*
		 * Free any literal to avoid a memleak.
		 */

		if ((lexeme == NUMBER) || (lexeme == BOOLEAN)) {
		    Tcl_DecrRefCount(literal);
		}
		goto error;
	    }

	    switch (lexeme) {

		msg = Tcl_ObjPrintf("missing operator at %s", mark);
		scanned = 0;
		insertMark = 1;
		errCode = "MISSING";
		goto error;
	    }

	    /*
	     * Create an OpNode for the unary operator.
	     */

	    nodePtr->lexeme = lexeme;
	    nodePtr->precedence = prec[lexeme];
	    nodePtr->mark = MARK_RIGHT;

	    /*
	     * A FUNCTION cannot be a constant expression, because Tcl allows
	     * functions to return variable results with the same arguments;

	case OT_EMPTY:

	    /* No tokens and no characters for the OT_EMPTY leaf. */
	    break;

	case OT_LITERAL:

	    /*
	     * Skip any white space that comes before the literal.
	     */

	    scanned = TclParseAllWhiteSpace(start, numBytes);
	    start += scanned;
	    numBytes -= scanned;

	    /*
	     * Reparse the literal to get pointers into source string.
	     */

	    numBytes -= scanned;
	    tokenPtr += toCopy;
	    break;
	}

	default:

	    /*
	     * Advance to the child node, which is an operator.
	     */

	    nodePtr = nodes + next;

	    /*
	     * Skip any white space that comes before the subexpression.
	     */

	    scanned = TclParseAllWhiteSpace(start, numBytes);

	case MARK_LEFT:
	    next = nodePtr->left;
	    break;

	case MARK_RIGHT:
	    next = nodePtr->right;

	    /*
	     * Skip any white space that comes before the operator.
	     */

	    scanned = TclParseAllWhiteSpace(start, numBytes);
	    start += scanned;
	    numBytes -= scanned;

	    /*
	     * Here we scan from the string the operator corresponding to
	     * nodePtr->lexeme.
	     */

	    scanned = ParseLexeme(start, numBytes, &lexeme, NULL);

	    switch(nodePtr->lexeme) {
	    case OPEN_PAREN:
	    case COMMA:
	    case COLON:

		/*
		 * No tokens for these lexemes -> nothing to do.
		 */

		break;

	    default:

		/*
		 * Record in the TCL_TOKEN_OPERATOR token the pointers into
		 * the string marking where the operator is.

	    case COLON:

		/* No tokens for these lexemes -> nothing to do. */
		break;

	    case OPEN_PAREN:

		/*
		 * Skip past matching close paren.
		 */

		scanned = TclParseAllWhiteSpace(start, numBytes);
		start += scanned;
		numBytes -= scanned;
		scanned = ParseLexeme(start, numBytes, &lexeme, NULL);
		start += scanned;
		numBytes -= scanned;
		break;

	    default:

		/*
		 * Before we leave this node/operator/subexpression for the
		 * last time, finish up its tokens....
		 * 
		 * Our current position scanning the string is where the
		 * substring for the subexpression ends.

		 * fill in the zero numComponents for the operator Tcl_Token.
		 */

		parentIdx = subExprTokenPtr[1].numComponents;
		subExprTokenPtr[1].numComponents = 0;
		subExprTokenIdx = parentIdx;
		break;

	    }

	    /*
	     * Since we're returning to parent, skip child handling code.
	     */

	    nodePtr = nodes + nodePtr->p.parent;

	     * (alpha, digit, underscore).  Is this a number followed by
	     * bareword syntax error?  Or should we join into one bareword?
	     * Example: Inf + luence + () becomes a valid function call.
	     * [Bug 3401704]
	     */
	    if (literal->typePtr == &tclDoubleType) {
		const char *p = start;

		while (p < end) {
		    if (!isalnum(UCHAR(*p++))) {
			/*
			 * The number has non-bareword characters, so we 
			 * must treat it as a number.
			 */
			goto number;
		    }
		}
	    }
	    ParseLexeme(end, numBytes-(end-start), &lexeme, NULL);
	    if ((NODE_TYPE & lexeme) == BINARY) {
		/*
		 * The bareword characters following the number take the
		 * form of an operator (eq, ne, in, ni, ...) so we treat
		 * as number + operator.
		 */
		goto number;
	    }

	    /*
	     * Otherwise, fall through and parse the whole as a bareword.
	     */
	}
    }

    if (Tcl_UtfCharComplete(start, numBytes)) {

		 */

		nodePtr->left = numWords;
		numWords = 2;	/* Command plus one argument */
		break;
	    }
	    case QUESTION:
		TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpPtr->jump);
		break;
	    case COLON:
		CLANG_ASSERT(jumpPtr);
		TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
			&jumpPtr->next->jump);
		envPtr->currStackDepth = jumpPtr->depth;
		jumpPtr->offset = (envPtr->codeNext - envPtr->codeStart);
		jumpPtr->convert = convert;
		convert = 1;
		break;
	    case AND:
		TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpPtr->jump);
		break;
	    case OR:
		TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &jumpPtr->jump);
		break;
	    }
	} else {
	    switch (nodePtr->lexeme) {
	    case START:
	    case QUESTION:
		if (convert && (nodePtr == rootPtr)) {

		 * Each comma implies another function argument.
		 */

		numWords++;
		break;
	    case COLON:
		CLANG_ASSERT(jumpPtr);
		if (TclFixupForwardJump(envPtr, &jumpPtr->next->jump,
			(envPtr->codeNext - envPtr->codeStart)
			- jumpPtr->next->jump.codeOffset, 127)) {
		    jumpPtr->offset += 3;
		}
		TclFixupForwardJump(envPtr, &jumpPtr->jump,
			jumpPtr->offset - jumpPtr->jump.codeOffset, 127);
		convert |= jumpPtr->convert;
		envPtr->currStackDepth = jumpPtr->depth + 1;
		freePtr = jumpPtr;
		jumpPtr = jumpPtr->next;
		TclStackFree(interp, freePtr);
		freePtr = jumpPtr;
		jumpPtr = jumpPtr->next;
		TclStackFree(interp, freePtr);
		break;
	    case AND:
	    case OR:
		CLANG_ASSERT(jumpPtr);
		TclEmitForwardJump(envPtr, (nodePtr->lexeme == AND)
			?  TCL_FALSE_JUMP : TCL_TRUE_JUMP,
			&jumpPtr->next->jump);
		TclEmitPush(TclRegisterNewLiteral(envPtr,
			(nodePtr->lexeme == AND) ? "1" : "0", 1), envPtr);
		TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
			&jumpPtr->next->next->jump);
		TclFixupForwardJumpToHere(envPtr, &jumpPtr->next->jump, 127);
		if (TclFixupForwardJumpToHere(envPtr, &jumpPtr->jump, 127)) {
		    jumpPtr->next->next->jump.codeOffset += 3;
		}
		TclEmitPush(TclRegisterNewLiteral(envPtr,
			(nodePtr->lexeme == AND) ? "0" : "1", 1), envPtr);
		TclFixupForwardJumpToHere(envPtr, &jumpPtr->next->next->jump,
			127);
		convert = 0;
		envPtr->currStackDepth = jumpPtr->depth + 1;
		freePtr = jumpPtr;
		jumpPtr = jumpPtr->next;
		TclStackFree(interp, freePtr);
		freePtr = jumpPtr;
		jumpPtr = jumpPtr->next;
		TclStackFree(interp, freePtr);
		freePtr = jumpPtr;
		jumpPtr = jumpPtr->next;
		TclStackFree(interp, freePtr);
		break;
	    default:
		TclEmitOpcode(instruction[nodePtr->lexeme], envPtr);
		convert = 0;
		break;
	    }
	    if (nodePtr == rootPtr) {

		/* We're done */

		return;
	    }
	    nodePtr = nodes + nodePtr->p.parent;
	    continue;
	}

	nodePtr->mark++;

		    int index;
		    Tcl_Obj *objPtr = Tcl_GetObjResult(interp);

		    /*
		     * Don't generate a string rep, but if we have one
		     * already, then use it to share via the literal table.
		     */

		    if (objPtr->bytes) {
			Tcl_Obj *tableValue;

			index = TclRegisterNewLiteral(envPtr, objPtr->bytes,
				objPtr->length);
			tableValue = envPtr->literalArrayPtr[index].objPtr;
			if ((tableValue->typePtr == NULL) &&
				(objPtr->typePtr != NULL)) {
			    /*
			     * Same intrep surgery as for OT_LITERAL.
			     */

			    tableValue->typePtr = objPtr->typePtr;
			    tableValue->internalRep = objPtr->internalRep;
			    objPtr->typePtr = NULL;
			}
		    } else {
			index = TclAddLiteralObj(envPtr, objPtr, NULL);
		    }

    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclSingleOpCmd --
 *
 *	Implements the commands: ~, !, <<, >>, %, !=, ne, in, ni
 *	in the ::tcl::mathop namespace.  These commands have no
 *	extension to arbitrary arguments; they accept only exactly one
 *	or exactly two arguments as suitable for the operator.
 *
 * Results:
 *	A standard Tcl return code and result left in interp.

    Tcl_Obj *const objv[])
{
    TclOpCmdClientData *occdPtr = clientData;
    unsigned char lexeme;
    OpNode nodes[2];
    Tcl_Obj *const *litObjv = objv + 1;

    if (objc != 1 + occdPtr->i.numArgs) {
	Tcl_WrongNumArgs(interp, 1, objv, occdPtr->expected);
	return TCL_ERROR;
    }

    ParseLexeme(occdPtr->op, strlen(occdPtr->op), &lexeme, NULL);
    nodes[0].lexeme = START;
    nodes[0].mark = MARK_RIGHT;

	 * stktop; op1 is 1 for errors on problems, 0 otherwise */
    {"unsetArrayStk",	 2,    -2,        1,	{OPERAND_UINT1}},
	/* Make array element cease to exist; element is stktop, array name is
	 * stknext; op1 is 1 for errors on problems, 0 otherwise */
    {"unsetStk",	 2,    -1,        1,	{OPERAND_UINT1}},
	/* Make general variable cease to exist; unparsed variable name is
	 * stktop; op1 is 1 for errors on problems, 0 otherwise */

    {"dictExpand",       1,    -1,        0,    {OPERAND_NONE}},
        /* Probe into a dict and extract it (or a subdict of it) into
         * variables with matched names. Produces list of keys bound as
         * result. Part of [dict with].
	 * Stack:  ... dict path => ... keyList */
    {"dictRecombineStk", 1,    -3,        0,    {OPERAND_NONE}},
        /* Map variable contents back into a dictionary in a variable. Part of
         * [dict with].
	 * Stack:  ... dictVarName path keyList => ... */
    {"dictRecombineImm", 1,    -2,        1,    {OPERAND_LVT4}},
        /* Map variable contents back into a dictionary in the local variable
         * indicated by the LVT index. Part of [dict with].
	 * Stack:  ... path keyList => ... */

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

/* For [unset] compilation */
#define INST_UNSET_SCALAR		134
#define INST_UNSET_ARRAY		135
#define INST_UNSET_ARRAY_STK		136
#define INST_UNSET_STK			137

/* For [dict with] compilation */
#define INST_DICT_EXPAND		138
#define INST_DICT_RECOMBINE_STK		139
#define INST_DICT_RECOMBINE_IMM		140

/* The last opcode */
#define LAST_INST_OPCODE		140

/*
 * 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"

    {"remove",	DictRemoveCmd, NULL, NULL, NULL, 0 },
    {"replace",	DictReplaceCmd, NULL, NULL, NULL, 0 },
    {"set",	DictSetCmd,	TclCompileDictSetCmd, NULL, NULL, 0 },
    {"size",	DictSizeCmd, NULL, NULL, NULL, 0 },
    {"unset",	DictUnsetCmd, NULL, NULL, NULL, 0 },
    {"update",	DictUpdateCmd,	TclCompileDictUpdateCmd, NULL, NULL, 0 },
    {"values",	DictValuesCmd, NULL, NULL, NULL, 0 },
    {"with",	DictWithCmd,	TclCompileDictWithCmd, NULL, NULL, 0 },
    {NULL, NULL, NULL, NULL, NULL, 0}
};

/*
 * Internal representation of the entries in the hash table that backs a
 * dictionary.
 */

DictWithCmd(
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *dictPtr, *keysPtr, *pathPtr;



    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictVar ?key ...? script");
	return TCL_ERROR;
    }

    /*
     * Get the dictionary to open out.
     */

    dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
    if (dictPtr == NULL) {
	return TCL_ERROR;
    }







    keysPtr = TclDictWithInit(interp, dictPtr, objc-3, objv+2);






    if (keysPtr == NULL) {


	return TCL_ERROR;
    }


    Tcl_IncrRefCount(keysPtr);











    /*
     * Execute the body, while making the invoking context available to the
     * loop body (TIP#280) and postponing the cleanup until later (NRE).
     */

    pathPtr = NULL;

static int
FinalizeDictWith(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj **pathv;
    int pathc;
    Tcl_InterpState state;
    Tcl_Obj *varName = data[0];
    Tcl_Obj *keysPtr = data[1];
    Tcl_Obj *pathPtr = data[2];
    Var *varPtr, *arrayPtr;

    if (result == TCL_ERROR) {
	Tcl_AddErrorInfo(interp, "\n    (body of \"dict with\")");
    }

    /*
     * Save the result state; TDWF doesn't guarantee to not modify that on
     * TCL_OK result.
     */

    state = Tcl_SaveInterpState(interp, result);
    if (pathPtr != NULL) {
	Tcl_ListObjGetElements(NULL, pathPtr, &pathc, &pathv);
    } else {
	pathc = 0;
	pathv = NULL;
    }

    /*
     * Pack from local variables back into the dictionary.
     */

    varPtr = TclObjLookupVarEx(interp, varName, NULL, TCL_LEAVE_ERR_MSG, "set",
	    /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
    if (varPtr == NULL) {
	result = TCL_ERROR;
    } else {
	result = TclDictWithFinish(interp, varPtr, arrayPtr, varName, NULL, -1,
		pathc, pathv, keysPtr);
    }

    /*
     * Tidy up and return the real result (unless we had an error).
     */

    TclDecrRefCount(varName);
    TclDecrRefCount(keysPtr);
    if (pathPtr != NULL) {
	TclDecrRefCount(pathPtr);
    }
    if (result != TCL_OK) {
	Tcl_DiscardInterpState(state);
	return TCL_ERROR;
    }
    return Tcl_RestoreInterpState(interp, state);
}

/*
 *----------------------------------------------------------------------
 *
 * TclDictWithInit --
 *
 *	Part of the core of [dict with]. Pokes into a dictionary and converts
 *	the mappings there into assignments to (presumably) local variables.
 *	Returns a list of all the names that were mapped so that removal of
 *	either the variable or the dictionary entry won't surprise us when we
 *	come to stuffing everything back.
 *
 * Result:
 *	List of mapped names, or NULL if there was an error.
 *
 * Side effects:
 *	Assigns to variables, so potentially legion due to traces.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclDictWithInit(
    Tcl_Interp *interp,
    Tcl_Obj *dictPtr,
    int pathc,
    Tcl_Obj *const pathv[])
{
    Tcl_DictSearch s;
    Tcl_Obj *keyPtr, *valPtr, *keysPtr;
    int done;

    if (pathc > 0) {
	dictPtr = TclTraceDictPath(interp, dictPtr, pathc, pathv,
		DICT_PATH_READ);
	if (dictPtr == NULL) {
	    return NULL;
	}
    }

    /*
     * Go over the list of keys and write each corresponding value to a
     * variable in the current context with the same name. Also keep a copy of
     * the keys so we can write back properly later on even if the dictionary
     * has been structurally modified.
     */

    if (Tcl_DictObjFirst(interp, dictPtr, &s, &keyPtr, &valPtr,
	    &done) != TCL_OK) {
	return NULL;
    }

    TclNewObj(keysPtr);

    for (; !done ; Tcl_DictObjNext(&s, &keyPtr, &valPtr, &done)) {
	Tcl_ListObjAppendElement(NULL, keysPtr, keyPtr);
	if (Tcl_ObjSetVar2(interp, keyPtr, NULL, valPtr,
		TCL_LEAVE_ERR_MSG) == NULL) {
	    TclDecrRefCount(keysPtr);
	    Tcl_DictObjDone(&s);
	    return NULL;
	}
    }

    return keysPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclDictWithFinish --
 *
 *	Part of the core of [dict with]. Reassembles the piece of the dict (in
 *	varName, location given by pathc/pathv) from the variables named in
 *	the keysPtr argument. NB, does not try to preserve errors or manage
 *	argument lifetimes.
 *
 * Result:
 *	TCL_OK if we succeeded, or TCL_ERROR if we failed.
 *
 * Side effects:
 *	Assigns to a variable, so potentially legion due to traces. Updates
 *	the dictionary in the named variable.
 *
 *----------------------------------------------------------------------
 */

int
TclDictWithFinish(
    Tcl_Interp *interp,		/* Command interpreter in which variable
				 * exists. Used for state management, traces
				 * and error reporting. */
    Var *varPtr,		/* Reference to the variable holding the
				 * dictionary. */
    Var *arrayPtr,		/* Reference to the array containing the
				 * variable, or NULL if the variable is a
				 * scalar. */
    Tcl_Obj *part1Ptr,		/* Name of an array (if part2 is non-NULL) or
				 * the name of a variable. NULL if the 'index'
				 * parameter is >= 0 */
    Tcl_Obj *part2Ptr,		/* If non-NULL, gives the name of an element
				 * in the array part1. */
    int index,			/* Index into the local variable table of the
				 * variable, or -1. Only used when part1Ptr is
				 * NULL. */
    int pathc,			/* The number of elements in the path into the
				 * dictionary. */
    Tcl_Obj *const pathv[],	/* The elements of the path to the subdict. */
    Tcl_Obj *keysPtr)		/* List of keys to be synchronized. This is
				 * the result value from TclDictWithInit. */
{
    Tcl_Obj *dictPtr, *leafPtr, *valPtr;
    int i, allocdict, keyc;
    Tcl_Obj **keyv;

    /*
     * If the dictionary variable doesn't exist, drop everything silently.
     */

    dictPtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
	    TCL_LEAVE_ERR_MSG, index);
    if (dictPtr == NULL) {





	return TCL_OK;
    }

    /*
     * Double-check that it is still a dictionary.
     */


    if (Tcl_DictObjSize(interp, dictPtr, &i) != TCL_OK) {






	return TCL_ERROR;
    }

    if (Tcl_IsShared(dictPtr)) {
	dictPtr = Tcl_DuplicateObj(dictPtr);
	allocdict = 1;
    } else {
	allocdict = 0;
    }

    if (pathc > 0) {



	/*
	 * Want to get to the dictionary which we will update; need to do
	 * prepare-for-update de-sharing along the path *but* avoid generating
	 * an error on a non-existant path (we'll treat that the same as a
	 * non-existant variable. Luckily, the de-sharing operation isn't
	 * deeply damaging if we don't go on to update; it's just less than
	 * perfectly efficient (but no memory should be leaked).
	 */


	leafPtr = TclTraceDictPath(interp, dictPtr, pathc, pathv,
		DICT_PATH_EXISTS | DICT_PATH_UPDATE);

	if (leafPtr == NULL) {
	    if (allocdict) {
		TclDecrRefCount(dictPtr);
	    }
	    return TCL_ERROR;
	}
	if (leafPtr == DICT_PATH_NON_EXISTENT) {
	    if (allocdict) {
		TclDecrRefCount(dictPtr);
	    }

	    return TCL_OK;








	}
    } else {
	leafPtr = dictPtr;
    }

    /*
     * Now process our updates on the leaf dictionary.

	     */

	    Tcl_DictObjPut(NULL, leafPtr, keyv[i], Tcl_DuplicateObj(valPtr));
	} else {
	    Tcl_DictObjPut(NULL, leafPtr, keyv[i], valPtr);
	}
    }


    /*
     * Ensure that none of the dictionaries in the chain still have a string
     * rep.
     */

    if (pathc > 0) {
	InvalidateDictChain(leafPtr);
    }

    /*
     * Write back the outermost dictionary to the variable.
     */

    if (TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, dictPtr,
	    TCL_LEAVE_ERR_MSG, index) == NULL) {
	if (allocdict) {
	    TclDecrRefCount(dictPtr);
	}
	return TCL_ERROR;
    }

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

    iPtr->stats.numExecutions++;
#endif

    /*
     * Push the callback for bytecode execution
     */
    
    TclNRAddCallback(interp, TEBCresume, TD, /*resume*/ INT2PTR(0),
	    NULL, NULL);

    return TCL_OK;
}

static int
TEBCresume(
    ClientData data[],
    Tcl_Interp *interp,

    /*
     * -----------------------------------------------------------------
     *	   Start of dictionary-related instructions.
     */

    {
	int opnd2, allocateDict, done, i, allocdict;
	Tcl_Obj *dictPtr, *statePtr, *keyPtr, *listPtr, *varNamePtr, *keysPtr;
	Tcl_Obj *emptyPtr, **keyPtrPtr;
	Tcl_DictSearch *searchPtr;
	DictUpdateInfo *duiPtr;

    case INST_DICT_GET:
	opnd = TclGetUInt4AtPtr(pc+1);
	TRACE(("%u => ", opnd));

		if (allocdict) {
		    TclDecrRefCount(dictPtr);
		}
		goto gotError;
	    }
	}
	NEXT_INST_F(9, 1, 0);

    case INST_DICT_EXPAND:
	dictPtr = OBJ_UNDER_TOS;
	listPtr = OBJ_AT_TOS;
	if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
	    TRACE_WITH_OBJ(("%.30s %.30s => ERROR: ",
		    O2S(dictPtr), O2S(listPtr)), Tcl_GetObjResult(interp));
	    goto gotError;
	}
	objResultPtr = TclDictWithInit(interp, dictPtr, objc, objv);
	if (objResultPtr == NULL) {
	    TRACE_WITH_OBJ(("%.30s %.30s => ERROR: ",
		    O2S(dictPtr), O2S(listPtr)), Tcl_GetObjResult(interp));
	    goto gotError;
	}
	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	NEXT_INST_F(1, 2, 1);

    case INST_DICT_RECOMBINE_STK:
	keysPtr = POP_OBJECT();
	varNamePtr = OBJ_UNDER_TOS;
	listPtr = OBJ_AT_TOS;
	TRACE(("\"%.30s\" \"%.30s\" \"%.30s\" => ",
		O2S(varNamePtr), O2S(valuePtr), O2S(keysPtr)));
	if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
	    TclDecrRefCount(keysPtr);
	    goto gotError;
	}
	varPtr = TclObjLookupVarEx(interp, varNamePtr, NULL,
		TCL_LEAVE_ERR_MSG, "set", 1, 1, &arrayPtr);
	if (varPtr == NULL) {
	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
	    TclDecrRefCount(keysPtr);
	    goto gotError;
	}
	DECACHE_STACK_INFO();
	result = TclDictWithFinish(interp, varPtr,arrayPtr,varNamePtr,NULL,-1,
		objc, objv, keysPtr);
	CACHE_STACK_INFO();
	TclDecrRefCount(keysPtr);
	if (result != TCL_OK) {
	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
	    goto gotError;
	}
	TRACE_APPEND(("OK\n"));
	NEXT_INST_F(1, 2, 0);

    case INST_DICT_RECOMBINE_IMM:
	opnd = TclGetUInt4AtPtr(pc+1);
	listPtr = OBJ_UNDER_TOS;
	keysPtr = OBJ_AT_TOS;
	varPtr = LOCAL(opnd);
	TRACE(("%u <- \"%.30s\" \"%.30s\" => ", opnd, O2S(valuePtr),
		O2S(keysPtr)));
	if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
	    goto gotError;
	}
	while (TclIsVarLink(varPtr)) {
	    varPtr = varPtr->value.linkPtr;
	}
	DECACHE_STACK_INFO();
	result = TclDictWithFinish(interp, varPtr, NULL, NULL, NULL, opnd,
		objc, objv, keysPtr);
	CACHE_STACK_INFO();
	if (result != TCL_OK) {
	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
	    goto gotError;
	}
	TRACE_APPEND(("OK\n"));
	NEXT_INST_F(5, 2, 0);
    }

    /*
     *	   End of dictionary-related instructions.
     * -----------------------------------------------------------------
     */

static int
ReflectClose(
    ClientData clientData,
    Tcl_Interp *interp)
{
    ReflectedTransform *rtPtr = clientData;
    int errorCode, errorCodeSet = 0;
    int result = TCL_OK;	/* Result code for 'close' */
    Tcl_Obj *resObj;		/* Result data for 'close' */
    ReflectedTransformMap *rtmPtr;
				/* Map of reflected transforms with handlers
				 * in this interp. */
    Tcl_HashEntry *hPtr;	/* Entry in the above map */

    if (TclInThreadExit()) {

MODULE_SCOPE Tcl_TimerToken TclCreateAbsoluteTimerHandler(
			    Tcl_Time *timePtr, Tcl_TimerProc *proc,
			    ClientData clientData);
MODULE_SCOPE int	TclDefaultBgErrorHandlerObjCmd(
			    ClientData clientData, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitDictCmd(Tcl_Interp *interp);
MODULE_SCOPE int	TclDictWithFinish(Tcl_Interp *interp, Var *varPtr,
			    Var *arrayPtr, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, int index, int pathc,
			    Tcl_Obj *const pathv[], Tcl_Obj *keysPtr);
MODULE_SCOPE Tcl_Obj *	TclDictWithInit(Tcl_Interp *interp, Tcl_Obj *dictPtr,
			    int pathc, Tcl_Obj *const pathv[]);
MODULE_SCOPE int	Tcl_DisassembleObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
			    
/* Assemble command function */			    
MODULE_SCOPE int	Tcl_AssembleObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,

			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileDictSetCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileDictUpdateCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileDictWithCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileEnsemble(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileErrorCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);

    {"delete",          NamespaceDeleteCmd, NULL, NULL, NULL, 0},
    {"ensemble",        TclNamespaceEnsembleCmd, NULL, NULL, NULL, 0},
    {"eval",            NamespaceEvalCmd,       NULL, NRNamespaceEvalCmd, NULL, 0},
    {"exists",          NamespaceExistsCmd, NULL, NULL, NULL, 0},
    {"export",          NamespaceExportCmd, NULL, NULL, NULL, 0},
    {"forget",          NamespaceForgetCmd, NULL, NULL, NULL, 0},
    {"import",          NamespaceImportCmd, NULL, NULL, NULL, 0},
    {"inscope",         NamespaceInscopeCmd,    NULL, NRNamespaceInscopeCmd, NULL, 0},
    {"origin",          NamespaceOriginCmd, NULL, NULL, NULL, 0},
    {"parent",          NamespaceParentCmd, NULL, NULL, NULL, 0},
    {"path",            NamespacePathCmd, NULL, NULL, NULL, 0},
    {"qualifiers",      NamespaceQualifiersCmd, NULL, NULL, NULL, 0},
    {"tail",            NamespaceTailCmd, NULL, NULL, NULL, 0},
    {"unknown",         NamespaceUnknownCmd, NULL, NULL, NULL, 0},
    {"upvar",           NamespaceUpvarCmd,      TclCompileNamespaceUpvarCmd, NULL, NULL, 0},

    Tcl_AsyncHandler handler;	/* Tcl's token for the handler. */
    char *command;		/* Command to invoke when the handler is
				 * invoked. */
    struct TestAsyncHandler *nextPtr;
				/* Next is list of handlers. */
} TestAsyncHandler;

TCL_DECLARE_MUTEX(asyncTestMutex)

static TestAsyncHandler *firstHandler = NULL;

/*
 * The dynamic string below is used by the "testdstring" command to test the
 * dynamic string facilities.
 */

static int
TestparseargsCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Arguments. */
{
    static int foo = 0;
    int count = objc;
    Tcl_Obj **remObjv, *result[3];
    Tcl_ArgvInfo argTable[] = {
        {TCL_ARGV_CONSTANT, "-bool", INT2PTR(1), &foo, "booltest", NULL},
        TCL_ARGV_AUTO_REST, TCL_ARGV_AUTO_HELP, TCL_ARGV_TABLE_END
    };

    foo = 0;
    if (Tcl_ParseArgsObjv(interp, argTable, &count, objv, &remObjv)!=TCL_OK) {
        return TCL_ERROR;
    }
    result[0] = Tcl_NewIntObj(foo);
    result[1] = Tcl_NewIntObj(count);
    result[2] = Tcl_NewListObj(count, remObjv);
    Tcl_SetObjResult(interp, Tcl_NewListObj(3, result));

	    }
	}
    }
    string range [append foo OK] end-1 end
} -cleanup {
    unset foo t inner
} -result OK
test dict-22.12 {dict with: compiled} {
    apply {{} {
	set d {a 1 b 2}
	list [dict with d {
	    set a $b
	    unset b
	    dict set d c 3
	    list ok
	}] $d
    }}
} {ok {a 2 c 3}}
test dict-22.13 {dict with: compiled} {
    apply {i {
	set d($i) {a 1 b 2}
	list [dict with d($i) {
	    set a $b
	    unset b
	    dict set d($i) c 3
	    list ok
	}] [array get d]
    }} e
} {ok {e {a 2 c 3}}}
test dict-22.14 {dict with: compiled} {
    apply {{} {
	set d {a 1 b 2}
	foreach x {1 2 3} {
	    dict with d {
		incr a $b
		if {$x == 2} break
	    }
	    unset a b
	}
	list $a $b $x $d
    }}
} {5 2 2 {a 5 b 2}}
test dict-22.15 {dict with: compiled} {
    apply {i {
	set d($i) {a 1 b 2}
	foreach x {1 2 3} {
	    dict with d($i) {
		incr a $b
		if {$x == 2} break
	    }
	    unset a b
	}
	list $a $b $x [array get d]
    }} e
} {5 2 2 {e {a 5 b 2}}}
test dict-22.16 {dict with: compiled} {
    apply {{} {
	set d {p {q {a 1 b 2}}}
	dict with d p q {
	    set a $b.$a
	}
	return $d
    }}
} {p {q {a 2.1 b 2}}}
test dict-22.17 {dict with: compiled} {
    apply {i {
	set d($i) {p {q {a 1 b 2}}}
	dict with d($i) p q {
	    set a $b.$a
	}
	array get d
    }} e
} {e {p {q {a 2.1 b 2}}}}
test dict-22.18 {dict with: compiled} {
    set ::d {a 1 b 2}
    apply {{} {
	dict with ::d {
	    set a $b.$a
	}
	return $::d
    }}
} {a 2.1 b 2}
test dict-22.19 {dict with: compiled} {
    set ::d {p {q {r {a 1 b 2}}}}
    apply {{} {
	dict with ::d p q r {
	    set a $b.$a
	}
	return $::d
    }}
} {p {q {r {a 2.1 b 2}}}}
test dict-22.20 {dict with: compiled} {
    apply {d {
	dict with d {
	}
	return $a,$b
    }} {a 1 b 2}
} 1,2
test dict-22.21 {dict with: compiled} {
    apply {d {
	dict with d p q {
	}
	return $a,$b
    }} {p {q {a 1 b 2}}}
} 1,2
test dict-22.22 {dict with: compiled} {
    set ::d {a 1 b 2}
    apply {{} {
	dict with ::d {
	}
	return $a,$b
    }}
} 1,2
test dict-22.23 {dict with: compiled} {
    set ::d {p {q {a 1 b 2}}}
    apply {{} {
	dict with ::d p q {
	}
	return $a,$b
    }}
} 1,2

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl

	lrem names ""
    }
    foreach name {
	TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY
	SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
	DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING
	__CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG WINDIR TERM
	CommonProgramFiles ProgramFiles
    } {
	lrem names $name
    }
    foreach p $names {
	puts "[mangle $p]=[mangle $env($p)]"
    }
    exit
} printenv]

# [exec] is required here to see the actual environment received by child
# processes.
proc getenv {} {
    global printenvScript tcltest
    catch {exec [interpreter] $printenvScript} out
    if {$out eq "child process exited abnormally"} {
	set out {}

    # Keep some environment variables that support operation of the tcltest
    # package.
    if {[string toupper $name] ni {
	TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH DISPLAY SHLIB_PATH
	SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
	DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING
	SECURITYSESSIONID LANG WINDIR TERM
	CommonProgramFiles ProgramFiles
    }} {
	unset env($name)
    }
}

# Need to run 'getenv' in known encoding, so save the current one here...
set sysenc [encoding system]

    set f [open $path(test3) r]
    lappend x [gets $f]
    close $f
    set x
} {zzy abzzy}
test io-40.2 {POSIX open access modes: CREAT} {unix} {
    file delete $path(test3)
    set f [open $path(test3) {WRONLY CREAT} 0o600]
    file stat $path(test3) stats
    set x [format "0o%o" [expr $stats(mode)&0o777]]
    puts $f "line 1"
    close $f
    set f [open $path(test3) r]
    lappend x [gets $f]
    close $f
    set x
} {0o600 {line 1}}
test io-40.3 {POSIX open access modes: CREAT} {unix umask} {
    # This test only works if your umask is 2, like ouster's.
    file delete $path(test3)
    set f [open $path(test3) {WRONLY CREAT}]
    close $f
    file stat $path(test3) stats
    format "0%o" [expr $stats(mode)&0o777]

 *
 * NativeMatchType --
 *
 *	This function needs a special case for a path which is a root volume,
 *	because for NTFS root volumes, the getFileAttributesProc returns a
 *	'hidden' attribute when it should not.
 *
 *	We never make any calls to a 'get attributes' routine here, since we
 *	have arranged things so that our caller already knows such
 *	information.
 *
 * Results:
 *	0 = file doesn't match
 *	1 = file matches
 *

    }

    /*
     * Propagate the S_IREAD, S_IWRITE, S_IEXEC bits to the group and other
     * positions.
     */

    mode |= (mode & (S_IREAD|S_IWRITE|S_IEXEC)) >> 3;
    mode |= (mode & (S_IREAD|S_IWRITE|S_IEXEC)) >> 6;
    return (unsigned short) mode;
}

/*
 *------------------------------------------------------------------------
 *
 * ToCTime --