Itcl - the [incr Tcl] extension

Check-in [c3440a6f46]
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:*interim* try to implement on demand var-resolver virtual table
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | sebres-on-dmnd-resolver-perf-branch
Files: files | file ages | folders
SHA3-256: c3440a6f46827e0827281cbcf04ce64ded059fa4801d6800728164c4b2b4e1cb
User & Date: sebres 2019-04-17 20:42:07
Context
2019-04-17
20:43
**interim** improved, but not ready (tests failed, segfault, rebuild on inheritance, etc) check-in: 904c4d882c user: sebres tags: sebres-on-dmnd-resolver-perf-branch
20:42
*interim* try to implement on demand var-resolver virtual table check-in: c3440a6f46 user: sebres tags: sebres-on-dmnd-resolver-perf-branch
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
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/itclBuiltin.c.

639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
...
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
...
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
...
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
                    "improper usage: should be ",
                    "\"object configure ?-option? ?value -option value...?\"",
                    (char*)NULL);
                return TCL_ERROR;
            }

            vlookup = NULL;
            hPtr = Tcl_FindHashEntry(&contextIclsPtr->resolveVars, token+1);
            if (hPtr) {
                vlookup = (ItclVarLookup*)Tcl_GetHashValue(hPtr);

                if (vlookup->ivPtr->protection != ITCL_PUBLIC) {
                    vlookup = NULL;
                }
            }
................................................................................
	    Tcl_AppendResult(interp, "need option value pair", NULL);
	    result = TCL_ERROR;
            goto configureDone;
	}
        vlookup = NULL;
        token = Tcl_GetString(unparsedObjv[i]);
        if (*token == '-') {
            hPtr = Tcl_FindHashEntry(&contextIclsPtr->resolveVars, token+1);
            if (hPtr == NULL) {
                hPtr = Tcl_FindHashEntry(&contextIclsPtr->resolveVars, token);
	    }
            if (hPtr) {
                vlookup = (ItclVarLookup*)Tcl_GetHashValue(hPtr);
            }
        }

        if (!vlookup || (vlookup->ivPtr->protection != ITCL_PUBLIC)) {
................................................................................
        if (result != TCL_CONTINUE) {
            return result;
        }
    }
    name = Tcl_GetString(objv[1]);

    vlookup = NULL;
    hPtr = Tcl_FindHashEntry(&contextIclsPtr->resolveVars, name+1);
    if (hPtr) {
        vlookup = (ItclVarLookup*)Tcl_GetHashValue(hPtr);
    }

    if ((vlookup == NULL) || (vlookup->ivPtr->protection != ITCL_PUBLIC)) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "unknown option \"", name, "\"",
................................................................................
     *  data table, then use the simple name.  Otherwise, this
     *  is a shadowed variable; use the full name.
     */
    Tcl_DStringInit(&optName);
    Tcl_DStringAppend(&optName, "-", -1);

    iclsPtr = (ItclClass*)contextIoPtr->iclsPtr;
    hPtr = Tcl_FindHashEntry(&iclsPtr->resolveVars,
            Tcl_GetString(ivPtr->fullNamePtr));
    assert(hPtr != NULL);
    vlookup = (ItclVarLookup*)Tcl_GetHashValue(hPtr);
    Tcl_DStringAppend(&optName, vlookup->leastQualName, -1);

    objPtr = Tcl_NewStringObj(Tcl_DStringValue(&optName), -1);
    Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr, objPtr);






|







 







|

|







 







|







 







|







639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
...
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
...
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
...
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
                    "improper usage: should be ",
                    "\"object configure ?-option? ?value -option value...?\"",
                    (char*)NULL);
                return TCL_ERROR;
            }

            vlookup = NULL;
            hPtr = ItclResolveVarEntry(contextIclsPtr, token+1);
            if (hPtr) {
                vlookup = (ItclVarLookup*)Tcl_GetHashValue(hPtr);

                if (vlookup->ivPtr->protection != ITCL_PUBLIC) {
                    vlookup = NULL;
                }
            }
