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		LocalScalarFromToken(Tcl_Token *tokenPtr,
			    CompileEnv *envPtr);
static int		LocalScalar(const char *bytes, int numBytes,
			    CompileEnv *envPtr);
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,

     * refer to local scalars.
     */

    resultIndex = optsIndex = -1;
    cmdTokenPtr = TokenAfter(parsePtr->tokenPtr);
    if (parsePtr->numWords >= 3) {
	resultNameTokenPtr = TokenAfter(cmdTokenPtr);
	resultIndex = LocalScalarFromToken(resultNameTokenPtr, envPtr);
	if (resultIndex < 0) {
	    return TCL_ERROR;
	}

	if (parsePtr->numWords == 4) {
	    optsNameTokenPtr = TokenAfter(resultNameTokenPtr);
	    optsIndex = LocalScalarFromToken(optsNameTokenPtr, envPtr);
	    if (optsIndex < 0) {
		return TCL_ERROR;
	    }
	}
    }

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

    /*
     * 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);
    dictVarIndex = LocalScalarFromToken(varTokenPtr, envPtr);
    if (dictVarIndex < 0) {
	return TCL_ERROR;
    }

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

    /*
     * 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);
    dictVarIndex = LocalScalarFromToken(varTokenPtr, envPtr);
    if (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, numBytes;
    const char *bytes;
    int savedStackDepth = envPtr->currStackDepth;
				/* Needed because jumps confuse the stack
				 * space calculator. */
    Tcl_Obj *varNameObj, *varListObj = NULL;


    DefineLineInformation;	/* TIP #280 */

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

    if (parsePtr->numWords != 4 || procPtr == NULL) {

	    TCL_OK != Tcl_ListObjLength(NULL, varListObj, &numVars) ||
	    numVars != 2) {
	Tcl_DecrRefCount(varListObj);
	return TCL_ERROR;
    }

    Tcl_ListObjIndex(NULL, varListObj, 0, &varNameObj);
    bytes = Tcl_GetStringFromObj(varNameObj, &numBytes);
    keyVarIndex = LocalScalar(bytes, numBytes, envPtr);
    if (keyVarIndex < 0) {
	Tcl_DecrRefCount(varListObj);
	return TCL_ERROR;
    }

    Tcl_ListObjIndex(NULL, varListObj, 1, &varNameObj);
    bytes = Tcl_GetStringFromObj(varNameObj, &numBytes);
    valueVarIndex = LocalScalar(bytes, numBytes, envPtr);
    if (valueVarIndex < 0) {
	Tcl_DecrRefCount(varListObj);
	return TCL_ERROR;
    }

    Tcl_DecrRefCount(varListObj);

    /*

    /*
     * 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);
    dictIndex = LocalScalarFromToken(dictVarTokenPtr, envPtr);
    if (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);
	index = LocalScalarFromToken(tokenPtr, envPtr);
	if (index < 0) {
	    ckfree((char *) duiPtr);
	    TclStackFree(interp, keyTokenPtrs);
	    return TCL_ERROR;
	}

	/*
	 * Stash the index in the auxiliary data.

    }

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

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    dictVarIndex = LocalScalarFromToken(tokenPtr, envPtr);
    if (dictVarIndex < 0) {
	return TCL_ERROR;
    }

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

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

    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
    keyTokenPtr = TokenAfter(varTokenPtr);
    valueTokenPtr = TokenAfter(keyTokenPtr);
    dictVarIndex = LocalScalarFromToken(varTokenPtr, envPtr);
    if (dictVarIndex < 0) {
	return TCL_ERROR;
    }
    CompileWord(envPtr, keyTokenPtr, interp, 2);
    CompileWord(envPtr, valueTokenPtr, interp, 3);
    TclEmitInstInt4( INST_DICT_LAPPEND, dictVarIndex, envPtr);
    return TCL_OK;
}

    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Proc *procPtr = envPtr->procPtr;
    ForeachInfo *infoPtr = NULL;/* Points to the structure describing this
				 * foreach command. Stored in a AuxData
				 * record in the ByteCode. */
    Tcl_Token *tokenPtr, *bodyTokenPtr;

    unsigned char *jumpPc;
    JumpFixup jumpFalseFixup;
    int jumpBackDist, jumpBackOffset, infoIndex, range;
    int numWords, numLists, tempVar, i, j, code = TCL_OK;
    int savedStackDepth = envPtr->currStackDepth;
    Tcl_Obj *varListObj = NULL;
    DefineLineInformation;	/* TIP #280 */

    /*
     * Parse each var list into sequence of var names. Don't
     * compile the foreach inline if any var name needs substitutions or isn't
     * a scalar, or if any var list needs substitutions.
     */

    varListObj = Tcl_NewObj();


    for (i = 0, tokenPtr = parsePtr->tokenPtr;
	    i < numWords-1;
	    i++, tokenPtr = TokenAfter(tokenPtr)) {
	ForeachVarList *varListPtr;
	int numVars;

	if (i%2 != 1) {

		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 numBytes;
	    const char *bytes;

	    Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj);
	    bytes = Tcl_GetStringFromObj(varNameObj, &numBytes);
	    varListPtr->varIndexes[j] = LocalScalar(bytes, numBytes, envPtr);
	    if (varListPtr->varIndexes[j] < 0) {
		code = TCL_ERROR;
		goto done;
	    }
	}
	Tcl_SetObjLength(varListObj, 0);
    }

    PushLiteral(envPtr, "", 0);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * LocalScalar(FromToken) --
 *
 *	Get the index into the table of compiled locals that corresponds
 *	to a local scalar variable name.

 *
 * Results:
 * 	Returns the non-negative integer index value into the table of
 *	compiled locals corresponding to a local scalar variable name.
 *	If the arguments passed in do not identify a local scalar variable
 *	then return -1.
 *
 * Side effects:


 *	May add an entry into the table of compiled locals.
 *
 *----------------------------------------------------------------------
 */

static int
LocalScalarFromToken(
    Tcl_Token *tokenPtr,
    CompileEnv *envPtr)

{
    int isSimple, isScalar, index;

    PushVarName(NULL, tokenPtr, envPtr, TCL_CREATE_VAR, &index,
	    &isSimple, &isScalar, 0 /* ignored */, NULL /* ignored */);
    if (!isScalar) {
	index = -1;
    }
    return index;
}

static int
LocalScalar(
    const char *bytes,
    int numBytes,
    CompileEnv *envPtr)
{
    Tcl_Token token[2] =	{{TCL_TOKEN_SIMPLE_WORD, NULL, 0, 1},
				 {TCL_TOKEN_TEXT, NULL, 0, 0}};

    token[1].start = bytes;
    token[1].size = numBytes;
    return LocalScalarFromToken(token, envPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * PushVarName --
 *

     * be called at runtime.
     */

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

	CompileWord(envPtr, otherTokenPtr, interp, i);
	localIndex = LocalScalarFromToken(localTokenPtr, envPtr);
	if (localIndex < 0) {
	    return TCL_ERROR;
	}
	TclEmitInstInt4(INST_UPVAR, localIndex, envPtr);
    }

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

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

	CompileWord(envPtr, otherTokenPtr, interp, i);
	localIndex = LocalScalarFromToken(localTokenPtr, envPtr);
	if (localIndex < 0) {
	    return TCL_ERROR;
	}
	TclEmitInstInt4(INST_NSUPVAR, localIndex, envPtr);
    }

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