Tcl Source Code

.RS
.TP 15
\fB$\fIname\fR
.
\fIName\fR is the name of a scalar variable;  the name is a sequence
of one or more characters that are a letter, digit, underscore,
or namespace separators (two or more colons).
Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\(en\fB9\fR,
\fBA\fR\(en\fBZ\fR and \fBa\fR\(en\fBz\fR).
.TP 15
\fB$\fIname\fB(\fIindex\fB)\fR
.
\fIName\fR gives the name of an array variable and \fIindex\fR gives
the name of an element within that array.
\fIName\fR must contain only letters, digits, underscores, and
namespace separators, and may be an empty string.
Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\(en\fB9\fR,
\fBA\fR\(en\fBZ\fR and \fBa\fR\(en\fBz\fR).
Command substitutions, variable substitutions, and backslash
substitutions are performed on the characters of \fIindex\fR.
.TP 15
\fB${\fIname\fB}\fR
.
\fIName\fR is the name of a scalar variable or array element.  It may contain
any characters whatsoever except for close braces.  It indicates an array

and dollar signs to be included in words without triggering
special processing.
The following table lists the backslash sequences that are
handled specially, along with the value that replaces each sequence.
.RS
.TP 7
\e\fBa\fR
Audible alert (bell) (Unicode U+000007).
.TP 7
\e\fBb\fR
Backspace (Unicode U+000008).
.TP 7
\e\fBf\fR
Form feed (Unicode U+00000C).
.TP 7
\e\fBn\fR
Newline (Unicode U+00000A).
.TP 7
\e\fBr\fR
Carriage-return (Unicode U+00000D).
.TP 7
\e\fBt\fR
Tab (Unicode U+000009).
.TP 7
\e\fBv\fR
Vertical tab (Unicode U+00000B).
.TP 7
\e\fB<newline>\fIwhiteSpace\fR
.
A single space character replaces the backslash, newline, and all spaces
and tabs after the newline.  This backslash sequence is unique in that it
is replaced in a separate pre-pass before the command is actually parsed.
This means that it will be replaced even when it occurs between braces,
and the resulting space will be treated as a word separator if it is not
in braces or quotes.
.TP 7
\e\e
Backslash
.PQ \e "" .
.TP 7
\e\fIooo\fR 
.
The digits \fIooo\fR (one, two, or three of them) give a eight-bit octal 
value for the Unicode character that will be inserted, in the range
\fI000\fR\(en\fI377\fR (i.e., the range U+000000\(enU+0000FF).
The parser will stop just before this range overflows, or when
the maximum of three digits is reached.  The upper bits of the Unicode
character will be 0.
.TP 7
\e\fBx\fIhh\fR 
.
The hexadecimal digits \fIhh\fR (one or two of them) give an eight-bit
hexadecimal value for the Unicode character that will be inserted.  The upper
bits of the Unicode character will be 0 (i.e., the character will be in the
range U+000000\(enU+0000FF).
.TP 7
\e\fBu\fIhhhh\fR 
.
The hexadecimal digits \fIhhhh\fR (one, two, three, or four of them) give a
sixteen-bit hexadecimal value for the Unicode character that will be
inserted.  The upper bits of the Unicode character will be 0 (i.e., the
character will be in the range U+000000\(enU+00FFFF).
.TP 7
\e\fBU\fIhhhhhhhh\fR 
.
The hexadecimal digits \fIhhhhhhhh\fR (one up to eight of them) give a
twenty-one-bit hexadecimal value for the Unicode character that will be
inserted, in the range U+000000\(enU+10FFFF.  The parser will stop just
before this range overflows, or when the maximum of eight digits
is reached.  The upper bits of the Unicode character will be 0.
.RS
.PP
The range U+010000\(enU+10FFFD is reserved for the future.
.RE
.PP
Backslash substitution is not performed on words enclosed in braces,
except for backslash-newline as described above.
.RE
.IP "[10] \fBComments.\fR"
If a hash character
.PQ #

static void		PrintDictUpdateInfo(ClientData clientData,
			    Tcl_Obj *appendObj, ByteCode *codePtr,
			    unsigned int pcOffset);
static ClientData	DupForeachInfo(ClientData clientData);
static void		FreeForeachInfo(ClientData clientData);
static void		PrintForeachInfo(ClientData clientData,
			    Tcl_Obj *appendObj, ByteCode *codePtr,
			    unsigned int pcOffset);
static void		PrintNewForeachInfo(ClientData clientData,
			    Tcl_Obj *appendObj, ByteCode *codePtr,
			    unsigned int pcOffset);
static int		CompileEachloopCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    CompileEnv *envPtr, int collect);
static int		CompileDictEachCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr, int collect);

/*
 * The structures below define the AuxData types defined in this file.
 */

const AuxDataType tclForeachInfoType = {
    "ForeachInfo",		/* name */
    DupForeachInfo,		/* dupProc */
    FreeForeachInfo,		/* freeProc */
    PrintForeachInfo		/* printProc */
};

const AuxDataType tclNewForeachInfoType = {
    "NewForeachInfo",		/* name */
    DupForeachInfo,		/* dupProc */
    FreeForeachInfo,		/* freeProc */
    PrintNewForeachInfo		/* printProc */
};

const AuxDataType tclDictUpdateInfoType = {
    "DictUpdateInfo",		/* name */
    DupDictUpdateInfo,		/* dupProc */
    FreeDictUpdateInfo,		/* freeProc */
    PrintDictUpdateInfo		/* printProc */
};

				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *varTokenPtr, *dataTokenPtr;
    int isScalar, localIndex, code = TCL_OK;
    int isDataLiteral, isDataValid, isDataEven, len;
    int keyVar, valVar, infoIndex;
    int fwd, offsetBack, offsetFwd;
    Tcl_Obj *literalObj;
    ForeachInfo *infoPtr;

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

    PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_ELEMENT,
	    &localIndex, &isScalar, 1);
    if (!isScalar) {
	code = TCL_ERROR;
	goto done;
    }

    /*
     * Special case: literal empty value argument is just an "ensure array"
     * operation.
     */

    if (isDataEven && len == 0) {
	if (localIndex >= 0) {

	    TclAdjustStackDepth(1, envPtr);
	    TclEmitOpcode(  INST_POP,				envPtr);
	}
	PushStringLiteral(envPtr, "");
	goto done;
    }

    if (localIndex < 0) {
	/*
	 * a non-local variable: upvar from a local one! This consumes the
	 * variable name that was left at stacktop.
	 */
	
	localIndex = AnonymousLocal(envPtr);
	PushStringLiteral(envPtr, "0");
	TclEmitInstInt4(INST_REVERSE, 2,        		envPtr);
	TclEmitInstInt4(INST_UPVAR, localIndex, 		envPtr);
	TclEmitOpcode(INST_POP,          			envPtr);
    }
    
    /*
     * Prepare for the internal foreach.
     */



    keyVar = AnonymousLocal(envPtr);
    valVar = AnonymousLocal(envPtr);

    infoPtr = ckalloc(sizeof(ForeachInfo));
    infoPtr->numLists = 1;


    infoPtr->varLists[0] = ckalloc(sizeof(ForeachVarList) + sizeof(int));
    infoPtr->varLists[0]->numVars = 2;
    infoPtr->varLists[0]->varIndexes[0] = keyVar;
    infoPtr->varLists[0]->varIndexes[1] = valVar;
    infoIndex = TclCreateAuxData(infoPtr, &tclForeachInfoType, envPtr);

    /*
     * Start issuing instructions to write to the array.

	PushStringLiteral(envPtr, "-errorCode {TCL ARGUMENT FORMAT}");
	TclEmitInstInt4(INST_RETURN_IMM, TCL_ERROR,		envPtr);
	TclEmitInt4(		0,				envPtr);
	TclAdjustStackDepth(-1, envPtr);
	fwd = CurrentOffset(envPtr) - offsetFwd;
	TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1);
    }




    TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex,	envPtr);
    TclEmitInstInt1(INST_JUMP_TRUE1, 7,			envPtr);
    TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex,	envPtr);
    TclEmitInstInt4(INST_FOREACH_START, infoIndex,	envPtr);
    offsetBack = CurrentOffset(envPtr);



    Emit14Inst(	INST_LOAD_SCALAR, keyVar,		envPtr);
    Emit14Inst(	INST_LOAD_SCALAR, valVar,		envPtr);
    Emit14Inst(	INST_STORE_ARRAY, localIndex,		envPtr);
    TclEmitOpcode(	INST_POP,			envPtr);
    infoPtr->loopCtTemp = offsetBack - CurrentOffset(envPtr); /*misuse */




    TclEmitOpcode( INST_FOREACH_STEP,			envPtr);


    TclEmitOpcode( INST_FOREACH_END,			envPtr);


    TclAdjustStackDepth(-3, envPtr);














    PushStringLiteral(envPtr,	"");




    done:
    Tcl_DecrRefCount(literalObj);
    return code;
}

int
TclCompileArrayUnsetCmd(
    Tcl_Interp *interp,		/* Used for looking up stuff. */

	    }
	}
    }

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

     *



     * If the body is a simple word, compile a BEGIN_CATCH instruction,
     * followed by the instructions to eval the body.
     * Otherwise, compile instructions to substitute the body text before
     * starting the catch, then BEGIN_CATCH, and then EVAL_STK to evaluate the
     * substituted body.
     * Care has to be taken to make sure that substitution happens outside the
     * catch range so that errors in the substitution are not caught.
     * [Bug 219184]
     * The reason for duplicating the script is that EVAL_STK would otherwise
     * begin by undeflowing the stack below the mark set by BEGIN_CATCH4.
     */

    range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
    if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	TclEmitInstInt4(	INST_BEGIN_CATCH4, range,	envPtr);
	ExceptionRangeStarts(envPtr, range);
	BODY(cmdTokenPtr, 1);
    } else {
	SetLineInformation(1);
	CompileTokens(envPtr, cmdTokenPtr, interp);
	TclEmitInstInt4(	INST_BEGIN_CATCH4, range,	envPtr);
	ExceptionRangeStarts(envPtr, range);
	TclEmitOpcode(		INST_DUP,			envPtr);
	TclEmitInvoke(envPtr,	INST_EVAL_STK);





	/* drop the script */







	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
	TclEmitOpcode(		INST_POP,			envPtr);







    }





    ExceptionRangeEnds(envPtr, range);



    /*
     * Emit the "no errors" epilogue: push "0" (TCL_OK) as the catch result,
     * and jump around the "error case" code.
     */

    PushStringLiteral(envPtr, "0");
    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);


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

    TclAdjustStackDepth(-2, envPtr);
    ExceptionRangeTarget(envPtr, range, catchOffset);
    /* Stack at this point is empty */
    TclEmitOpcode(		INST_PUSH_RESULT,		envPtr);
    TclEmitOpcode(		INST_PUSH_RETURN_CODE,		envPtr);

    /* Stack at this point on both branches: 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. This needs to happen
     * before INST_END_CATCH
     */

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

    /*
     * End the catch
     */


    TclEmitOpcode(		INST_END_CATCH,			envPtr);

    /*




     * Save the result and return options if the caller wants them. This needs





     * to happen after INST_END_CATCH (compile-3.6/7).


     */











    if (optsIndex != -1) {

	Emit14Inst(		INST_STORE_SCALAR, optsIndex,	envPtr);
	TclEmitOpcode(		INST_POP,			envPtr);
    }



    /*
     * At this point, the top of the stack is inconveniently ordered:
     *		result returnCode

     * Reverse the stack to store the result.
     */


    TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
    if (resultIndex != -1) {
	Emit14Inst(	INST_STORE_SCALAR, resultIndex,	envPtr);
    }
    TclEmitOpcode(	INST_POP,			envPtr);

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

    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 */

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

		code = TCL_ERROR;
		goto done;
	    }
	}
	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.
     */

    infoPtr = ckalloc(sizeof(ForeachInfo)
	    + (numLists - 1) * sizeof(ForeachVarList *));
    infoPtr->numLists = numLists;


    for (loopIndex = 0;  loopIndex < numLists;  loopIndex++) {
	ForeachVarList *varListPtr;

	numVars = varcList[loopIndex];
	varListPtr = ckalloc(sizeof(ForeachVarList)
		+ (numVars - 1) * sizeof(int));
	varListPtr->numVars = numVars;
	for (j = 0;  j < numVars;  j++) {
	    const char *varName = varvList[loopIndex][j];
	    int nameChars = strlen(varName);

	    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);
    TclEmitOpcode(INST_FOREACH_STEP, envPtr);
    ExceptionRangeTarget(envPtr, range, breakOffset);
    TclFinalizeLoopExceptionRange(envPtr, range);
    TclEmitOpcode(INST_FOREACH_END, envPtr);
    TclAdjustStackDepth(-(numLists+2), envPtr);

    /*
     * Set the jumpback distance from INST_FOREACH_STEP to the start of the
     * body's code. Misuse loopCtTemp for storing the jump size.

     */
    
    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]);
	}
    }
    TclStackFree(interp, (void *)varvList);
    TclStackFree(interp, varcList);

	}
	Tcl_AppendPrintfToObj(appendObj, "\n\t\t it%%v%u\t[",
		(unsigned) (infoPtr->firstValueTemp + i));
	varsPtr = infoPtr->varLists[i];
	for (j=0 ; j<varsPtr->numVars ; j++) {
	    if (j) {
		Tcl_AppendToObj(appendObj, ", ", -1);
	    }
	    Tcl_AppendPrintfToObj(appendObj, "%%v%u",
		    (unsigned) varsPtr->varIndexes[j]);
	}
	Tcl_AppendToObj(appendObj, "]", -1);
    }
}