................................................................................
	    Tcl_AppendResult(interp, "need option value pair", NULL);
	    result = TCL_ERROR;
            goto configureDone;
	}
        vlookup = NULL;
        token = Tcl_GetString(unparsedObjv[i]);
        if (*token == '-') {
            hPtr = ItclResolveVarEntry(contextIclsPtr, token+1);
            if (hPtr == NULL) {
                hPtr = ItclResolveVarEntry(contextIclsPtr, token);
	    }
            if (hPtr) {
                vlookup = (ItclVarLookup*)Tcl_GetHashValue(hPtr);
            }
        }

        if (!vlookup || (vlookup->ivPtr->protection != ITCL_PUBLIC)) {
................................................................................
        if (result != TCL_CONTINUE) {
            return result;
        }
    }
    name = Tcl_GetString(objv[1]);

    vlookup = NULL;
    hPtr = ItclResolveVarEntry(contextIclsPtr, name+1);
    if (hPtr) {
        vlookup = (ItclVarLookup*)Tcl_GetHashValue(hPtr);
    }

    if ((vlookup == NULL) || (vlookup->ivPtr->protection != ITCL_PUBLIC)) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "unknown option \"", name, "\"",
................................................................................
     *  data table, then use the simple name.  Otherwise, this
     *  is a shadowed variable; use the full name.
     */
    Tcl_DStringInit(&optName);
    Tcl_DStringAppend(&optName, "-", -1);

    iclsPtr = (ItclClass*)contextIoPtr->iclsPtr;
    hPtr = ItclResolveVarEntry(iclsPtr,
            Tcl_GetString(ivPtr->fullNamePtr));
    assert(hPtr != NULL);
    vlookup = (ItclVarLookup*)Tcl_GetHashValue(hPtr);
    Tcl_DStringAppend(&optName, vlookup->leastQualName, -1);

    objPtr = Tcl_NewStringObj(Tcl_DStringValue(&optName), -1);
    Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr, objPtr);

Changes to generic/itclClass.c.

1682
1683
1684
1685
1686
1687
1688











































































































































































































1689
1690
1691
1692
1693
1694
1695
....
1727
1728
1729
1730
1731
1732
1733

1734
1735
1736
1737
1738
1739
1740
....
1868
1869
1870
1871
1872
1873
1874

1875
1876
1877
1878
1879
1880
1881
    Tcl_NRAddCallback(interp, FinalizeCreateObject, objNamePtr, iclsPtr,
            NULL, NULL);
    Tcl_NRAddCallback(interp, CallCreateObject, objNamePtr, iclsPtr,
            INT2PTR(objc-4), newObjv);
    return Itcl_NRRunCallbacks(interp, callbackPtr);
}












































































































































































































 
/*
 * ------------------------------------------------------------------------
 *  Itcl_BuildVirtualTables()
 *
 *  Invoked whenever the class heritage changes or members are added or
 *  removed from a class definition to rebuild the member lookup
................................................................................
    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.
     */
