Tcl Source Code

Check-in [e9759dbced]
Login

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

Overview
Comment:Replace use of TclIsLocalScalar() and late setting of varIndexes with an earlier setting of varIndexes using PushVarNameWord().
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | bug-e711ffb458
Files: files | file ages | folders
SHA1: e9759dbced365dd9382ac1fee65076d9f5419b7b
User & Date: dgp 2014-12-18 21:08:53
Context
2014-12-18
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
20:38
Simplify creation and storage of temporaries check-in: 289b5a64d8 user: dgp tags: bug-e711ffb458
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclCompCmds.c.

1541
1542
1543
1544
1545
1546
1547

1548
1549
1550
1551
1552
1553
1554
				 * 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;

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








>







1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
				 * 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.
     */

1603
1604
1605
1606
1607
1608
1609

1610
1611
1612
1613
1614
1615
1616
1617
1618
1619









1620
1621
1622
1623
1624
1625
1626
    /*
     * 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;

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

	if (i%2 != 1) {
	    continue;
	}
	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {









	    code = TCL_ERROR;
	    goto done;
	}

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







>









|
>
>
>
>
>
>
>
>
>







1604
1605
1606
1607
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
    /*
     * 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;
	    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.
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

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

	/*
	 * 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 (numVars == 0) {
	    code = TCL_ERROR;
	    goto done;

	}

	for (j = 0;  j < numVars;  j++) {
	    const char *varName = varvList[loopIndex][j];


	    if (!TclIsLocalScalar(varName, (int) strlen(varName))) {
		code = TCL_ERROR;
		goto done;
	    }

	}


	loopIndex++;
    }

    /*
     * We will compile the foreach command. Reserve (numLists + 1) temporary
     * variables:
     *    - numLists temps to hold each value list







<
<
<
<
<
|
|
<
|
>
|
|
<
|
|
>
|



>

>
>







1649
1650
1651
1652
1653
1654
1655





1656
1657

1658
1659
1660
1661

1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679

	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;
	}

	Tcl_SetObjLength(varListObj, 0);
	loopIndex++;
    }

    /*
     * We will compile the foreach command. Reserve (numLists + 1) temporary
     * variables:
     *    - numLists temps to hold each value list
1679
1680
1681
1682
1683
1684
1685

1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696

1697
1698
1699
1700
1701
1702
1703
    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);


    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);
	}
    }

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

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

    range = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE);







>











>







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);
1806
1807
1808
1809
1810
1811
1812



1813
1814
1815
1816
1817
1818
1819

  done:
    if (code == TCL_ERROR) {
	if (infoPtr) {
	    FreeForeachInfo(infoPtr);
	}
    }



    for (loopIndex = 0;  loopIndex < numLists;  loopIndex++) {
	if (varvList[loopIndex] != NULL) {
	    ckfree((char *) varvList[loopIndex]);
	}
    }
    TclStackFree(interp, (void *)varvList);
    return code;







>
>
>







1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833

  done:
    if (code == TCL_ERROR) {
	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;