Tcl Source Code

Check-in [840e1b7039]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Fix up the token array passed to PushVarNameWord. Remove string list parse.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | bug-e711ffb458
Files: files | file ages | folders
SHA1: 840e1b703911f14f34e414e79268aa088cb1bfd3
User & Date: dgp 2014-12-18 21:29:07
Context
2014-12-18
22:00
No need for varvList any more. check-in: 3af30a1c21 user: dgp tags: bug-e711ffb458
21:29
Fix up the token array passed to PushVarNameWord. Remove string list parse. check-in: 840e1b7039 user: dgp tags: bug-e711ffb458
21:08
Replace use of TclIsLocalScalar() and late setting of varIndexes with an earlier setting of varIndex... check-in: e9759dbced user: dgp tags: bug-e711ffb458
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclCompCmds.c.

1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
    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, numVars, loopIndex, tempVar, i, j, code;
    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.







|







1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
    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, 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.
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661


1662
1663
1664
1665
1666
1667
1668
1669
1670
     */

    loopIndex = 0;
    varListObj = Tcl_NewObj();
    for (i = 0, tokenPtr = parsePtr->tokenPtr;
	    i < numWords-1;
	    i++, tokenPtr = TokenAfter(tokenPtr)) {
	Tcl_DString varList;
	ForeachVarList *varListPtr;

	if (i%2 != 1) {
	    continue;
	}

	/*
	 * If the variable list is empty, we can enter an infinite loop when
	 * the interpreted version would not. Take care to ensure this does
	 * not happen. [Bug 1671138]
	 */

	if (!TclWordKnownAtCompileTime(tokenPtr, varListObj) ||
		TCL_OK != Tcl_ListObjLength(NULL, varListObj, &numVars) ||
		numVars == 0) {
	    code = TCL_ERROR;
	    goto done;
	}

	/*
	 * Lots of copying going on here. Need a ListObj wizard to show a
	 * better way.
	 */

	Tcl_DStringInit(&varList);
	Tcl_DStringAppend(&varList, tokenPtr[1].start, tokenPtr[1].size);
	code = Tcl_SplitList(interp, Tcl_DStringValue(&varList),
		&numVars, &varvList[loopIndex]);
	Tcl_DStringFree(&varList);
	if (code != TCL_OK) {
	    code = TCL_ERROR;
	    goto done;
	}

	varListPtr = (ForeachVarList *) ckalloc((unsigned)
		sizeof(ForeachVarList) + numVars*sizeof(int));
	varListPtr->numVars = numVars;
	infoPtr->varLists[loopIndex] = varListPtr;
	infoPtr->numLists++;

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

	    Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj);


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







<



















<
<
<
<
<
<
<
<
<
<
<
<
<
<
<








|



>
>
|
|







1608
1609
1610
1611
1612
1613
1614

1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633















1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
     */

    loopIndex = 0;
    varListObj = Tcl_NewObj();
    for (i = 0, tokenPtr = parsePtr->tokenPtr;
	    i < numWords-1;
	    i++, tokenPtr = TokenAfter(tokenPtr)) {

	ForeachVarList *varListPtr;

	if (i%2 != 1) {
	    continue;
	}

	/*
	 * If the variable list is empty, we can enter an infinite loop when
	 * the interpreted version would not. Take care to ensure this does
	 * not happen. [Bug 1671138]
	 */

	if (!TclWordKnownAtCompileTime(tokenPtr, varListObj) ||
		TCL_OK != Tcl_ListObjLength(NULL, varListObj, &numVars) ||
		numVars == 0) {
	    code = TCL_ERROR;
	    goto done;
	}
















	varListPtr = (ForeachVarList *) ckalloc((unsigned)
		sizeof(ForeachVarList) + numVars*sizeof(int));
	varListPtr->numVars = numVars;
	infoPtr->varLists[loopIndex] = varListPtr;
	infoPtr->numLists++;

	for (j = 0;  j < numVars;  j++) {
	    Tcl_Obj *varNameObj;
	    Tcl_Token token[2];
	    int varIndex, isSimple, isScalar;

	    Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj);
	    token[0].type = TCL_TOKEN_SIMPLE_WORD;
	    token[0].numComponents = 1;
	    token[1].start = Tcl_GetStringFromObj(varNameObj, &token[1].size);
	    PushVarNameWord(interp, token, envPtr, TCL_CREATE_VAR,
		&varIndex, &isSimple, &isScalar, 0 /* ignored */);
	    if (!isScalar || varIndex < 0) {
		code = TCL_ERROR;
		goto done;
	    }
	    varListPtr->varIndexes[j] = varIndex;
	}
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
    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 0
    for (loopIndex = 0;  loopIndex < numLists;  loopIndex++) {
	ForeachVarList *varListPtr = infoPtr->varLists[loopIndex];
	numVars = varListPtr->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, procPtr);
	}
    }
#endif
    infoIndex = TclCreateAuxData(infoPtr, &tclForeachInfoType, envPtr);

    /*
     * Create an exception record to handle [break] and [continue].
     */

    range = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE);







<
<
<
<
<
<
<
<
<
<
<
<
<







1674
1675
1676
1677
1678
1679
1680













1681
1682
1683
1684
1685
1686
1687
    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);














    infoIndex = TclCreateAuxData(infoPtr, &tclForeachInfoType, envPtr);

    /*
     * Create an exception record to handle [break] and [continue].
     */

    range = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE);