Itcl - the [incr Tcl] extension

Check-in [d46639da5b]
Login
Core Home Timeline Branches Tags Tickets Wiki

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

Overview
Comment:move bypass-logic of internal dicts into and simplify Itcl_ParseVarResolver
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | sebres-on-dmnd-resolver-perf-branch
Files: files | file ages | folders
SHA3-256: d46639da5bd26deb4441439e50186cc22cc097f808d4c18e0f38b7784b18ddce
User & Date: sebres 2019-04-17 20:45:19.959
Context
2019-04-17
20:46
add performance test-suite check-in: b8ab55a29e user: sebres tags: sebres-on-dmnd-resolver-perf-branch
20:45
move bypass-logic of internal dicts into and simplify Itcl_ParseVarResolver check-in: d46639da5b user: sebres tags: sebres-on-dmnd-resolver-perf-branch
20:44
some clean-ups / review check-in: 7b37e1c98b user: sebres tags: sebres-on-dmnd-resolver-perf-branch
Changes
Unified Diff Ignore Whitespace Patch
Changes to generic/itclBase.c.
︙︙
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239


    nsPtr = Tcl_CreateNamespace(interp, ITCL_NAMESPACE, infoPtr, FreeItclObjectInfo);
    if (nsPtr == NULL) {
	ckfree(infoPtr);
        Tcl_Panic("Itcl: cannot create namespace: \"%s\" \n", ITCL_NAMESPACE);
    }

    nsPtr = Tcl_CreateNamespace(interp, ITCL_NAMESPACE"::internal::dicts",
            NULL, NULL);
    if (nsPtr == NULL) {
	ckfree(infoPtr);
        Tcl_Panic("Itcl: cannot create namespace: \"%s::internal::dicts\" \n",
	        ITCL_NAMESPACE);
    }









|








225
226
227
228
229
230
231
232
233
234
235
236
237
238
239


    nsPtr = Tcl_CreateNamespace(interp, ITCL_NAMESPACE, infoPtr, FreeItclObjectInfo);
    if (nsPtr == NULL) {
	ckfree(infoPtr);
        Tcl_Panic("Itcl: cannot create namespace: \"%s\" \n", ITCL_NAMESPACE);
    }

    nsPtr = Tcl_CreateNamespace(interp, ITCL_INTDICTS_NAMESPACE,
            NULL, NULL);
    if (nsPtr == NULL) {
	ckfree(infoPtr);
        Tcl_Panic("Itcl: cannot create namespace: \"%s::internal::dicts\" \n",
	        ITCL_NAMESPACE);
    }
︙︙
Changes to generic/itclClass.c.
︙︙
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739

    ItclClass* iclsPtr2;
    ItclVarLookup *vlookup;
    ItclVariable *ivPtr;
    Tcl_Namespace* nsPtr;
    Tcl_Obj *vnObjPtr;
    int newEntry, processAncestors;
    size_t varLen;

    /* simple speedup: avoid lookup for ::itcl::internal's - not resolvable in a class */
    if (strncmp(lookupName, ITCL_NAMESPACE, sizeof(ITCL_NAMESPACE)-1) == 0) {
	return NULL;
    }
    
    /* (de)qualify to simple name */
    varName = simpleName = lookupName;
    while(*varName) {
        if (*varName++ == ':') {
            if (*varName++ == ':') { simpleName = varName; }
        };
    }








|
<
<
<
<
<








1720
1721
1722
1723
1724
1725
1726
1727





1728
1729
1730
1731
1732
1733
1734

    ItclClass* iclsPtr2;
    ItclVarLookup *vlookup;
    ItclVariable *ivPtr;
    Tcl_Namespace* nsPtr;
    Tcl_Obj *vnObjPtr;
    int newEntry, processAncestors;
    size_t varLen;
  





    /* (de)qualify to simple name */
    varName = simpleName = lookupName;
    while(*varName) {
        if (*varName++ == ':') {
            if (*varName++ == ':') { simpleName = varName; }
        };
    }
︙︙
Changes to generic/itclInt.h.
︙︙
82
83
84
85
86
87
88


89
90
91
92
93
94
95
96
97


/*
 * What sort of size of things we like to allocate.
 */

#define ALLOC_CHUNK 8



#define ITCL_VARIABLES_NAMESPACE "::itcl::internal::variables"
#define ITCL_COMMANDS_NAMESPACE "::itcl::internal::commands"

