Itcl - the [incr Tcl] extension

Check-in [4744d4ba35]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment:Itcl_BuildVirtualTables: avoid whole recreation of var-resolver table (huge speed-up of class creation)
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | sebres-on-dmnd-resolver-perf-branch
Files: files | file ages | folders
SHA3-256: 4744d4ba35e9029ecc60d153c1067ea7dae7f638728898023dc487c96ac4b93a
User & Date: sebres 2019-04-17 20:40:16
Context
2019-04-17
20:41
avoid duplicates of vlookup by same var (protected vars of ancestor class), can use same handle across all namespaces check-in: 0020101e54 user: sebres tags: sebres-on-dmnd-resolver-perf-branch
20:40
Itcl_BuildVirtualTables: avoid whole recreation of var-resolver table (huge speed-up of class creation) check-in: 4744d4ba35 user: sebres tags: sebres-on-dmnd-resolver-perf-branch
20:36
fix disable assert for release-version (normally NDEBUG signaling no asserts) check-in: fcbb36b8f9 user: sebres tags: sebres-on-dmnd-resolver-perf-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/itclClass.c.

337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
....
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755

1756
1757
1758


1759
1760
1761
1762
1763
1764
1765
1766
1767





1768
1769

1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810

1811
1812
1813
1814
1815
1816

1817
1818








1819





1820







1821
1822
1823
1824


1825
1826







































1827
1828
1829
1830
1831
1832

1833
1834
1835

1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
    Tcl_InitObjHashTable(&iclsPtr->delegatedOptions);
    Tcl_InitObjHashTable(&iclsPtr->delegatedFunctions);
    Tcl_InitObjHashTable(&iclsPtr->methodVariables);
    Tcl_InitObjHashTable(&iclsPtr->resolveCmds);

    iclsPtr->numInstanceVars = 0;
    Tcl_InitHashTable(&iclsPtr->classCommons, TCL_ONE_WORD_KEYS);
    Tcl_InitHashTable(&iclsPtr->resolveVars, TCL_ONE_WORD_KEYS);
    Tcl_InitHashTable(&iclsPtr->contextCache, TCL_ONE_WORD_KEYS);

    Itcl_InitList(&iclsPtr->bases);
    Itcl_InitList(&iclsPtr->derived);

    resolveInfoPtr = (ItclResolveInfo *) ckalloc(sizeof(ItclResolveInfo));
    memset (resolveInfoPtr, 0, sizeof(ItclResolveInfo));