static void
PrintNewForeachInfo(
    ClientData clientData,
    Tcl_Obj *appendObj,
    ByteCode *codePtr,
    unsigned int pcOffset)
{
    register ForeachInfo *infoPtr = clientData;
    register ForeachVarList *varsPtr;
    int i, j;

    Tcl_AppendPrintfToObj(appendObj, "jumpOffset=%+d, vars=",
	    infoPtr->loopCtTemp);
    for (i=0 ; i<infoPtr->numLists ; i++) {
	if (i) {
	    Tcl_AppendToObj(appendObj, ",", -1);
	}
	Tcl_AppendToObj(appendObj, "[", -1);
	varsPtr = infoPtr->varLists[i];
	for (j=0 ; j<varsPtr->numVars ; j++) {
	    if (j) {
		Tcl_AppendToObj(appendObj, ",", -1);
	    }
	    Tcl_AppendPrintfToObj(appendObj, "%%v%u",
		    (unsigned) varsPtr->varIndexes[j]);
	}
	Tcl_AppendToObj(appendObj, "]", -1);
    }
}

	 * list and pushes that resulting list onto the stack.
	 * Stack: ... list1 list2 => ... [lconcat list1 list2] */

    {"expandDrop",       1,    0,          0,	{OPERAND_NONE}},
	/* Drops an element from the auxiliary stack, popping stack elements
	 * until the matching stack depth is reached. */

    /* New foreach implementation */
    {"foreach_start",	  5,   +2,          1,	{OPERAND_AUX4}},
	/* 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,   -1,         0,	{OPERAND_NONE}},

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

#define INST_TRY_CVT_TO_NUMERIC		64

/* Opcodes 65 to 66 */
#define INST_BREAK			65
#define INST_CONTINUE			66