................................................................................
                nsPtr = nsPtr->parentPtr;
            }
	    hPtr = Tcl_NextHashEntry(&place);
	}
        iclsPtr2 = Itcl_AdvanceHierIter(&hier);
    }
    Itcl_DeleteHierIter(&hier);


    /*
     *  Clear the command resolution table.
     */
    while (1) {
        hPtr = Tcl_FirstHashEntry(&iclsPtr->resolveCmds, &place);
        if (hPtr == NULL) {






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>







 







>







1682
1683
1684
1685
1686
1687
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
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
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
....
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
....
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
    Tcl_NRAddCallback(interp, FinalizeCreateObject, objNamePtr, iclsPtr,
            NULL, NULL);
    Tcl_NRAddCallback(interp, CallCreateObject, objNamePtr, iclsPtr,
            INT2PTR(objc-4), newObjv);
    return Itcl_NRRunCallbacks(interp, callbackPtr);
}

 
/*
 * ------------------------------------------------------------------------
 *  ItclResolveVarEntry()
 *
 *  Side effect: (re)build part of resolver hash-table on demand.
 * ------------------------------------------------------------------------
 */
Tcl_HashEntry *
ItclResolveVarEntry(
    ItclClass* iclsPtr,       /* class definition where to resolve variable */
    const char *lookupName)      /* name of variable being resolved */
{
#if 0
    return Tcl_FindHashEntry(&iclsPtr->resolveVars, lookupName);
#else
    Tcl_HashEntry *reshPtr, *hPtr;

    /* could be resolved directly */
    if ((reshPtr = Tcl_FindHashEntry(&iclsPtr->resolveVars, lookupName)) != NULL) {
	return reshPtr;
    } else {

    /* try to build virtual table for this var */
    const char *varName, *simpleName;
    Tcl_DString buffer, buffer2, *bufferC;
    ItclHierIter hier;
    ItclClass* iclsPtr2;
    ItclVarLookup *vlookup;
    ItclVariable *ivPtr;
    int processAncestors;
    
    /* (de)qualify to simple name */
    varName = lookupName;
    while(*varName) {
        if (*varName++ == ':' && *varName++ == ':')
	    simpleName = varName;
	    continue;
        };
        varName++;
    }
    simpleName = varName;
    
    processAncestors = simpleName != lookupName;
    
    Tcl_DStringInit(&buffer);
    Tcl_DStringInit(&buffer2);

    /*
     *  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_FindHashEntry(&iclsPtr2->variables, varName);
	if (hPtr) {
	    Tcl_Namespace* nsPtr;
	    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 = simpleName;
            bufferC = &buffer;
            nsPtr = iclsPtr2->nsPtr;

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

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

			/*
			 *  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++;
			}
			/*
			 *  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);

	/* Stop create vars for ancestors (if already processed once) */
	if (iclsPtr2 != iclsPtr && !processAncestors) {
	    if (simpleName == lookupName) {
		/* simple name */
		return reshPtr;
	    }
	    break;
	}
    }
    Itcl_DeleteHierIter(&hier);


	Tcl_DStringFree(&buffer);
	Tcl_DStringFree(&buffer2);
    }

    hPtr = Tcl_FindHashEntry(&iclsPtr->resolveVars, lookupName);
    return hPtr;
#endif
}
 
/*
 * ------------------------------------------------------------------------
 *  Itcl_BuildVirtualTables()
 *
 *  Invoked whenever the class heritage changes or members are added or
 *  removed from a class definition to rebuild the member lookup
................................................................................
    ItclClass *iclsPtr2;
    ItclCmdLookup *clookupPtr;
    int newEntry, processAncestors = 0;

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

#if 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.
     */
................................................................................
                nsPtr = nsPtr->parentPtr;
            }
	    hPtr = Tcl_NextHashEntry(&place);
	}
        iclsPtr2 = Itcl_AdvanceHierIter(&hier);
    }
    Itcl_DeleteHierIter(&hier);
#endif

    /*
     *  Clear the command resolution table.
     */
    while (1) {
        hPtr = Tcl_FirstHashEntry(&iclsPtr->resolveCmds, &place);
        if (hPtr == NULL) {

Changes to generic/itclCmd.c.

744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
    hPtr = Tcl_FindHashEntry(&infoPtr->namespaceClasses, (char *)contextNsPtr);
    if (hPtr != NULL) {
        contextIclsPtr = (ItclClass *)Tcl_GetHashValue(hPtr);
    }
    if (Itcl_IsClassNamespace(contextNsPtr)) {
	ClientData clientData;

        entry = Tcl_FindHashEntry(&contextIclsPtr->resolveVars, token);
        if (!entry) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "variable \"", token, "\" not found in class \"",
                Tcl_GetString(contextIclsPtr->fullNamePtr), "\"",
                (char*)NULL);
            result = TCL_ERROR;
            goto scopeCmdDone;






|







744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
    hPtr = Tcl_FindHashEntry(&infoPtr->namespaceClasses, (char *)contextNsPtr);
    if (hPtr != NULL) {
        contextIclsPtr = (ItclClass *)Tcl_GetHashValue(hPtr);
    }
    if (Itcl_IsClassNamespace(contextNsPtr)) {
	ClientData clientData;

        entry = ItclResolveVarEntry(contextIclsPtr, token);
        if (!entry) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "variable \"", token, "\" not found in class \"",
                Tcl_GetString(contextIclsPtr->fullNamePtr), "\"",
                (char*)NULL);
            result = TCL_ERROR;
            goto scopeCmdDone;

Changes to generic/itclInfo.c.

1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
....
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
        objc--; objv++;
    }

    /*
     *  Return info for a specific variable.
     */
    if (varName) {
        entry = Tcl_FindHashEntry(&contextIclsPtr->resolveVars, varName);
        if (entry == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "\"", varName, "\" isn't a variable in class \"",
                contextIclsPtr->nsPtr->fullName, "\"",
                (char*)NULL);
            return TCL_ERROR;
        }
................................................................................
        objc--; objv++;
    }

    /*
     *  Return info for a specific variable.
     */
    if (varName) {
        hPtr = Tcl_FindHashEntry(&contextIclsPtr->resolveVars, varName);
        if (hPtr == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "\"", varName, "\" isn't a typevariable in class \"",
                contextIclsPtr->nsPtr->fullName, "\"",
                (char*)NULL);
            return TCL_ERROR;
        }






