Tcl Source Code

			    Tcl_Obj *appendObj, ByteCode *codePtr,
			    unsigned int pcOffset);
static ClientData	DupJumptableInfo(ClientData clientData);
static void		FreeJumptableInfo(ClientData clientData);
static void		PrintJumptableInfo(ClientData clientData,
			    Tcl_Obj *appendObj, ByteCode *codePtr,
			    unsigned int pcOffset);


static int		PushVarName(Tcl_Interp *interp,
			    Tcl_Token *varTokenPtr, CompileEnv *envPtr,
			    int flags, int *localIndexPtr,
			    int *simpleVarNamePtr, int *isScalarPtr,
			    int line, int* clNext);
static int		CompileAssociativeBinaryOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, const char *identity,

				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    JumpFixup jumpFixup;
    Tcl_Token *cmdTokenPtr, *resultNameTokenPtr, *optsNameTokenPtr;
    int resultIndex, optsIndex, isSimple, isScalar, range;
    int initStackDepth = envPtr->currStackDepth;
    int savedStackDepth;
    DefineLineInformation;	/* TIP #280 */

    /*
     * If syntax does not match what we expect for [catch], do not compile.
     * Let runtime checks determine if syntax has changed.

     * refer to local scalars.
     */

    resultIndex = optsIndex = -1;
    cmdTokenPtr = TokenAfter(parsePtr->tokenPtr);
    if (parsePtr->numWords >= 3) {
	resultNameTokenPtr = TokenAfter(cmdTokenPtr);
	PushVarNameWord(NULL, resultNameTokenPtr, envPtr, TCL_CREATE_VAR,
		&resultIndex, &isSimple, &isScalar, 2);
	if (!isScalar || resultIndex < 0) {
	    return TCL_ERROR;
	}

	if (parsePtr->numWords == 4) {
	    optsNameTokenPtr = TokenAfter(resultNameTokenPtr);
	    PushVarNameWord(NULL, optsNameTokenPtr, envPtr, TCL_CREATE_VAR,
		    &optsIndex, &isSimple, &isScalar, 3);
	    if (!isScalar || resultIndex < 0) {
		return TCL_ERROR;
	    }
	}
    }

    /*
     * We will compile the catch command. Declare the exception range

    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. */
{
    Tcl_Token *tokenPtr;
    Tcl_Token *varTokenPtr;
    int i, isSimple, isScalar = 0, dictVarIndex = -1;
    DefineLineInformation;	/* TIP #280 */

    /*
     * There must be at least three arguments after the (sub-)command.
     */

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

    /*
     * The dictionary variable must be a local scalar that is knowable at
     * compile time; anything else exceeds the complexity of the opcode. So
     * discover what the index is.
     */

    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
    PushVarNameWord(NULL, varTokenPtr, envPtr, TCL_CREATE_VAR,
	    &dictVarIndex, &isSimple, &isScalar, 1);
    if (!isScalar || dictVarIndex < 0) {
	return TCL_ERROR;
    }

    /*
     * Remaining words (key path and value to set) can be handled normally.
     */

    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, *keyTokenPtr;
    int dictVarIndex, incrAmount, isScalar, isSimple;
    DefineLineInformation;	/* TIP #280 */

    /*
     * There must be at least two arguments after the command.
     */

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

    /*
     * The dictionary variable must be a local scalar that is knowable at
     * compile time; anything else exceeds the complexity of the opcode. So
     * discover what the index is.
     */

    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
    PushVarNameWord(NULL, varTokenPtr, envPtr, TCL_CREATE_VAR,
	    &dictVarIndex, &isSimple, &isScalar, 1);
    if (!isScalar || dictVarIndex < 0) {
	return TCL_ERROR;
    }

    keyTokenPtr = TokenAfter(varTokenPtr);

    /*
     * Parse the increment amount, if present.

				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Proc *procPtr = envPtr->procPtr;
    Tcl_Token *varsTokenPtr, *dictTokenPtr, *bodyTokenPtr;
    int keyVarIndex, valueVarIndex, loopRange, catchRange;
    int infoIndex, jumpDisplacement, bodyTargetOffset, emptyTargetOffset;
    int numVars, endTargetOffset, isSimple, isScalar;
    int savedStackDepth = envPtr->currStackDepth;
				/* Needed because jumps confuse the stack
				 * space calculator. */
    Tcl_Obj *varNameObj, *varListObj = NULL;
    Tcl_Token token[2] =	{{TCL_TOKEN_SIMPLE_WORD, NULL, 0, 1},
				 {TCL_TOKEN_TEXT, NULL, 0, 0}};
    DefineLineInformation;	/* TIP #280 */

	    numVars != 2) {
	Tcl_DecrRefCount(varListObj);
	return TCL_ERROR;
    }

    Tcl_ListObjIndex(NULL, varListObj, 0, &varNameObj);
    token[1].start = Tcl_GetStringFromObj(varNameObj, &token[1].size);
    PushVarNameWord(NULL, token, envPtr, TCL_CREATE_VAR,
	    &keyVarIndex, &isSimple, &isScalar, 0 /* ignored */);
    if (!isScalar || keyVarIndex < 0) {
	Tcl_DecrRefCount(varListObj);
	return TCL_ERROR;
    }

    Tcl_ListObjIndex(NULL, varListObj, 1, &varNameObj);
    token[1].start = Tcl_GetStringFromObj(varNameObj, &token[1].size);
    PushVarNameWord(NULL, token, envPtr, TCL_CREATE_VAR,
	    &valueVarIndex, &isSimple, &isScalar, 0 /* ignored */);
    if (!isScalar || valueVarIndex < 0) {
	Tcl_DecrRefCount(varListObj);
	return TCL_ERROR;
    }

    Tcl_DecrRefCount(varListObj);

    /*

    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. */
{
    int i, dictIndex, numVars, range, infoIndex, isSimple, isScalar;
    Tcl_Token **keyTokenPtrs, *dictVarTokenPtr, *bodyTokenPtr, *tokenPtr;
    DictUpdateInfo *duiPtr;
    JumpFixup jumpFixup;
    DefineLineInformation;	/* TIP #280 */

    /*
     * Parse the command. Expect the following:

    /*
     * The dictionary variable must be a local scalar that is knowable at
     * compile time; anything else exceeds the complexity of the opcode. So
     * discover what the index is.
     */

    dictVarTokenPtr = TokenAfter(parsePtr->tokenPtr);
    PushVarNameWord(NULL, dictVarTokenPtr, envPtr, TCL_CREATE_VAR,
	    &dictIndex, &isSimple, &isScalar, 1);
    if (!isScalar || dictIndex < 0) {
	return TCL_ERROR;
    }

    /*
     * Assemble the instruction metadata. This is complex enough that it is
     * represented as auxData; it holds an ordered list of variable indices
     * that are to be used.

	keyTokenPtrs[i] = tokenPtr;

	/*
	 * Variables first need to be checked for sanity.
	 */

	tokenPtr = TokenAfter(tokenPtr);
	PushVarNameWord(NULL, tokenPtr, envPtr, TCL_CREATE_VAR,
	    &index, &isSimple, &isScalar, 1);
	if (!isScalar || index < 0) {
	    ckfree((char *) duiPtr);
	    TclStackFree(interp, keyTokenPtrs);
	    return TCL_ERROR;
	}

	/*
	 * Stash the index in the auxiliary data.

    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 *tokenPtr;
    int i, isSimple, isScalar, dictVarIndex;
    DefineLineInformation;	/* TIP #280 */

    /*
     * There must be at least two argument after the command. Since we
     * implement using INST_CONCAT1, make sure the number of arguments
     * stays within its range.
     */

    if (parsePtr->numWords<4 || parsePtr->numWords>258) {
	return TCL_ERROR;
    }

    /*
     * Get the index of the local variable that we will be working with.
     */

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    PushVarNameWord(NULL, tokenPtr, envPtr, TCL_CREATE_VAR,
	    &dictVarIndex, &isSimple, &isScalar, 1);
    if (!isScalar || dictVarIndex < 0) {
	return TCL_ERROR;
    }

    /*
     * Produce the string to concatenate onto the dictionary entry.
     */

    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, *keyTokenPtr, *valueTokenPtr;
    int isSimple, dictVarIndex = -1, isScalar = 0;
    DefineLineInformation;	/* TIP #280 */

    /*
     * There must be three arguments after the command.
     */

    if (parsePtr->numWords != 4) {
	return TCL_ERROR;
    }

    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
    keyTokenPtr = TokenAfter(varTokenPtr);
    valueTokenPtr = TokenAfter(keyTokenPtr);
    PushVarNameWord(NULL, varTokenPtr, envPtr, TCL_CREATE_VAR,
	    &dictVarIndex, &isSimple, &isScalar, 1);
    if (!isScalar || dictVarIndex < 0) {
	return TCL_ERROR;
    }
    CompileWord(envPtr, keyTokenPtr, interp, 2);
    CompileWord(envPtr, valueTokenPtr, interp, 3);
    TclEmitInstInt4( INST_DICT_LAPPEND, dictVarIndex, envPtr);
    return TCL_OK;
}

		sizeof(ForeachVarList) + numVars*sizeof(int));
	varListPtr->numVars = numVars;
	infoPtr->varLists[i/2] = varListPtr;
	infoPtr->numLists++;

	for (j = 0;  j < numVars;  j++) {
	    Tcl_Obj *varNameObj;
	    int varIndex, isSimple, isScalar;

	    Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj);
	    token[1].start = Tcl_GetStringFromObj(varNameObj, &token[1].size);
	    PushVarNameWord(NULL, token, envPtr, TCL_CREATE_VAR,
		&varIndex, &isSimple, &isScalar, 0 /* ignored */);
	    if (!isScalar || varIndex < 0) {
		code = TCL_ERROR;
		goto done;
	    }
	    varListPtr->varIndexes[j] = varIndex;
	}
	Tcl_SetObjLength(varListObj, 0);
    }

    /*
     * Reserve (numLists + 1) temporary variables:
     *    - numLists temps to hold each value list

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
































 * PushVarName --
 *
 *	Procedure used in the compiling where pushing a variable name is
 *	necessary (append, lappend, set).
 *
 * Results:
 * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer

    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 *tokenPtr, *otherTokenPtr, *localTokenPtr;
    int simpleVarName, isScalar, localIndex, numWords, i;
    DefineLineInformation;	/* TIP #280 */
    Tcl_Obj *objPtr;

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

     * be called at runtime.
     */

    for(; i<numWords; i+=2, otherTokenPtr = TokenAfter(localTokenPtr)) {
	localTokenPtr = TokenAfter(otherTokenPtr);

	CompileWord(envPtr, otherTokenPtr, interp, i);
	PushVarNameWord(NULL, localTokenPtr, envPtr, TCL_CREATE_VAR,
			&localIndex, &simpleVarName, &isScalar, i+1);

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

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

    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 *tokenPtr, *otherTokenPtr, *localTokenPtr;
    int simpleVarName, isScalar, localIndex, numWords, i;
    DefineLineInformation;	/* TIP #280 */

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

    /*

    localTokenPtr = tokenPtr;
    for(i=3; i<numWords; i+=2) {
	otherTokenPtr = TokenAfter(localTokenPtr);
	localTokenPtr = TokenAfter(otherTokenPtr);

	CompileWord(envPtr, otherTokenPtr, interp, i);
	PushVarNameWord(NULL, localTokenPtr, envPtr, TCL_CREATE_VAR,
			&localIndex, &simpleVarName, &isScalar, i+1);

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

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