#ifdef ITCL_PRESERVE_DEBUG
#define ITCL_PRESERVE_BUCKET_SIZE 50
#define ITCL_PRESERVE_INCR 1
#define ITCL_PRESERVE_DECR -1
#define ITCL_PRESERVE_DELETED 0









>
>
|
|








82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99


/*
 * What sort of size of things we like to allocate.
 */

#define ALLOC_CHUNK 8

#define ITCL_INT_NAMESPACE	    ITCL_NAMESPACE"::internal"
#define ITCL_INTDICTS_NAMESPACE	    ITCL_INT_NAMESPACE"::dicts"
#define ITCL_VARIABLES_NAMESPACE    ITCL_INT_NAMESPACE"::variables"
#define ITCL_COMMANDS_NAMESPACE	    ITCL_INT_NAMESPACE"::commands"

#ifdef ITCL_PRESERVE_DEBUG
#define ITCL_PRESERVE_BUCKET_SIZE 50
#define ITCL_PRESERVE_INCR 1
#define ITCL_PRESERVE_DECR -1
#define ITCL_PRESERVE_DELETED 0
︙︙
Changes to generic/itclResolve.c.
︙︙
645
646
647
648
649
650
651
652





653
654
655
656
657
658



659
660
661


662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692

    Tcl_Var* rPtr)             /* returns: Tcl_Var for desired variable */
{
    ItclObjectInfo *infoPtr = (ItclObjectInfo*)contextNs->clientData;
    ItclClass *iclsPtr = (ItclClass*)Itcl_PeekStack(&infoPtr->clsStack);

    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, "\": ",
                    Itcl_ProtectionStr(vlookup->ivPtr->protection),
                    " variable",
                    (char*)NULL);
                return TCL_ERROR;
            }
	    hPtr = Tcl_FindHashEntry(&vlookup->ivPtr->iclsPtr->classCommons,
	        (char *)vlookup->ivPtr);
	    if (hPtr != NULL) {
                *rPtr = Tcl_GetHashValue(hPtr);
                return TCL_OK;
	    }
        }
    }

    /*
     *  If the variable is not recognized, return TCL_CONTINUE and
     *  let lookup continue via the normal name resolution rules.
     *  This is important for variables like "errorInfo"
     *  that might get set while the parser namespace is active.
     */
    return TCL_CONTINUE;
}



int
ItclSetParserResolver(
    Tcl_Namespace *nsPtr)









>
>
>
>
>





|
>
>
>
|

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








645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682

683
684


685






686
687
688
689
690
691
692
693

    Tcl_Var* rPtr)             /* returns: Tcl_Var for desired variable */
{
    ItclObjectInfo *infoPtr = (ItclObjectInfo*)contextNs->clientData;
    ItclClass *iclsPtr = (ItclClass*)Itcl_PeekStack(&infoPtr->clsStack);

    Tcl_HashEntry *hPtr;
    ItclVarLookup *vlookup;

    /* simple speedup: avoid lookup for ::itcl::internal's - not resolvable in a class */
    if (strncmp(name, ITCL_INTDICTS_NAMESPACE, sizeof(ITCL_INTDICTS_NAMESPACE)-1) == 0) {
	return TCL_CONTINUE;
    }

    /*
     *  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) {
	return TCL_CONTINUE;
    }

    vlookup = (ItclVarLookup*)Tcl_GetHashValue(hPtr);

    if ((vlookup->ivPtr->flags & ITCL_COMMON) == 0) {
	return TCL_CONTINUE;
    }
    if (!vlookup->accessible) {
        Tcl_AppendResult(interp,
            "can't access \"", name, "\": ",
            Itcl_ProtectionStr(vlookup->ivPtr->protection),
            " variable",
            (char*)NULL);
        return TCL_ERROR;
    }
    hPtr = Tcl_FindHashEntry(&vlookup->ivPtr->iclsPtr->classCommons,
        (char *)vlookup->ivPtr);
    if (!hPtr) {

	return TCL_CONTINUE;
    }


    *rPtr = Tcl_GetHashValue(hPtr);






    return TCL_OK;
}



int
ItclSetParserResolver(
    Tcl_Namespace *nsPtr)
︙︙
This page was generated in about 0.018s by Fossil 2.26 [1205ec86cb] 2025-04-30 16:57:32