|







 







|







1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
....
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
        objc--; objv++;
    }

    /*
     *  Return info for a specific variable.
     */
    if (varName) {
        entry = ItclResolveVarEntry(contextIclsPtr, varName);
        if (entry == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "\"", varName, "\" isn't a variable in class \"",
                contextIclsPtr->nsPtr->fullName, "\"",
                (char*)NULL);
            return TCL_ERROR;
        }
................................................................................
        objc--; objv++;
    }

    /*
     *  Return info for a specific variable.
     */
    if (varName) {
        hPtr = ItclResolveVarEntry(contextIclsPtr, varName);
        if (hPtr == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "\"", varName, "\" isn't a typevariable in class \"",
                contextIclsPtr->nsPtr->fullName, "\"",
                (char*)NULL);
            return TCL_ERROR;
        }

Changes to generic/itclInt.h.

729
730
731
732
733
734
735



736
737
738
739
740
741
742
MODULE_SCOPE int ItclCreateObject (Tcl_Interp *interp, const char* name,
        ItclClass *iclsPtr, int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE void ItclDeleteObjectVariablesNamespace(Tcl_Interp *interp,
        ItclObject *ioPtr);
MODULE_SCOPE void ItclDeleteClassVariablesNamespace(Tcl_Interp *interp,
        ItclClass *iclsPtr);
MODULE_SCOPE int ItclInfoInit(Tcl_Interp *interp, ItclObjectInfo *infoPtr);




struct Tcl_ResolvedVarInfo;
MODULE_SCOPE int Itcl_ClassCmdResolver(Tcl_Interp *interp, const char* name,
	Tcl_Namespace *nsPtr, int flags, Tcl_Command *rPtr);
MODULE_SCOPE int Itcl_ClassVarResolver(Tcl_Interp *interp, const char* name,
        Tcl_Namespace *nsPtr, int flags, Tcl_Var *rPtr);
MODULE_SCOPE int Itcl_ClassCompiledVarResolver(Tcl_Interp *interp,






>
>
>







729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
MODULE_SCOPE int ItclCreateObject (Tcl_Interp *interp, const char* name,
        ItclClass *iclsPtr, int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE void ItclDeleteObjectVariablesNamespace(Tcl_Interp *interp,
        ItclObject *ioPtr);
MODULE_SCOPE void ItclDeleteClassVariablesNamespace(Tcl_Interp *interp,
        ItclClass *iclsPtr);
MODULE_SCOPE int ItclInfoInit(Tcl_Interp *interp, ItclObjectInfo *infoPtr);

MODULE_SCOPE Tcl_HashEntry *ItclResolveVarEntry(
	ItclClass* iclsPtr, const char *varName);

struct Tcl_ResolvedVarInfo;
MODULE_SCOPE int Itcl_ClassCmdResolver(Tcl_Interp *interp, const char* name,
	Tcl_Namespace *nsPtr, int flags, Tcl_Command *rPtr);
MODULE_SCOPE int Itcl_ClassVarResolver(Tcl_Interp *interp, const char* name,
        Tcl_Namespace *nsPtr, int flags, Tcl_Var *rPtr);
MODULE_SCOPE int Itcl_ClassCompiledVarResolver(Tcl_Interp *interp,

Changes to generic/itclMethod.c.

271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
....
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
    /*
     *  Find the variable and change its implementation.
     *  Note that variable resolution table has *all* variables,
     *  even those in a base class.  Make sure that the class
     *  containing the variable definition is the requested class.
     */
    vlookup = NULL;
    entry = Tcl_FindHashEntry(&iclsPtr->resolveVars, tail);
    if (entry) {
        vlookup = (ItclVarLookup*)Tcl_GetHashValue(entry);
        if (vlookup->ivPtr->iclsPtr != iclsPtr) {
            vlookup = NULL;
        }
    }

................................................................................
        iclsPtr = resolveInfoPtr->iclsPtr;
    }
    infoPtr = iclsPtr->infoPtr;
    hPtr = Tcl_FindHashEntry(&infoPtr->namespaceClasses, (char *)nsPtr);
    if (hPtr != NULL) {
        iclsPtr = Tcl_GetHashValue(hPtr);
    }
    hPtr = Tcl_FindHashEntry(&iclsPtr->resolveVars, varName);
    if (hPtr == NULL) {
	/* no class/object variable */
        return NULL;
    }
    ivlPtr = Tcl_GetHashValue(hPtr);
    if (ivlPtr == NULL) {
        return NULL;






|







 







|







271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
....
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
    /*
     *  Find the variable and change its implementation.
     *  Note that variable resolution table has *all* variables,
     *  even those in a base class.  Make sure that the class
     *  containing the variable definition is the requested class.
     */
    vlookup = NULL;
    entry = ItclResolveVarEntry(iclsPtr, tail);
    if (entry) {
        vlookup = (ItclVarLookup*)Tcl_GetHashValue(entry);
        if (vlookup->ivPtr->iclsPtr != iclsPtr) {
            vlookup = NULL;
        }
    }

................................................................................
        iclsPtr = resolveInfoPtr->iclsPtr;
    }
    infoPtr = iclsPtr->infoPtr;
    hPtr = Tcl_FindHashEntry(&infoPtr->namespaceClasses, (char *)nsPtr);
    if (hPtr != NULL) {
        iclsPtr = Tcl_GetHashValue(hPtr);
    }
    hPtr = ItclResolveVarEntry(iclsPtr, varName);
    if (hPtr == NULL) {
	/* no class/object variable */
        return NULL;
    }
    ivlPtr = Tcl_GetHashValue(hPtr);
    if (ivlPtr == NULL) {
        return NULL;

Changes to generic/itclObject.c.

1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
....
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
....
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
    /* get the variable definition to check if that is an ITCL_COMMON */
    if (contextIclsPtr == NULL) {
        iclsPtr = contextIoPtr->iclsPtr;
    } else {
        iclsPtr = contextIclsPtr;
    }
    ivPtr = NULL;
    hPtr = Tcl_FindHashEntry(&iclsPtr->resolveVars, (char *)name1);
    if (hPtr != NULL) {
        vlookup = Tcl_GetHashValue(hPtr);
        ivPtr = vlookup->ivPtr;
    /*
     *  Install the object context and access the data member
     *  like any other variable.
     */
................................................................................
    }
    /* get the variable definition to check if that is an ITCL_COMMON */
    if (contextIclsPtr == NULL) {
        iclsPtr = contextIoPtr->iclsPtr;
    } else {
        iclsPtr = contextIclsPtr;
    }
    hPtr = Tcl_FindHashEntry(&iclsPtr->resolveVars, (char *)name1);
    if (hPtr != NULL) {
        vlookup = Tcl_GetHashValue(hPtr);
        ivPtr = vlookup->ivPtr;
    } else {
        return NULL;
    }
    /*
................................................................................
    Tcl_HashEntry *hPtr;
    Tcl_Obj *objPtr;
    Tcl_DString buffer;
    ItclVarLookup *vlookup;
    ItclVariable *ivPtr;
    const char *val;

    hPtr = Tcl_FindHashEntry(&iclsPtr->resolveVars, (char *)varName);
    if (hPtr == NULL) {
	/* no such variable */
        return NULL;
    }
    vlookup = (ItclVarLookup *)Tcl_GetHashValue(hPtr);
    if (vlookup == NULL) {
        return NULL;






|







 







|







 







|







1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
....
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
....
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
    /* get the variable definition to check if that is an ITCL_COMMON */
    if (contextIclsPtr == NULL) {
        iclsPtr = contextIoPtr->iclsPtr;
    } else {
        iclsPtr = contextIclsPtr;
    }
    ivPtr = NULL;
    hPtr = ItclResolveVarEntry(iclsPtr, (char *)name1);
    if (hPtr != NULL) {
        vlookup = Tcl_GetHashValue(hPtr);
        ivPtr = vlookup->ivPtr;
    /*
     *  Install the object context and access the data member
     *  like any other variable.
     */
................................................................................
    }
    /* get the variable definition to check if that is an ITCL_COMMON */
    if (contextIclsPtr == NULL) {
        iclsPtr = contextIoPtr->iclsPtr;
    } else {
        iclsPtr = contextIclsPtr;
    }
    hPtr = ItclResolveVarEntry(iclsPtr, (char *)name1);
    if (hPtr != NULL) {
        vlookup = Tcl_GetHashValue(hPtr);
        ivPtr = vlookup->ivPtr;
    } else {
        return NULL;
    }
    /*
................................................................................
    Tcl_HashEntry *hPtr;
    Tcl_Obj *objPtr;
    Tcl_DString buffer;
    ItclVarLookup *vlookup;
    ItclVariable *ivPtr;
    const char *val;

    hPtr = ItclResolveVarEntry(iclsPtr, (char *)varName);
    if (hPtr == NULL) {
	/* no such variable */
        return NULL;
    }
    vlookup = (ItclVarLookup *)Tcl_GetHashValue(hPtr);
    if (vlookup == NULL) {
        return NULL;

Changes to generic/itclResolve.c.

272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
...
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
...
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
        return TCL_CONTINUE;
    }
    iclsPtr = Tcl_GetHashValue(hPtr);

    /*
     *  See if the variable is a known data member and accessible.
     */
    hPtr = Tcl_FindHashEntry(&iclsPtr->resolveVars, name);
    if (hPtr == NULL) {
        return TCL_CONTINUE;
    }

    vlookup = (ItclVarLookup*)Tcl_GetHashValue(hPtr);
    if (!vlookup->accessible) {
        return TCL_CONTINUE;
................................................................................
        buffer = storage;
    } else {
        buffer = (char*)ckalloc((unsigned)(length+1));
    }
    memcpy((void*)buffer, (void*)name, (size_t)length);
    buffer[length] = '\0';

    hPtr = Tcl_FindHashEntry(&iclsPtr->resolveVars, buffer);

    if (buffer != storage) {
        ckfree(buffer);
    }

    /*
     *  If the name is not found, or if it is inaccessible,
................................................................................
    Tcl_HashEntry *hPtr;
    ItclVarLookup *vlookup;

    /*
     *  See if the requested variable is a recognized "common" member.
     *  If it is, make sure that access is allowed.
     */
    hPtr = Tcl_FindHashEntry(&iclsPtr->resolveVars, name);
    if (hPtr) {
        vlookup = (ItclVarLookup*)Tcl_GetHashValue(hPtr);

        if ((vlookup->ivPtr->flags & ITCL_COMMON) != 0) {
            if (!vlookup->accessible) {
                Tcl_AppendResult(interp,
                    "can't access \"", name, "\": ",






|







 







|







 







|







272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
...
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
...
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
        return TCL_CONTINUE;
    }
    iclsPtr = Tcl_GetHashValue(hPtr);

    /*
     *  See if the variable is a known data member and accessible.
     */
    hPtr = ItclResolveVarEntry(iclsPtr, name);
    if (hPtr == NULL) {
        return TCL_CONTINUE;
    }

    vlookup = (ItclVarLookup*)Tcl_GetHashValue(hPtr);
    if (!vlookup->accessible) {
        return TCL_CONTINUE;
................................................................................
        buffer = storage;
    } else {
        buffer = (char*)ckalloc((unsigned)(length+1));
    }
    memcpy((void*)buffer, (void*)name, (size_t)length);
    buffer[length] = '\0';

    hPtr = ItclResolveVarEntry(iclsPtr, buffer);

    if (buffer != storage) {
        ckfree(buffer);
    }

    /*
     *  If the name is not found, or if it is inaccessible,
................................................................................
    Tcl_HashEntry *hPtr;
    ItclVarLookup *vlookup;

    /*
     *  See if the requested variable is a recognized "common" member.
     *  If it is, make sure that access is allowed.
     */
    hPtr = ItclResolveVarEntry(iclsPtr, name);
    if (hPtr) {
        vlookup = (ItclVarLookup*)Tcl_GetHashValue(hPtr);

        if ((vlookup->ivPtr->flags & ITCL_COMMON) != 0) {
            if (!vlookup->accessible) {
                Tcl_AppendResult(interp,
                    "can't access \"", name, "\": ",