/* Opcodes 67 to 68 */
#define INST_FOREACH_START4		67 /* DEPRECATED */
#define INST_FOREACH_STEP4		68 /* DEPRECATED */

/* Opcodes 69 to 72 */
#define INST_BEGIN_CATCH4		69
#define INST_END_CATCH			70
#define INST_PUSH_RESULT		71
#define INST_PUSH_RETURN_CODE		72

#define INST_INVOKE_REPLACE		163

#define INST_LIST_CONCAT		164

#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"

				 * structures describing each var list. The
				 * actual size of this field will be large
				 * enough to numVars indexes. THIS MUST BE THE
				 * LAST FIELD IN THE STRUCTURE! */
} ForeachInfo;

MODULE_SCOPE const AuxDataType tclForeachInfoType;
MODULE_SCOPE const AuxDataType tclNewForeachInfoType;

#define FOREACHINFO(envPtr, index) \
    ((ForeachInfo*)((envPtr)->auxDataArrayPtr[TclGetUInt4AtPtr(index)].clientData))

/*
 * Structure used to hold information about a switch command that is needed
 * during program execution. These structures are stored in CompileEnv and

	Var *iterVarPtr, *listVarPtr;
	Tcl_Obj *oldValuePtr, *listPtr, **elements;
	ForeachVarList *varListPtr;
	int numLists, iterNum, listTmpIndex, listLen, numVars;
	int varIndex, valIndex, continueLoop, j, iterTmpIndex;
	long i;

    case INST_FOREACH_START4: /* DEPRECATED */
	/*
	 * Initialize the temporary local var that holds the count of the
	 * number of iterations of the loop body to -1.
	 */

	opnd = TclGetUInt4AtPtr(pc+1);
	infoPtr = codePtr->auxDataArrayPtr[opnd].clientData;

	pc += 5;
	TCL_DTRACE_INST_NEXT();
