Tcl Source Code

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

    /*
     * We parse the variable list argument words and create two arrays:
     *    varvList[i] points to array of var names in i-th var list.
     */

    const char ***varvList;

    /*
     * If the foreach command isn't in a procedure, don't compile it inline:
     * the payoff is too small.
     */

    if (procPtr == NULL) {
	return TCL_ERROR;

	tokenPtr = TokenAfter(tokenPtr);
    }
    bodyTokenPtr = tokenPtr;
    if (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	return TCL_ERROR;
    }

    /*
     * Allocate storage for the varcList and varvList arrays if necessary.
     */

    numLists = (numWords - 2)/2;
    varvList = (const char ***) TclStackAlloc(interp,
	    numLists * sizeof(const char **));
    memset((char*) varvList, 0, numLists * sizeof(const char **));

    /*
     * Create and initialize the ForeachInfo and ForeachVarList data
     * structures describing this command. Then create a AuxData record
     * pointing to the ForeachInfo structure.
     */


    infoPtr = (ForeachInfo *) ckalloc((unsigned)
	    sizeof(ForeachInfo) + numLists*sizeof(ForeachVarList *));
    infoPtr->numLists = 0;	/* Count this up as we go */

    /*
     * Break up each var list and set the varcList and varvList arrays. Don't
     * compile the foreach inline if any var name needs substitutions or isn't
     * a scalar, or if any var list needs substitutions.
     */

    loopIndex = 0;
    varListObj = Tcl_NewObj();
    for (i = 0, tokenPtr = parsePtr->tokenPtr;

     *    - numLists temps to hold each value list
     *    - 1 temp for the loop counter (index of next element in each list)
     *
     * At this time we don't try to reuse temporaries; if there are two
     * nonoverlapping foreach loops, they don't share any temps.
     */

    code = TCL_OK;

    tempVar = TclFindCompiledLocal(NULL, 0, 1, procPtr);
    infoPtr->firstValueTemp = tempVar;
    for (loopIndex = 1;  loopIndex < numLists;  loopIndex++) {
	TclFindCompiledLocal(NULL, 0, 1, procPtr);
    }
    infoPtr->loopCtTemp = TclFindCompiledLocal(NULL, 0, 1, procPtr);

	if (infoPtr) {
	    FreeForeachInfo(infoPtr);
	}
    }
    if (varListObj) {
	Tcl_DecrRefCount(varListObj);
    }
    for (loopIndex = 0;  loopIndex < numLists;  loopIndex++) {
	if (varvList[loopIndex] != NULL) {
	    ckfree((char *) varvList[loopIndex]);
	}
    }
    TclStackFree(interp, (void *)varvList);
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * DupForeachInfo --