................................................................................
void
Itcl_BuildVirtualTables(
    ItclClass* iclsPtr)       /* class definition being updated */
{
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch place;
    Tcl_Namespace* nsPtr;
    Tcl_DString buffer, buffer2;
    Tcl_Obj *objPtr;
    ItclVarLookup *vlookup;
    ItclVariable *ivPtr;
    ItclMemberFunc *imPtr;
    ItclDelegatedFunction *idmPtr;
    ItclHierIter hier;
    ItclClass *iclsPtr2;
    ItclCmdLookup *clookupPtr;
    int newEntry;

    Tcl_DStringInit(&buffer);
    Tcl_DStringInit(&buffer2);

    /*
     *  Clear the variable resolution table.
     */
    hPtr = Tcl_FirstHashEntry(&iclsPtr->resolveVars, &place);
    while (hPtr) {
        vlookup = (ItclVarLookup*)Tcl_GetHashValue(hPtr);
        if (--vlookup->usage == 0) {
            ckfree((char*)vlookup);
        }
        hPtr = Tcl_NextHashEntry(&place);
    }
    Tcl_DeleteHashTable(&iclsPtr->resolveVars);
    Tcl_InitHashTable(&iclsPtr->resolveVars, TCL_STRING_KEYS);
    iclsPtr->numInstanceVars = 0;

    /*
     *  Set aside the first object-specific slot for the built-in
     *  "this" variable.  Only allocate one of these, even though
     *  there is a definition for "this" in each class scope.
     *  Set aside the second and third object-specific slot for the built-in
     *  "itcl_options" and "itcl_option_components" variable.
     */

    iclsPtr->numInstanceVars++;
    iclsPtr->numInstanceVars++;
    iclsPtr->numInstanceVars++;



    /*
     *  Scan through all classes in the hierarchy, from most to
     *  least specific.  Add a lookup entry for each variable
     *  into the table.
     */
    Itcl_InitHierIter(&hier, iclsPtr);
    iclsPtr2 = Itcl_AdvanceHierIter(&hier);
    while (iclsPtr2 != NULL) {





        hPtr = Tcl_FirstHashEntry(&iclsPtr2->variables, &place);
        while (hPtr) {

            ivPtr = (ItclVariable*)Tcl_GetHashValue(hPtr);

            vlookup = (ItclVarLookup *)ckalloc(sizeof(ItclVarLookup));
            vlookup->ivPtr = ivPtr;
            vlookup->usage = 0;
            vlookup->leastQualName = NULL;

            /*
             *  If this variable is PRIVATE to another class scope,
             *  then mark it as "inaccessible".
             */
            vlookup->accessible = (ivPtr->protection != ITCL_PRIVATE ||
	            ivPtr->iclsPtr == iclsPtr);

            /*
             *  If this is a reference to the built-in "this"
             *  variable, then its index is "0".  Otherwise,
             *  add another slot to the end of the table.
             */
            if ((ivPtr->flags & ITCL_THIS_VAR) != 0) {
	        vlookup->varNum = 0;
	    } else {
		if ((ivPtr->flags & ITCL_OPTIONS_VAR) != 0) {
	            vlookup->varNum = 1;
		} else {
		    vlookup->varNum = iclsPtr->numInstanceVars++;
	        }
	    }
/* FIXME !!! should use for var lookup !! */

            /*
             *  Create all possible names for this variable and enter
             *  them into the variable resolution table:
             *     var
             *     class::var
             *     namesp1::class::var
             *     namesp2::namesp1::class::var
             *     ...
             */
            Tcl_DStringSetLength(&buffer, 0);
            Tcl_DStringAppend(&buffer, Tcl_GetString(ivPtr->namePtr), -1);

            nsPtr = iclsPtr2->nsPtr;

            while (1) {
                hPtr = Tcl_CreateHashEntry(&iclsPtr->resolveVars,
                    Tcl_DStringValue(&buffer), &newEntry);


                if (newEntry) {
                    Tcl_SetHashValue(hPtr, (ClientData)vlookup);








                    vlookup->usage++;













                    if (!vlookup->leastQualName) {
                        vlookup->leastQualName =
                            Tcl_GetHashKey(&iclsPtr->resolveVars, hPtr);
                    }


                }








































                if (nsPtr == NULL) {
                    break;
                }
                Tcl_DStringSetLength(&buffer2, 0);
                Tcl_DStringAppend(&buffer2, Tcl_DStringValue(&buffer), -1);
                Tcl_DStringSetLength(&buffer, 0);

                Tcl_DStringAppend(&buffer, nsPtr->name, -1);
                Tcl_DStringAppend(&buffer, "::", -1);
                Tcl_DStringAppend(&buffer, Tcl_DStringValue(&buffer2), -1);


                nsPtr = nsPtr->parentPtr;
            }

            /*
             *  If this record is not needed, free it now.
             */
            if (vlookup->usage == 0) {
                ckfree((char*)vlookup);
            }
            hPtr = Tcl_NextHashEntry(&place);
        }
        iclsPtr2 = Itcl_AdvanceHierIter(&hier);
    }
    Itcl_DeleteHierIter(&hier);

    /*
     *  Clear the command resolution table.
     */






|







 







|








|




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







>
|
|
|
>
>









>
>
>
>
>
|
|
>
|

<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<










<
|
>



|
|

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



|
<
<
>
|
|
|
>



<
<
<
<
<
<
<
|
|







337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
....
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733















1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765


1766
























1767
1768
1769
1770
1771
1772
1773
1774
1775
1776

1777
1778
1779
1780
1781
1782
1783
1784
1785
1786

1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859


1860
1861
1862
1863
1864
1865
1866
1867







1868
1869
1870
1871
1872
1873
1874
1875
1876
    Tcl_InitObjHashTable(&iclsPtr->delegatedOptions);
    Tcl_InitObjHashTable(&iclsPtr->delegatedFunctions);
    Tcl_InitObjHashTable(&iclsPtr->methodVariables);
    Tcl_InitObjHashTable(&iclsPtr->resolveCmds);

    iclsPtr->numInstanceVars = 0;
    Tcl_InitHashTable(&iclsPtr->classCommons, TCL_ONE_WORD_KEYS);
    Tcl_InitHashTable(&iclsPtr->resolveVars, TCL_STRING_KEYS);
    Tcl_InitHashTable(&iclsPtr->contextCache, TCL_ONE_WORD_KEYS);

    Itcl_InitList(&iclsPtr->bases);
    Itcl_InitList(&iclsPtr->derived);

    resolveInfoPtr = (ItclResolveInfo *) ckalloc(sizeof(ItclResolveInfo));
    memset (resolveInfoPtr, 0, sizeof(ItclResolveInfo));
................................................................................
void
Itcl_BuildVirtualTables(
    ItclClass* iclsPtr)       /* class definition being updated */
{
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch place;
    Tcl_Namespace* nsPtr;
    Tcl_DString buffer, buffer2, *bufferC;
    Tcl_Obj *objPtr;
    ItclVarLookup *vlookup;
    ItclVariable *ivPtr;
    ItclMemberFunc *imPtr;
    ItclDelegatedFunction *idmPtr;
    ItclHierIter hier;
    ItclClass *iclsPtr2;
    ItclCmdLookup *clookupPtr;
    int newEntry, processAncestors = 0;

    Tcl_DStringInit(&buffer);
    Tcl_DStringInit(&buffer2);
















    /*
     *  Set aside the first object-specific slot for the built-in
     *  "this" variable.  Only allocate one of these, even though
     *  there is a definition for "this" in each class scope.
     *  Set aside the second and third object-specific slot for the built-in
     *  "itcl_options" and "itcl_option_components" variable.
     */
    if (!iclsPtr->numInstanceVars) {
	iclsPtr->numInstanceVars++;
	iclsPtr->numInstanceVars++;
	iclsPtr->numInstanceVars++;
	processAncestors = 1;
    }

    /*
     *  Scan through all classes in the hierarchy, from most to
     *  least specific.  Add a lookup entry for each variable
     *  into the table.
     */
    Itcl_InitHierIter(&hier, iclsPtr);
    iclsPtr2 = Itcl_AdvanceHierIter(&hier);
    while (iclsPtr2 != NULL) {
	/* Stop create vars for ancestors (if already processed once) */
	if (iclsPtr2 != iclsPtr && !processAncestors) {
	    break;
	}

	hPtr = Tcl_FirstHashEntry(&iclsPtr2->variables, &place);
	while (hPtr) {
	    const char *varName;
	    ivPtr = (ItclVariable*)Tcl_GetHashValue(hPtr);



            vlookup = NULL;

























            /*
             *  Create all possible names for this variable and enter
             *  them into the variable resolution table:
             *     var
             *     class::var
             *     namesp1::class::var
             *     namesp2::namesp1::class::var
             *     ...
             */

            varName = Tcl_GetString(ivPtr->namePtr);
            bufferC = &buffer;
            nsPtr = iclsPtr2->nsPtr;

            while (1) {
		hPtr = Tcl_CreateHashEntry(&iclsPtr->resolveVars,
		    varName, &newEntry);

		/* check for same name in current class */
		if (!newEntry) {

		    vlookup = (ItclVarLookup*)Tcl_GetHashValue(hPtr);
		    if (vlookup->ivPtr != ivPtr && iclsPtr2 == iclsPtr) {
		    	/* if used multiple times - unbind, else - overwrite */
			if (vlookup->usage > 1) {
			    /* correct leastQualName */
			    vlookup->leastQualName = NULL;
			    processAncestors = 1; /* correction in progress */
			    /* should create new lookup */
			    --vlookup->usage;
			    vlookup = NULL;
			} else {
			    /* correct values (overwrite) */
			    vlookup->usage = 0;
			    goto setResVar;
			}
			newEntry = 1;
		    } else {
		    	/* var exists and no correction necessary - next var */
			if (!processAncestors) {
			    break;
			}
			/* check leastQualName correction needed */
			if (!vlookup->leastQualName) {
			    vlookup->leastQualName = 
				Tcl_GetHashKey(&iclsPtr->resolveVars, hPtr);
			}
			/* reset vlookup for full-qualified names - new lookup */
			vlookup = NULL;
		    }
		}
		if (newEntry) {
		    if (!vlookup) {
			/* create new (or overwrite) */
			vlookup = (ItclVarLookup *)ckalloc(sizeof(ItclVarLookup));
			vlookup->usage = 0;

		    setResVar:

			vlookup->ivPtr = ivPtr;
			vlookup->leastQualName = 
			    Tcl_GetHashKey(&iclsPtr->resolveVars, hPtr);

			/*
			 *  If this variable is PRIVATE to another class scope,
			 *  then mark it as "inaccessible".
			 */
			vlookup->accessible = (ivPtr->protection != ITCL_PRIVATE ||
				ivPtr->iclsPtr == iclsPtr);

			/*
			 *  If this is a reference to the built-in "this"
			 *  variable, then its index is "0".  Otherwise,
			 *  add another slot to the end of the table.
			 */
			if ((ivPtr->flags & ITCL_THIS_VAR) != 0) {
			    vlookup->varNum = 0;
			} else {
			    if ((ivPtr->flags & ITCL_OPTIONS_VAR) != 0) {
				vlookup->varNum = 1;
			    } else {
				vlookup->varNum = iclsPtr->numInstanceVars++;
			    }
			}
		    }

		    Tcl_SetHashValue(hPtr, (ClientData)vlookup);
		    vlookup->usage++;
		}

                if (nsPtr == NULL) {
                    break;
                }
                Tcl_DStringSetLength(bufferC, 0);


                Tcl_DStringAppend(bufferC, nsPtr->name, -1);
                Tcl_DStringAppend(bufferC, "::", -1);
                Tcl_DStringAppend(bufferC, varName, -1);
                varName = Tcl_DStringValue(bufferC);
                bufferC = (bufferC == &buffer) ? &buffer2 : &buffer;

                nsPtr = nsPtr->parentPtr;
            }







	    hPtr = Tcl_NextHashEntry(&place);
	}
        iclsPtr2 = Itcl_AdvanceHierIter(&hier);
    }
    Itcl_DeleteHierIter(&hier);

    /*
     *  Clear the command resolution table.
     */