#else
	NEXT_INST_F(5, 0, 0);
#endif

    case INST_FOREACH_STEP4: /* DEPRECATED */
	/*
	 * "Step" a foreach loop (i.e., begin its next iteration) by assigning
	 * the next value list element to each loop var.
	 */

	opnd = TclGetUInt4AtPtr(pc+1);
	infoPtr = codePtr->auxDataArrayPtr[opnd].clientData;

	pc += 5;
	if (*pc == INST_JUMP_FALSE1) {
	    NEXT_INST_F((continueLoop? 2 : TclGetInt1AtPtr(pc+1)), 0, 0);
	} else {
	    NEXT_INST_F((continueLoop? 5 : TclGetInt4AtPtr(pc+1)), 0, 0);
	}

    }
    {
	ForeachInfo *infoPtr;
	Tcl_Obj *listPtr, **elements, *tmpPtr;
	ForeachVarList *varListPtr;
	int numLists, iterMax, listLen, numVars;
	int iterTmp, iterNum, listTmpDepth;
	int varIndex, valIndex, j;
	long i;

    case INST_FOREACH_START:
	/*
	 * Initialize the data for the looping construct, pushing the
	 * corresponding Tcl_Objs to the stack.
	 */

	opnd = TclGetUInt4AtPtr(pc+1);
	infoPtr = codePtr->auxDataArrayPtr[opnd].clientData;
	numLists = infoPtr->numLists;

	/*
	 * Compute the number of iterations that will be run: iterMax
	 */

	iterMax = 0;
	listTmpDepth = numLists-1;
	for (i = 0;  i < numLists;  i++) {
	    varListPtr = infoPtr->varLists[i];
	    numVars = varListPtr->numVars;
	    listPtr = OBJ_AT_DEPTH(listTmpDepth);
	    if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) {
		TRACE_WITH_OBJ(("%u => ERROR converting list %ld, \"%s\": ",
			opnd, i, O2S(listPtr)), Tcl_GetObjResult(interp));
		goto gotError;
	    }
	    if (Tcl_IsShared(listPtr)) {
		objPtr = TclListObjCopy(NULL, listPtr);
		Tcl_IncrRefCount(objPtr);
		Tcl_DecrRefCount(listPtr);
		OBJ_AT_DEPTH(listTmpDepth) = objPtr;
	    }
	    iterTmp = (listLen + (numVars - 1))/numVars;
	    if (iterTmp > iterMax) {
		iterMax = iterTmp;
	    }
	    listTmpDepth--;
	}

	/*
	 * Store the iterNum and iterMax in a single Tcl_Obj; we keep a
	 * nul-string obj with the pointer stored in the ptrValue so that the
	 * thing is properly garbage collected. THIS OBJ MAKES NO SENSE, but
	 * it will never leave this scope and is read-only.
	 */

	TclNewObj(tmpPtr);
	tmpPtr->internalRep.twoPtrValue.ptr1 = INT2PTR(0);
	tmpPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(iterMax);
	PUSH_OBJECT(tmpPtr); /* iterCounts object */

	/*
	 * Store a pointer to the ForeachInfo struct; same dirty trick
	 * as above
	 */

	TclNewObj(tmpPtr);
	tmpPtr->internalRep.otherValuePtr = infoPtr;
	PUSH_OBJECT(tmpPtr); /* infoPtr object */

	/*
	 * Jump directly to the INST_FOREACH_STEP instruction; the C code just
	 * falls through.
	 */

	pc += 5 - infoPtr->loopCtTemp;

    case INST_FOREACH_STEP:
	/*
	 * "Step" a foreach loop (i.e., begin its next iteration) by assigning
	 * the next value list element to each loop var.
	 */

	tmpPtr = OBJ_AT_TOS;
	infoPtr = tmpPtr->internalRep.otherValuePtr;
	numLists = infoPtr->numLists;

	tmpPtr = OBJ_AT_DEPTH(1);
	iterNum = PTR2INT(tmpPtr->internalRep.twoPtrValue.ptr1);
	iterMax = PTR2INT(tmpPtr->internalRep.twoPtrValue.ptr2);

	/*
	 * If some list still has a remaining list element iterate one more
	 * time. Assign to var the next element from its value list.
	 */

	if (iterNum < iterMax) {
	    /*
	     * Set the variables and jump back to run the body
	     */

	    tmpPtr->internalRep.twoPtrValue.ptr1 = INT2PTR(iterNum + 1);

	    listTmpDepth = numLists + 1;

	    for (i = 0;  i < numLists;  i++) {
		varListPtr = infoPtr->varLists[i];
		numVars = varListPtr->numVars;

		listPtr = OBJ_AT_DEPTH(listTmpDepth);
		TclListObjGetElements(interp, listPtr, &listLen, &elements);

		valIndex = (iterNum * numVars);
		for (j = 0;  j < numVars;  j++) {
		    if (valIndex >= listLen) {
			TclNewObj(valuePtr);
		    } else {
			valuePtr = elements[valIndex];
		    }

		    varIndex = varListPtr->varIndexes[j];
		    varPtr = LOCAL(varIndex);
		    while (TclIsVarLink(varPtr)) {
			varPtr = varPtr->value.linkPtr;
		    }
		    if (TclIsVarDirectWritable(varPtr)) {
			value2Ptr = varPtr->value.objPtr;
			if (valuePtr != value2Ptr) {
			    if (value2Ptr != NULL) {
				TclDecrRefCount(value2Ptr);
			    }
			    varPtr->value.objPtr = valuePtr;
			    Tcl_IncrRefCount(valuePtr);
			}
		    } else {
			DECACHE_STACK_INFO();
			if (TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
				valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){
			    CACHE_STACK_INFO();
			    TRACE_WITH_OBJ((
				    "%u => ERROR init. index temp %d: ",
				    opnd,varIndex), Tcl_GetObjResult(interp));
			    goto gotError;
			}
			CACHE_STACK_INFO();
		    }
		    valIndex++;
		}
		listTmpDepth--;
	    }
	    /* loopCtTemp being 'misused' for storing the jump size */
	    NEXT_INST_F(infoPtr->loopCtTemp, 0, 0);
	}

	/*
	 * FALL THROUGH
	 */
	pc++;

    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.

	    list $count $result2
	}
	catchtest::x
    }
    -result {10 {can't set "result1": trace on result1 fails by request}}
    -cleanup {namespace delete catchtest}
}

test compile-3.7 {TclCompileCatchCmd: error in storing options [Bug 3098302]} {*}{
     -setup {
	 namespace eval catchtest {
	     variable options1 {}
	 }
	 trace add variable catchtest::options1 write catchtest::failtrace
	 proc catchtest::failtrace {n1 n2 op} {
	     return -code error "trace on $n1 fails by request"
	 }
     }
    -body {
	proc catchtest::x {} {
	    variable options1
	    set count 0
	    for {set i 0} {$i < 10} {incr i} {
		set status2 [catch {
		    set status1 [catch {
			return -code error -level 0 "original failure"
		    } result1 options1]
		} result2 options2]
		incr count
	    }
	    list $count $result2
	}
	catchtest::x
    }
    -result {10 {can't set "options1": trace on options1 fails by request}}
    -cleanup {namespace delete catchtest}
}

test compile-4.1 {TclCompileForCmd: command substituted test expression} {
    set i 0
    set j 0
    # Should be "forever"
    for {} [expr $i < 3] {} {
	set j [incr i]

	    textSetup
	    puts -nonewline $file "-"
	}
	{\(mu} {
	    textSetup
	    puts -nonewline $file "\\'d7 "
	}
	{\(em} - {\(en} {
	    textSetup
	    puts -nonewline $file "-"
	}
	{\(fm} {
	    textSetup
	    puts -nonewline $file "\\'27 "
	}

    set charmap [list \
	    {\&}	"\t" \
	    {\%}	{} \
	    "\\\n"	"\n" \
	    {\(+-}	"±" \
	    {\(co}	"©" \
	    {\(em}	"—" \
	    {\(en}	"–" \
	    {\(fm}	"′" \
	    {\(mu}	"×" \
	    {\(mi}	"−" \
	    {\(->}	"<font size=\"+1\">&#8594;</font>" \
	    {\fP}	{\fR} \
	    {\.}	. \
	    {\(bu}	"&#8226;" \