Tcl Source Code

    int collect)		/* Select collecting or accumulating mode
				 * (TCL_EACH_*) */
{
    Proc *procPtr = envPtr->procPtr;
    ForeachInfo *infoPtr;	/* Points to the structure describing this
				 * foreach command. Stored in a AuxData
				 * record in the ByteCode. */


    
    Tcl_Token *tokenPtr, *bodyTokenPtr;
    int jumpBackOffset, infoIndex, range;
    int numWords, numLists, numVars, loopIndex, i, j, code;
    DefineLineInformation;	/* TIP #280 */

    /*

	loopIndex++;
    }

    /*
     * We will compile the foreach command.
     */








    code = TCL_OK;

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

	    varListPtr->varIndexes[j] = TclFindCompiledLocal(varName,
		    nameChars, /*create*/ 1, envPtr);
	}
	infoPtr->varLists[loopIndex] = varListPtr;
    }
    infoIndex = TclCreateAuxData(infoPtr, &tclNewForeachInfoType, envPtr);

    /*
     * Create the collecting object, unshared.
     */
    
    if (collect == TCL_EACH_COLLECT) {
	TclEmitInstInt4(INST_LIST, 0, envPtr);
    }
	    
    /*
     * Evaluate each value list and leave it on stack.
     */

    for (i = 0, tokenPtr = parsePtr->tokenPtr;
	    i < numWords-1;
	    i++, tokenPtr = TokenAfter(tokenPtr)) {
	if ((i%2 == 0) && (i > 0)) {
	    CompileWord(envPtr, tokenPtr, interp, i);
	}
    }











    TclEmitInstInt4(INST_FOREACH_START, infoIndex, envPtr);
    
    /*
     * Inline compile the loop body.
     */

    range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);

    ExceptionRangeStarts(envPtr, range);
    BODY(bodyTokenPtr, numWords - 1);
    ExceptionRangeEnds(envPtr, range);
    
    if (collect == TCL_EACH_COLLECT) {
	TclEmitOpcode(INST_LMAP_COLLECT, envPtr);
    } else {
	TclEmitOpcode(		INST_POP,			envPtr);
    }

    /*
     * Bottom of loop code: assign each loop variable and check whether
     * to terminate the loop. Set the loop's break target. 
     */

    ExceptionRangeTarget(envPtr, range, continueOffset);

     */
    
    jumpBackOffset = envPtr->exceptArrayPtr[range].continueOffset -
	    envPtr->exceptArrayPtr[range].codeOffset;
    infoPtr->loopCtTemp = -jumpBackOffset;

    /*
     * The command's result is an empty string if not collecting. If
     * collecting, it is automatically left on stack after FOREACH_END.
     */

    if (collect != TCL_EACH_COLLECT) {




	PushStringLiteral(envPtr, "");
    }
    
    done:
    for (loopIndex = 0;  loopIndex < numLists;  loopIndex++) {
	if (varvList[loopIndex] != NULL) {
	    ckfree(varvList[loopIndex]);

	/* Initialize execution of a foreach loop. Operand is aux data index
	 * of the ForeachInfo structure for the foreach command. It pushes 2
	 * elements which hold runtime params for foreach_step, they are later
	 * dropped by foreach_end together with the value lists. */ 
    {"foreach_step",	  1,    0,         0,	{OPERAND_NONE}},
	/* "Step" or begin next iteration of foreach loop. */
    {"foreach_end",	  1,    0,         0,	{OPERAND_NONE}},
    {"lmap_collect",	  1,    0,         0,	{OPERAND_NONE}},

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

#define INST_EXPAND_DROP		165

/* New foreach implementation */

#define INST_FOREACH_START              166
#define INST_FOREACH_STEP               167
#define INST_FOREACH_END                168
#define INST_LMAP_COLLECT               169

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

    case INST_FOREACH_END:
	/* THIS INSTRUCTION IS ONLY CALLED AS A BREAK TARGET */
	tmpPtr = OBJ_AT_TOS;
	infoPtr = tmpPtr->internalRep.otherValuePtr;
	numLists = infoPtr->numLists;
	NEXT_INST_V(1, numLists+2, 0);

    case INST_LMAP_COLLECT:
	/*
	 * This instruction is only issued by lmap. The stack is:
	 *   - result
	 *   - infoPtr
	 *   - loop counters
	 *   - valLists
	 *   - collecting obj (unshared)
	 * The instruction lappends the result to the collecting obj.
	 */

	tmpPtr = OBJ_AT_DEPTH(1);
	infoPtr = tmpPtr->internalRep.otherValuePtr;
	numLists = infoPtr->numLists;
	
	objPtr = OBJ_AT_DEPTH(3 + numLists);
	Tcl_ListObjAppendElement(NULL, objPtr, OBJ_AT_TOS);
	NEXT_INST_F(1, 1, 0);
    }

    case INST_BEGIN_CATCH4:
	/*
	 * Record start of the catch command with exception range index equal
	 * to the operand. Push the current stack depth onto the special catch
	 * stack.