Itcl - the [incr Tcl] extension

\fBTcl_Free\fR, \fBTcl_Preserve\fR, \fBTcl_Release\fR, and
\fBTcl_EventuallyFree\fR. The Tcl routines suffer from issues with
performance scaling as the number of blocks managed grows large. The facilities
of Itcl encounter these performance scaling issues and require an
alternative that does not suffer from them.
.PP
\fBItcl_Alloc\fR returns an untyped pointer to an allocated block
of memory of at least \fIsize\fR bytes. All \fIsize\fR bytes are
initialized to zero.
.PP
A module calls \fBItcl_PreserveData\fR on a pointer \fIptr\fR 
allocated by \fBItcl_Alloc\fR to prevent deallocation of that memory while
the module remains interested in it.
.PP
A module calls \fBItcl_ReleaseData\fR on a pointer \fIptr\fR previously
preserved by \fBItcl_PreserveData\fR to indicate the module no longer has

and procs.  If \fIcmdName\fR is specified, it returns information
for a specific method or proc.  If no flags are specified, this
command returns a list with the following elements:  the protection
level, the type (method/proc), the qualified name, the argument list
and the body.  Flags can be used to request specific elements from
this list.
.TP
\fIobjName \fBinfo variable\fR ?\fIvarName\fR? ?\fB-protection\fR? ?\fB-type\fR? ?\fB-name\fR? ?\fB-init\fR? ?\fB-value\fR? ?\fB-config\fR? ?\fB-scope\fR?
.
With no arguments, this command returns a list of all object-specific
variables and common data members.  If \fIvarName\fR is specified, it
returns information for a specific data member.  
Flags can be specified with \fIvarName\fR in an arbitrary order. 
The result is a list of the specific information in exactly the
same order as the flags are specified.

If no flags are given, this command returns a list 
as if the followings flags have been specified:
.IP
\fB-protection\fR \fB-type\fR \fB-name\fR \fB-init\fR \fB-value\fR ?\fB-config\fR?

The \fB-config\fR result is only present if \fIvarName\fR is a public
variable. It contains the code that is executed at initialization 
of \fIvarName\fR. The \fB-scope\fR flag gives the namespace context
of \fIvarName\fR. Herewith the variable can be accessed from outside 
the object like any other variable. It is similar to the result of 
the \fBitcl::scope\fR command.

.RE
.SH "CHAINING METHODS/PROCS"
.PP
Sometimes a base class has a method or proc that is redefined with
the same name in a derived class.  This is a way of making the
derived class handle the same operations as the base class, but
with its own specialized behavior.  For example, suppose we have

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

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

                    "improper usage: should be ",
                    "\"object configure ?-option? ?value -option value...?\"",
                    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(NULL, listPtr, objPtr);

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

     */
    if (iclsPtr->flags & ITCL_TYPE) {
        namePtr = Tcl_NewStringObj("type", -1);
        (void) Itcl_CreateVariable(interp, iclsPtr, namePtr, NULL,
            NULL, &ivPtr);
        ivPtr->protection = ITCL_PROTECTED;  /* always "protected" */
        ivPtr->flags |= ITCL_TYPE_VAR;       /* mark as "type" variable */



    }

    if (iclsPtr->flags & (ITCL_ECLASS)) {
        namePtr = Tcl_NewStringObj("win", -1);
        (void) Itcl_CreateVariable(interp, iclsPtr, namePtr, NULL,
            NULL, &ivPtr);
        ivPtr->protection = ITCL_PROTECTED;  /* always "protected" */
        ivPtr->flags |= ITCL_WIN_VAR;        /* mark as "win" variable */



    }
    if (iclsPtr->flags & (ITCL_TYPE|ITCL_WIDGET|ITCL_WIDGETADAPTOR)) {
        namePtr = Tcl_NewStringObj("self", -1);
        (void) Itcl_CreateVariable(interp, iclsPtr, namePtr, NULL,
            NULL, &ivPtr);
        ivPtr->protection = ITCL_PROTECTED;  /* always "protected" */
        ivPtr->flags |= ITCL_SELF_VAR;       /* mark as "self" variable */




        namePtr = Tcl_NewStringObj("selfns", -1);
        (void) Itcl_CreateVariable(interp, iclsPtr, namePtr, NULL,
            NULL, &ivPtr);
        ivPtr->protection = ITCL_PROTECTED;  /* always "protected" */
        ivPtr->flags |= ITCL_SELFNS_VAR;     /* mark as "selfns" variable */




        namePtr = Tcl_NewStringObj("win", -1);
        (void) Itcl_CreateVariable(interp, iclsPtr, namePtr, NULL,
            NULL, &ivPtr);
        ivPtr->protection = ITCL_PROTECTED;  /* always "protected" */
        ivPtr->flags |= ITCL_WIN_VAR;        /* mark as "win" variable */



    }
    namePtr = Tcl_NewStringObj("this", -1);
    (void) Itcl_CreateVariable(interp, iclsPtr, namePtr, NULL,
            NULL, &ivPtr);

    ivPtr->protection = ITCL_PROTECTED;  /* always "protected" */
    ivPtr->flags |= ITCL_THIS_VAR;       /* mark as "this" variable */





    if (infoPtr->currClassFlags &
            (ITCL_ECLASS|ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET)) {
        /*
         *  Add the built-in "itcl_options" variable to the list of
	 *  data members.
         */
        namePtr = Tcl_NewStringObj("itcl_options", -1);
        (void) Itcl_CreateVariable(interp, iclsPtr, namePtr, NULL,
                NULL, &ivPtr);

        ivPtr->protection = ITCL_PROTECTED;  /* always "protected" */
        ivPtr->flags |= ITCL_OPTIONS_VAR;    /* mark as "itcl_options"
	                                      * variable */





    }
    if (infoPtr->currClassFlags &
            ITCL_ECLASS) {
        /*
         *  Add the built-in "itcl_option_components" variable to the list of
	 *  data members.
         */
        namePtr = Tcl_NewStringObj("itcl_option_components", -1);
        (void) Itcl_CreateVariable(interp, iclsPtr, namePtr, NULL,
                NULL, &ivPtr);

        ivPtr->protection = ITCL_PROTECTED;  /* always "protected" */
        ivPtr->flags |= ITCL_OPTION_COMP_VAR; /* mark as "itcl_option_components"
	                                      * variable */





    }
    if (infoPtr->currClassFlags & (ITCL_WIDGET|ITCL_WIDGETADAPTOR)) {
        /*
         *  Add the built-in "thiswin" variable to the list of data members.
         */
        namePtr = Tcl_NewStringObj("thiswin", -1);
        (void) Itcl_CreateVariable(interp, iclsPtr, namePtr, NULL,
                NULL, &ivPtr);

        ivPtr->protection = ITCL_PROTECTED;  /* always "protected" */
        ivPtr->flags |= ITCL_THIS_VAR;       /* mark as "thiswin" variable */




    }
    if (infoPtr->currClassFlags & (ITCL_WIDGET|ITCL_WIDGETADAPTOR)) {
        /* create the itcl_hull component */
        ItclComponent *icPtr;
        namePtr = Tcl_NewStringObj("itcl_hull", 9);
	/* itcl_hull must not be an ITCL_COMMON!! */
        if (ItclCreateComponent(interp, iclsPtr, namePtr, 0, &icPtr) !=

    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 */
{
    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;
	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; }
	    };
	}
	vnObjPtr = Tcl_NewStringObj(simpleName, -1);
	
	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, vnObjPtr);
	    if (hPtr) {
		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; varLen = -1;
		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 */
			    if (vlookup->ivPtr != ivPtr) {
				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 += 3;
			    }
			    /*
			     *  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, vlookup);
			vlookup->usage++;
		    }

		    /* if we have found it */
		    if (simpleName == lookupName || strcmp(varName, lookupName) == 0) {
			if (!reshPtr) {
			    reshPtr = hPtr;
			}
			break;
		    }
		    if (nsPtr == NULL) {
			break;
		    }
		    Tcl_DStringSetLength(bufferC, 0);
		    Tcl_DStringAppend(bufferC, nsPtr->name, -1);
		    Tcl_DStringAppend(bufferC, "::", 2);
		    Tcl_DStringAppend(bufferC, varName, varLen);
		    varName = Tcl_DStringValue(bufferC);
		    varLen = Tcl_DStringLength(bufferC);
		    bufferC = (bufferC == &buffer) ? &buffer2 : &buffer;

		    nsPtr = nsPtr->parentPtr;
		}

	    }

	    /* Stop create vars for ancestors (if not needed) */
	    if (!processAncestors && reshPtr) {
		/* simple name - don't need to check ancestors */
		break;
	    }

	    iclsPtr2 = Itcl_AdvanceHierIter(&hier);
	}
	Itcl_DeleteHierIter(&hier);

	Tcl_DStringFree(&buffer);
	Tcl_DStringFree(&buffer2);
	Tcl_DecrRefCount(vnObjPtr);

	if (reshPtr == NULL) {
	    reshPtr = Tcl_FindHashEntry(&iclsPtr->resolveVars, lookupName);
	}
	return reshPtr;
    }
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_BuildVirtualTables()
 *
 *  Invoked whenever the class heritage changes or members are added or
 *  removed from a class definition to rebuild the member lookup
 *  tables.  There are two tables:
 *
 *  METHODS:  resolveCmds
 *    Used primarily in Itcl_ClassCmdResolver() to resolve all
 *    command references in a namespace.
 *
 *  DATA MEMBERS:  resolveVars (built on demand, moved to ItclResolveVarEntry)
 *    Used primarily in Itcl_ClassVarResolver() to quickly resolve
 *    variable references in each class scope.
 *
 *  These tables store every possible name for each command/variable
 *  (member, class::member, namesp::class::member, etc.).  Members
 *  in a derived class may shadow members with the same name in a
 *  base class.  In that case, the simple name in the resolution
 *  table will point to the most-specific member.
 * ------------------------------------------------------------------------
 */
void
Itcl_BuildVirtualTables(
    ItclClass* iclsPtr)       /* class definition being updated */
{
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch place;
    Tcl_Namespace* nsPtr;
    Tcl_DString buffer, buffer2, *bufferC, *bufferC2, *bufferSwp;
    Tcl_Obj *objPtr;


    ItclMemberFunc *imPtr;
    ItclDelegatedFunction *idmPtr;
    ItclHierIter hier;
    ItclClass *iclsPtr2;
    ItclCmdLookup *clookupPtr;
    int newEntry;

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

    /*






















































































































     *  Clear the command resolution table.
     */
    while (1) {
        hPtr = Tcl_FirstHashEntry(&iclsPtr->resolveCmds, &place);
        if (hPtr == NULL) {
            break;
        }
        clookupPtr = Tcl_GetHashValue(hPtr);
        ckfree((char *)clookupPtr);
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(&iclsPtr->resolveCmds);
    Tcl_InitObjHashTable(&iclsPtr->resolveCmds);

    /*

             *     class::func
             *     namesp1::class::func
             *     namesp2::namesp1::class::func
             *     ...
             */
            Tcl_DStringSetLength(&buffer, 0);
            Tcl_DStringAppend(&buffer, Tcl_GetString(imPtr->namePtr), -1);
            bufferC = &buffer; bufferC2 = &buffer2;
            nsPtr = iclsPtr2->nsPtr;

            while (1) {
		objPtr = Tcl_NewStringObj(Tcl_DStringValue(bufferC),
				Tcl_DStringLength(bufferC));
                hPtr = Tcl_CreateHashEntry(&iclsPtr->resolveCmds,
                        (char *)objPtr, &newEntry);

                if (newEntry) {
		    clookupPtr = (ItclCmdLookup *)ckalloc(sizeof(ItclCmdLookup));
		    memset(clookupPtr, 0, sizeof(ItclCmdLookup));
		    clookupPtr->imPtr = imPtr;
                    Tcl_SetHashValue(hPtr, clookupPtr);
                } else {
		    Tcl_DecrRefCount(objPtr);
		}

                if (nsPtr == NULL) {
                    break;
                }


                Tcl_DStringSetLength(bufferC2, 0);
                Tcl_DStringAppend(bufferC2, nsPtr->name, -1);
                Tcl_DStringAppend(bufferC2, "::", 2);
                Tcl_DStringAppend(bufferC2, Tcl_DStringValue(bufferC),
				Tcl_DStringLength(bufferC));
                bufferSwp = bufferC; bufferC = bufferC2; bufferC2 = bufferSwp;

                nsPtr = nsPtr->parentPtr;
            }
            hPtr = Tcl_NextHashEntry(&place);
        }
        iclsPtr2 = Itcl_AdvanceHierIter(&hier);
    }

    Itcl_PreserveData(ioptPtr);
    Itcl_EventuallyFree(ioptPtr, (Tcl_FreeProc *) ItclDeleteOption);
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  ItclCreateMethodVariable(), Itcl_CreateMethodVariable()
 *
 *  Creates a new class methdovariable definition.  If this is a public
 *  methodvariable,
 *
 *  Returns TCL_ERROR along with an error message in the specified
 *  interpreter if anything goes wrong.  Otherwise, this returns
 *  TCL_OK and a pointer to the new option definition in "imvPtr".
 * ------------------------------------------------------------------------
 */
int
ItclCreateMethodVariable(
    Tcl_Interp *interp,       /* interpreter managing this transaction */

    ItclVariable *ivPtr,      /* variable reference (from Itcl_CreateVariable) */
    Tcl_Obj* defaultPtr,      /* initial value */
    Tcl_Obj* callbackPtr,     /* code invoked when variable is set */
    ItclMethodVariable** imvPtrPtr)
                              /* returns: new methdovariable definition */
{
    int isNew;
    ItclMethodVariable *imvPtr;
    Tcl_HashEntry *hPtr;

    /*
     *  Add this methodvariable to the options table for the class.
     *  Make sure that the methodvariable name does not already exist.
     */
    hPtr = Tcl_CreateHashEntry(&ivPtr->iclsPtr->methodVariables,
            (char *)ivPtr->namePtr, &isNew);
    if (!isNew) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "methdovariable name \"", Tcl_GetString(ivPtr->namePtr),
	    "\" already defined in class \"",
            Tcl_GetString (ivPtr->iclsPtr->fullNamePtr), "\"",
            NULL);
        return TCL_ERROR;
    }


    /*
     *  If everything looks good, create the option definition.
     */
    imvPtr = (ItclMethodVariable*)ckalloc(sizeof(ItclMethodVariable));
    memset(imvPtr, 0, sizeof(ItclMethodVariable));
    imvPtr->iclsPtr      = ivPtr->iclsPtr;
    imvPtr->protection   = Itcl_Protection(interp, 0);
    imvPtr->namePtr      = ivPtr->namePtr;
    Tcl_IncrRefCount(imvPtr->namePtr);
    imvPtr->fullNamePtr = ivPtr->fullNamePtr;



    Tcl_IncrRefCount(imvPtr->fullNamePtr);
    imvPtr->defaultValuePtr    = defaultPtr;
    if (defaultPtr != NULL) {
        Tcl_IncrRefCount(imvPtr->defaultValuePtr);
    }
    imvPtr->callbackPtr    = callbackPtr;
    if (callbackPtr != NULL) {
        Tcl_IncrRefCount(imvPtr->callbackPtr);
    }

    if (imvPtr->protection == ITCL_DEFAULT_PROTECT) {
        imvPtr->protection = ITCL_PROTECTED;
    }

    Tcl_SetHashValue(hPtr, imvPtr);

    *imvPtrPtr = imvPtr;
    return TCL_OK;
}

/* 
 * TODO: remove this if unused (seems to be internal API only),
 *       now superseded by ItclCreateMethodVariable.
 */
int
Itcl_CreateMethodVariable(
    Tcl_Interp *interp,       /* interpreter managing this transaction */
    ItclClass* iclsPtr,       /* class containing this variable */
    Tcl_Obj* namePtr,         /* variable name */
    Tcl_Obj* defaultPtr,      /* initial value */
    Tcl_Obj* callbackPtr,     /* code invoked when variable is set */
    ItclMethodVariable** imvPtrPtr)
                              /* returns: new methdovariable definition */
{
    ItclVariable *ivPtr;
    Tcl_HashEntry *hPtr;

    /*
     *  Search variable reference (ivPtr).
     */
    hPtr = Tcl_FindHashEntry(&iclsPtr->variables, (char *)namePtr);
    if (!hPtr || !(ivPtr = (ItclVariable*)Tcl_GetHashValue(hPtr))) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "variable name \"", Tcl_GetString(namePtr),
	    "\" is not declared in class \"",
            Tcl_GetString (iclsPtr->fullNamePtr), "\"",
            NULL);
        return TCL_ERROR;
    }

    /*
     *  Create method variable.
     */
    return ItclCreateMethodVariable(interp, ivPtr, defaultPtr, callbackPtr,
		imvPtrPtr);
}


/*
 * ------------------------------------------------------------------------
 *  Itcl_GetCommonVar()
 *
 *  Returns the current value for a common class variable.  The member

    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), "\"",
                NULL);
            result = TCL_ERROR;
            goto scopeCmdDone;

    const char *cp;
    int haveFlags;
    int newValue1;

    keyPtr = iclsPtr->fullNamePtr;
    dictPtr = Tcl_GetVar2Ex(interp,
             ITCL_NAMESPACE"::internal::dicts::classVariables",
	     NULL, TCL_GLOBAL_ONLY);
    if (dictPtr == NULL) {
        Tcl_AppendResult(interp, "cannot get dict ", ITCL_NAMESPACE,
	        "::internal::dicts::classVariables", NULL);
	return TCL_ERROR;
    }
    if (Tcl_DictObjGet(interp, dictPtr, keyPtr, &valuePtr1) != TCL_OK) {
        return TCL_ERROR;

        keyPtr = iclsPtr->fullNamePtr;
        if (Tcl_DictObjPut(interp, dictPtr, keyPtr, valuePtr1) != TCL_OK) {
            return TCL_ERROR;
        }
    }
    Tcl_SetVar2Ex(interp,
            ITCL_NAMESPACE"::internal::dicts::classVariables",
            NULL, dictPtr, TCL_GLOBAL_ONLY);
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  ItclAddClassFunctionDictInfo()
 * ------------------------------------------------------------------------

    Tcl_Obj *listPtr;
    const char *cp;
    int haveFlags;
    int newValue1;

    dictPtr = Tcl_GetVar2Ex(interp,
             ITCL_NAMESPACE"::internal::dicts::classFunctions",
	     NULL, TCL_GLOBAL_ONLY);
    if (dictPtr == NULL) {
        Tcl_AppendResult(interp, "cannot get dict ", ITCL_NAMESPACE,
	        "::internal::dicts::classFunctions", NULL);
	return TCL_ERROR;
    }
    keyPtr = iclsPtr->fullNamePtr;
    if (Tcl_DictObjGet(interp, dictPtr, keyPtr, &valuePtr1) != TCL_OK) {

        keyPtr = iclsPtr->fullNamePtr;
        if (Tcl_DictObjPut(interp, dictPtr, keyPtr, valuePtr1) != TCL_OK) {
            return TCL_ERROR;
        }
    }
    Tcl_SetVar2Ex(interp,
            ITCL_NAMESPACE"::internal::dicts::classFunctions",
            NULL, dictPtr, TCL_GLOBAL_ONLY);
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  ItclAddClassDelegatedFunctionDictInfo()
 * ------------------------------------------------------------------------

    },
    { "typevars",
        "?pattern?",
	Itcl_BiInfoTypeVarsCmd,
	ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET|ITCL_ECLASS
    },
    { "variable",
        "?name? ?-protection? ?-type? ?-name? ?-init? ?-value? ?-config? ?-scope?",
        Itcl_BiInfoVariableCmd,
	ITCL_CLASS|ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET|ITCL_ECLASS
    },
    { "variables",
        "?pattern?",
        Itcl_BiInfoVariablesCmd,
	ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET|ITCL_ECLASS

 *
 *  If the ?varName? is not specified, then a list of all known
 *  data members is returned.  Otherwise, the information for a
 *  specific member is returned.  Returns a status TCL_OK/TCL_ERROR
 *  to indicate success/failure.
 * ------------------------------------------------------------------------
 */
/*&&&1*/
/* ARGSUSED */
int
Itcl_BiInfoVariableCmd(
    ClientData clientData, /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,    /* current interpreter */
    int objc,              /* number of arguments */
    Tcl_Obj *const objv[]) /* argument objects */

    ItclVariable *ivPtr;
    ItclVarLookup *vlookup;
    ItclHierIter hier;
    char *varName;
    const char *val;
    int i;
    int result;

    ClientData cfClientData;
    ItclObjectInfo *infoPtr;
    Tcl_Object oPtr;
    int doAppend;

    static const char *options[] = {
        "-config", "-init", "-name", "-protection", "-type",
        "-value", "-scope", NULL
    };
    enum BIvIdx {
        BIvConfigIdx, BIvInitIdx, BIvNameIdx, BIvProtectIdx,
        BIvTypeIdx, BIvValueIdx, BIvScopeIdx
    } *ivlist, ivlistStorage[7];

    static enum BIvIdx DefInfoVariable[5] = {
        BIvProtectIdx,
        BIvTypeIdx,
        BIvNameIdx,
        BIvInitIdx,
        BIvValueIdx
    };

    static enum BIvIdx DefInfoPubVariable[6] = {
        BIvProtectIdx,
        BIvTypeIdx,
        BIvNameIdx,
        BIvInitIdx,
        BIvConfigIdx,
        BIvValueIdx
    };


    ItclShowArgs(1, "Itcl_BiInfoVariableCmd", objc, objv);
    resultPtr = NULL;
    objPtr = NULL;
    varName = NULL;
    contextIclsPtr = NULL;
    /*

    }
    if (contextIoPtr != NULL) {
        contextIclsPtr = contextIoPtr->iclsPtr;
    }

    /*
     *  Process args:
     *  ?varName? ?-protection? ?-type? ?-name? ?-init? ?-config? ?-value? ?-scope?
     */
    objv++;  /* skip over command name */
    objc--;

    if (objc > 0) {
        varName = Tcl_GetString(*objv);
        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, "\"",
                NULL);
            return TCL_ERROR;
        }

                        }
                    }
                    if (val == NULL) {
                        val = "<undefined>";
                    }
                    objPtr = Tcl_NewStringObj((const char *)val, -1);
                    break;

                case BIvScopeIdx:
                    entry = Tcl_FindHashEntry(&contextIclsPtr->resolveVars, varName);
                    if (!entry) {
                        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                              "variable \"", varName, "\" not found in class \"",
                              Tcl_GetString(contextIclsPtr->fullNamePtr), "\"",
                              (char*)NULL);
                        return TCL_ERROR;
                    }
                    vlookup = (ItclVarLookup*)Tcl_GetHashValue(entry);

                    if (vlookup->ivPtr->flags & ITCL_COMMON) {
                        objPtr = Tcl_NewStringObj("", -1);

                        if (vlookup->ivPtr->protection != ITCL_PUBLIC) {
                            Tcl_AppendToObj(objPtr, ITCL_VARIABLES_NAMESPACE, -1);
                        }
                        Tcl_AppendToObj(objPtr,
                                Tcl_GetString(vlookup->ivPtr->fullNamePtr), -1);
                    } else {
                        /*
                         *  If this is not a common variable, then we better have
                         *  an object context.  Return the name as a fully qualified name.
                         */
                        infoPtr = contextIclsPtr->infoPtr;
                        cfClientData = Itcl_GetCallFrameClientData(interp);
                        if (cfClientData != NULL) {
                            oPtr = Tcl_ObjectContextObject((Tcl_ObjectContext)cfClientData);
                            if (oPtr != NULL) {
                                contextIoPtr = (ItclObject*)Tcl_ObjectGetMetadata(
                                        oPtr, infoPtr->object_meta_type);
                            }
                        }

                        if (contextIoPtr == NULL) {
                            if (infoPtr->currIoPtr != NULL) {
                                contextIoPtr = infoPtr->currIoPtr;
                            }
                        }

                        if (contextIoPtr == NULL) {
                            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                                "can't scope variable \"", varName,
                                "\": missing object context",
                                (char*)NULL);
                            return TCL_ERROR;
                        }

                        doAppend = 1;
                        if (contextIclsPtr->flags & ITCL_ECLASS) {
                            if (strcmp(varName, "itcl_options") == 0) {
                                doAppend = 0;
                            }
                        }

                        objPtr = Tcl_NewStringObj((char*)NULL, 0);
                        Tcl_IncrRefCount(objPtr);
                        Tcl_AppendToObj(objPtr, ITCL_VARIABLES_NAMESPACE, -1);
                        Tcl_AppendToObj(objPtr,
                                (Tcl_GetObjectNamespace(contextIoPtr->oPtr))->fullName, -1);

                        if (doAppend) {
                            Tcl_AppendToObj(objPtr,
                                    Tcl_GetString(vlookup->ivPtr->fullNamePtr), -1);
                        } else {
                            Tcl_AppendToObj(objPtr, "::", -1);
                            Tcl_AppendToObj(objPtr,
                                    Tcl_GetString(vlookup->ivPtr->namePtr), -1);
                        }
                    }
                    break;
            }

            if (objc == 1) {
                resultPtr = objPtr;
            } else {
                Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);
            }

        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, "\"",
                NULL);
            return TCL_ERROR;
        }

/*
 * Since the Tcl/Tk distribution doesn't perform any asserts,
 * dynamic loading can fail to find the __assert function.
 * As a workaround, we'll include our own.
 */

#undef  assert
#if defined(NDEBUG) && !defined(DEBUG)

#define assert(EX) ((void)0)
#else /* !NDEBUG || DEBUG */
#define assert(EX) (void)((EX) || (Itcl_Assert(STRINGIFY(EX), __FILE__, __LINE__), 0))
#endif

#define ITCL_INTERP_DATA "itcl_data"
#define ITCL_TK_VERSION "8.6"

/*
 * Convenience macros for iterating through hash tables. FOREACH_HASH_DECLS
 * sets up the declarations needed for the main macro, FOREACH_HASH, which

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

typedef struct ItclFoundation {
    Itcl_Stack methodCallStack;
    Tcl_Command dispatchCommand;
} ItclFoundation;

typedef struct ItclArgList {

        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,
        const char* name, int length, Tcl_Namespace *nsPtr,
        struct Tcl_ResolvedVarInfo **rPtr);
MODULE_SCOPE int Itcl_ClassCmdResolver2(Tcl_Interp *interp, const char* name,
	Tcl_Namespace *nsPtr, int flags, Tcl_Command *rPtr);
MODULE_SCOPE int Itcl_ClassVarResolver2(Tcl_Interp *interp, const char* name,
        Tcl_Namespace *nsPtr, int flags, Tcl_Var *rPtr);
MODULE_SCOPE int Itcl_ClassCompiledVarResolver2(Tcl_Interp *interp,
        const char* name, int length, Tcl_Namespace *nsPtr,
        struct Tcl_ResolvedVarInfo **rPtr);
MODULE_SCOPE int ItclSetParserResolver(Tcl_Namespace *nsPtr);
MODULE_SCOPE void ItclProcErrorProc(Tcl_Interp *interp, Tcl_Obj *procNameObj);
MODULE_SCOPE int Itcl_CreateOption (Tcl_Interp *interp, ItclClass *iclsPtr,
	ItclOption *ioptPtr);
MODULE_SCOPE int ItclCreateMethodVariable(Tcl_Interp *interp,
	ItclVariable *ivPtr, Tcl_Obj* defaultPtr, Tcl_Obj* callbackPtr,
	ItclMethodVariable** imvPtrPtr);
MODULE_SCOPE int Itcl_CreateMethodVariable (Tcl_Interp *interp,
        ItclClass *iclsPtr, Tcl_Obj *name, Tcl_Obj *defaultPtr,
	Tcl_Obj *callbackPtr, ItclMethodVariable **imvPtr);
MODULE_SCOPE int DelegationInstall(Tcl_Interp *interp, ItclObject *ioPtr,
        ItclClass *iclsPtr);
MODULE_SCOPE ItclClass *ItclNamespace2Class(Tcl_Namespace *nsPtr);
MODULE_SCOPE const char* ItclGetCommonInstanceVar(Tcl_Interp *interp,

    /*
     *  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 = (ItclClass *)Tcl_GetHashValue(hPtr);
    }
    hPtr = ItclResolveVarEntry(iclsPtr, varName);
    if (hPtr == NULL) {
	/* no class/object variable */
        return NULL;
    }
    ivlPtr = (ItclVarLookup *)Tcl_GetHashValue(hPtr);
    if (ivlPtr == NULL) {
        return NULL;

                if (Tcl_SetVar2(interp, varName, NULL,
	                "", TCL_NAMESPACE_ONLY) == NULL) {
                    Tcl_AppendResult(interp, "INTERNAL ERROR cannot set",
		            " variable \"", varName, "\"\n", NULL);
		    goto errorCleanup;
                }
	    }
            hPtr2 = ItclResolveVarEntry(ivPtr->iclsPtr, varName);
            if (hPtr2 == NULL) {
                hPtr = Tcl_NextHashEntry(&place);
	        continue;
            }
	    if ((ivPtr->flags & ITCL_COMMON) == 0) {
                varPtr = Tcl_NewNamespaceVar(interp, varNsPtr,
                        Tcl_GetString(ivPtr->namePtr));

    /* 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 = (ItclVarLookup *)Tcl_GetHashValue(hPtr);
        ivPtr = vlookup->ivPtr;
    /*
     *  Install the object context and access the data member
     *  like any other variable.
     */
    hPtr = Tcl_FindHashEntry(&contextIoPtr->objectVariables, (char *)ivPtr);
    if (hPtr) {
	Tcl_Obj *varName = Tcl_NewObj();
	Tcl_Var varPtr = (Tcl_Var)Tcl_GetHashValue(hPtr);
	Tcl_GetVariableFullName(interp, varPtr, varName);

	val = Tcl_GetVar2(interp, Tcl_GetString(varName), name2,
		TCL_LEAVE_ERR_MSG | TCL_GLOBAL_ONLY);
	Tcl_DecrRefCount(varName);
	if (val) {
	    return val;
	}
    }
    }

    }
    /* 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 = (ItclVarLookup *)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;

        /* create the itcl_hull variable */
        namePtr = Tcl_NewStringObj("itcl_hull", -1);
        if (ItclCreateComponent(interp, iclsPtr, namePtr, ITCL_COMMON,
	        &icPtr) != TCL_OK) {
            return TCL_ERROR;
        }
        iclsPtr->numVariables++;

    }
    Tcl_ResetResult(interp);
    Tcl_AppendResult(interp, Tcl_GetString(iclsPtr->fullNamePtr), NULL);
    return result;
}

/*

        Tcl_SetHashValue(hPtr, varPtr);
    }
    result = Itcl_PushCallFrame(interp, &frame, commonNsPtr,
        /* isProcCallFrame */ 0);
    Itcl_PopCallFrame(interp);

    /*






     *  If an initialization value was specified, then initialize
     *  the variable now, otherwise be sure the variable is uninitialized.
     */


    if (initStr != NULL) {
	const char *val;


	val = Tcl_SetVar2(interp, Tcl_GetString(ivPtr->fullNamePtr), NULL,

		initStr, TCL_NAMESPACE_ONLY);

        if (!val) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "cannot initialize common variable \"",
                Tcl_GetString(ivPtr->namePtr), "\"",
                NULL);
            return TCL_ERROR;
        }
    } else {
	/* previous var-lookup in class body (in ::itcl::parser) could obtain
	 * inherited common vars, so be sure it does not exists after new
	 * common creation (simply remove this reference). */
	Tcl_UnsetVar2(interp, Tcl_GetString(ivPtr->fullNamePtr), NULL,
		TCL_NAMESPACE_ONLY);
    }
    if (ivPtr->arrayInitPtr != NULL) {
	int i;
	int argc;
	const char **argv;
	const char *val;


	result = Tcl_SplitList(interp, Tcl_GetString(ivPtr->arrayInitPtr),
	        &argc, &argv);
	for (i = 0; i < argc; i++) {
            val = Tcl_SetVar2(interp, Tcl_GetString(ivPtr->fullNamePtr), argv[i],
                    argv[i + 1], TCL_NAMESPACE_ONLY);
            if (!val) {
                Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                    "cannot initialize common variable \"",
                    Tcl_GetString(ivPtr->namePtr), "\"",
                    NULL);
                return TCL_ERROR;

    }

    if (Itcl_CreateVariable(interp, iclsPtr, namePtr,
            Tcl_GetString(defaultPtr), NULL, &ivPtr) != TCL_OK) {
        return TCL_ERROR;
    }
    iclsPtr->numVariables++;
    result = ItclCreateMethodVariable(interp, ivPtr, defaultPtr,
            callbackPtr, &imvPtr);
    if (result != TCL_OK) {
        return result;
    }
    objPtr = Tcl_NewStringObj("@itcl-builtin-setget ", -1);
    Tcl_AppendToObj(objPtr, Tcl_GetString(namePtr), -1);
    Tcl_AppendToObj(objPtr, " ", 1);

        return TCL_CONTINUE;
    }
    iclsPtr = (ItclClass *)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;

    /* Check that the object hasn't already been destroyed. */
    hPtr = Tcl_FindHashEntry(&infoPtr->objects, (char *)contextIoPtr);
    if (hPtr == NULL) {
	return TCL_CONTINUE;
    }
        if (contextIoPtr->iclsPtr != vlookup->ivPtr->iclsPtr) {
	    if (strcmp(Tcl_GetString(vlookup->ivPtr->namePtr), "this") == 0) {
                hPtr = ItclResolveVarEntry(contextIoPtr->iclsPtr,
                    Tcl_GetString(vlookup->ivPtr->namePtr));

                if (hPtr != NULL) {
                    vlookup = (ItclVarLookup*)Tcl_GetHashValue(hPtr);
                }
            }
        }

        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,

	return NULL;
    }

        if (contextIoPtr->iclsPtr != vlookup->ivPtr->iclsPtr) {
	    if (strcmp(Tcl_GetString(vlookup->ivPtr->namePtr), "this") == 0) {
	        /* only for the this variable we need the one of the
		 * contextIoPtr class */
                hPtr = ItclResolveVarEntry(contextIoPtr->iclsPtr,
                        Tcl_GetString(vlookup->ivPtr->namePtr));

                if (hPtr != NULL) {
                    vlookup = (ItclVarLookup*)Tcl_GetHashValue(hPtr);
	        }
	    }
        }

    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) {
	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", NULL);

        return TCL_ERROR;
    }
    hPtr = Tcl_FindHashEntry(&vlookup->ivPtr->iclsPtr->classCommons,
        (char *)vlookup->ivPtr);
    if (!hPtr) {

	return TCL_CONTINUE;
    }


    *rPtr = (Tcl_Var)Tcl_GetHashValue(hPtr);






    return TCL_OK;
}



int
ItclSetParserResolver(
    Tcl_Namespace *nsPtr)
{
    Itcl_SetNamespaceResolvers(nsPtr, NULL,
            Itcl_ParseVarResolver, NULL);
    return TCL_OK;
}

# Tcl package index file, version 1.0

if {![package vsatisfies [package provide Tcl] 8.5]} {return}
if {![package vsatisfies [package provide Tcl] 8.6-]} {return}

package ifneeded itcl @PACKAGE_VERSION@ [list load [file join $dir "@PKG_LIB_FILE@"] itcl]
package ifneeded Itcl @PACKAGE_VERSION@ [list load [file join $dir "@PKG_LIB_FILE@"] itcl]

#!/usr/bin/tclsh

# ------------------------------------------------------------------------
#
# itcl-basic.perf.tcl --
# 
#  This file provides performance tests for comparison of basic itcl-speed.
#
# ------------------------------------------------------------------------
# 
# Copyright (c) 2019 Serg G. Brester (aka sebres)
# 
# See the file "license.terms" for information on usage and redistribution
# of this file.
# 


if {![namespace exists ::tclTestPerf]} {
  source [file join [file dirname [info library]] tests-perf test-performance.tcl]
}

namespace eval ::itclTestPerf-Basic {

namespace path {::tclTestPerf}


## test cases covering regression on class count (memory preserve/release):
proc test-cls-init {{reptime {3000 1000}}} {
  set reptime [_adjust_maxcount $reptime 1000]
  _test_run $reptime {
    setup {set i 0; set k 0}
    ## 1) create up-to 1000 classes (with 100 vars):
    {itcl::class timeClass[incr i] { for {set j 0} {$j<100} {incr j} { public variable d$j } }}
    ## 2) create up-to 1000 classes (with 100 vars):
    {itcl::class finiClass[incr k] { for {set j 0} {$j<100} {incr j} { public variable d$j } }}
    ## 2) delete up-to 1000 classes:
    {itcl::delete class finiClass$k; if {[incr k -1] <= 0} break}
    cleanup {while {$k > 0} {itcl::delete class finiClass$k; incr k -1}}
    ## 1) delete up-to 1000 classes:
    {itcl::delete class timeClass$i; if {[incr i -1] <= 0} break}
    cleanup {while {$i > 0} {itcl::delete class timeClass$i; incr i -1}}
  }
}

## test cases covering run-time dependency to variable count of class with nested
## namespaces and class inheritances...
## original itcl-resolver (due to completely rebuild) has the complexity ca. O(nn**2,2**vn) here,
## so the deeper a class/inheritance and expecially the more variables it has,
## the worse the performance of class creation or modification.

proc test-var-create {{reptime {3000 10000}}} {
  upvar maxv maxv
  foreach ns {{} ::test-itcl-ns1 ::test-itcl-ns1::test-itcl-ns2} {
    incr n
    if {$ns ne {}} { namespace eval $ns {} }
    _test_start $reptime
    foreach clsi {0 1 2} {
      if {$clsi} {
        set inh ${ns}::timeClass[expr {$clsi-1}]
      } else {
        set inh {}
      }
      set cls ${ns}::timeClass$clsi
      puts "== ${n}.$clsi) class : $cls == [expr {$inh ne "" ? "inherite $inh" : ""}]"
      if {[info command $cls] ne ""} {
        itcl::delete class $cls
      }
      itcl::class $cls [string map [list \$reptime [list $reptime] \$in_inh [list $inh] \$clsi $clsi] {
        set j 0
        set inh $in_inh
        if {$inh ne ""} {
          puts "% inherit $inh"
          ::tclTestPerf::_test_iter 2 [timerate { 
            inherit $inh
          } 1 1]
        }
        puts "% declare vars ..."
        ::tclTestPerf::_test_iter 2 [timerate {
          public variable pub[incr j] 0
          protected variable pro$j 1
          private variable pri$j 2
          # 10K commons is too slow in Itcl original edition (time grows on each iter), so 1K enough:
          if {$j <= 1000} {
            public common com$j ""
          }
        } {*}$reptime]
        public method getv {vn} {set $vn}
        public method getpub1 {} {set pro1}
        public method getpro1 {} {set pro1}
        public method getpri1 {} {set pri1}
        public method getunknown {} {catch {set novarinthisclass}}
        # Itcl original edition may be too slow (time grows on each inheritance), so save real max-iters (<= 10K):
        uplevel [list set j $j]
      }]
      set maxv($clsi,$ns) $j
    }
  }
  _test_out_total
}

# access variable:
proc test-access {{reptime 1000}} {
  upvar maxv maxv
  _test_start $reptime
  foreach ns {{} ::test-itcl-ns1 ::test-itcl-ns1::test-itcl-ns2} {
    set reptm [_adjust_maxcount $reptime $maxv(0,$ns)]
    incr n
    set cls ${ns}::timeClass0
    puts "== ${n}) class : $cls =="
    set mp [list \
      \$cls $cls \$n $n \
      \$maxc0 [expr {min(1000,$maxv(0,$ns))}]
    ]
    _test_run $reptm [string map $mp {
      # $n) obj-var resolve/get
      setup {$cls o; set j 0}
      {o getv pub[incr j]}
      # $n) obj-var get (resolved)
      setup {set j 0}
      {o getv pub[incr j]}
      # $n) obj-var resolved
      setup {set j 0}
      {o getv pub1}
      # $n) obj-var in method compiled (public)
      {o getpub1}
      # $n) obj-var in method compiled (protected)
      {o getpro1}
      # $n) obj-var in method compiled (private)
      {o getpri1}
      # $n) obj-var in method unknown
      {o getunknown}
      cleanup {itcl::delete object o}

      # $n) obj-var resolve/cget
      setup {$cls o; set j 0}
      {o cget -pub[incr j]}
      # $n) obj-var cget (resolved):
      setup {set j 0}
      {o cget -pub[incr j]}

      # $n) obj-var cfg/cget
      {o configure -pub1} 
      {o cget -pub1}

      # $n) cls-com resolve
      setup {set j 0}
      {o getv com[incr j]; if {$j >= $maxc0} {set j 0}}

      # $n) cls-com resolved
      {o getv com1}
      cleanup {itcl::delete object o}
    }]
  }
  _test_out_total
}

# ------------------------------------------------------------------------

# create/delete object:
proc test-obj-instance {{reptime 1000}} {
  _test_start $reptime
  set n 0
  foreach ns {{} ::test-itcl-ns1 ::test-itcl-ns1::test-itcl-ns2} {
    incr n
    set cls ${ns}::timeClass0
    puts "== ${n}) class : $cls =="
    _test_run $reptime [string map [list \$cls $cls \$n $n] {
      setup {set i 0}
      # $n) create :
      {$cls o[incr i]}
      # $n) delete:
      {itcl::delete object o$i; if {[incr i -1] <= 0} break}
      cleanup {while {$i > 0} {itcl::delete object o$i; incr i -1}}
      # $n) create + delete:
      {$cls o; itcl::delete object o}
    }]
  }
  _test_out_total
}

# ------------------------------------------------------------------------

proc test {{reptime 1000}} {
  set reptm $reptime
  lset reptm 0 [expr {[lindex $reptm 0] * 10}]
  if {[llength $reptm] == 1} {
    lappend reptm 10000
  }
  puts "==== initialization (preserve/release) ====\n"
  test-cls-init $reptm
  puts "==== class/var creation ====\n"
  test-var-create $reptm
  puts "==== var access ====\n"
  test-access $reptime
  puts "==== object instance ====\n"
  test-obj-instance $reptime

  puts \n**OK**
}

}; # end of ::tclTestPerf-Timer-Event

# ------------------------------------------------------------------------

# if calling direct:
if {[info exists ::argv0] && [file tail $::argv0] eq [file tail [info script]]} {
  array set in {-time 500 -lib {} -load {}}
  array set in $argv
  if {$in(-load) ne ""} {
    eval $in(-load)
  }
  if {![namespace exists ::itcl]} {
    if {$in(-lib) eq ""} {
      set in(-lib) "itcl412"
    }
    puts "testing with $in(-lib)"
    load $in(-lib) itcl
  }

  ::itclTestPerf-Basic::test $in(-time)
}

    test_arrays0 do array names undefined
} -result {}

test basic-6.8 {common variables can be redefined
} -body {
    test_arrays0 do set undefined "scalar"
} -result {scalar}

proc testVarResolver {{access private} {init 0}} {
  eval [string map [list \$access $access \$init $init] {
    itcl::class A {
	$access common cv "A::cv"
	public proc cv {} {set cv}
    }
    itcl::class B {
	inherit A
	public common res {}
	lappend res [info exists cv]
	if {$init} {
	    $access common cv ""
	} else {
	    $access common cv
	}
	lappend res [info exists cv]
	lappend cv "B::cv-add"
	public proc cv {} {set cv}
    }
    lappend B::res [A::cv] [B::cv]
    set B::res
  }]
}
test basic-7.1-a {variable lookup before a common creation (bug [777ae99cfb])} -body {
    # private uninitialized var:
    testVarResolver private 0
} -result {0 0 A::cv B::cv-add} -cleanup {
    itcl::delete class B A
}
test basic-7.1-b {variable lookup before a common creation (bug [777ae99cfb])} -body {
    # public uninitialized var:
    testVarResolver public 0
} -result {1 0 A::cv B::cv-add} -cleanup {
    itcl::delete class B A
}
test basic-7.2-a {variable lookup before a common creation (bug [777ae99cfb])} -body {
    # private initialized var:
    testVarResolver private 1
} -result {0 1 A::cv B::cv-add} -cleanup {
    itcl::delete class B A
}
test basic-7.2-b {variable lookup before a common creation (bug [777ae99cfb])} -body {
    # public initialized var:
    testVarResolver public 1
} -result {1 1 A::cv B::cv-add} -cleanup {
    itcl::delete class B A
}

if {[namespace which test_arrays] ne {}} {
    ::itcl::delete class test_arrays
}
check_itcl_basic_errors
rename check_itcl_basic_errors {}

} {1 {wrong # args: should be one of...
  info args procname
  info body procname
  info class
  info function ?name? ?-protection? ?-type? ?-name? ?-args? ?-body?
  info heritage
  info inherit
  info variable ?name? ?-protection? ?-type? ?-name? ?-init? ?-value? ?-config? ?-scope?
...and others described on the man page}}

test info-1.3 {info: errors trigger usage info} {
    test_info ti
    list [catch {ti info} msg] $msg
} {1 {wrong # args: should be one of...
  info args procname
  info body procname
  info class
  info function ?name? ?-protection? ?-type? ?-name? ?-args? ?-body?
  info heritage
  info inherit
  info variable ?name? ?-protection? ?-type? ?-name? ?-init? ?-value? ?-config? ?-scope?
...and others described on the man page}}

test info-1.4 {info: info class works on class itself} {
    namespace eval test_info { info class }
} {::test_info}

# ----------------------------------------------------------------------
#  Data members
# ----------------------------------------------------------------------
test info-2.1 {info: all variables} {
    lsort [ti info variable]
} {::test_info::defc ::test_info::defv ::test_info::pric ::test_info::priv ::test_info::proc ::test_info::prov ::test_info::pubc ::test_info::pubv ::test_info::this ::test_info::uninitc ::test_info::uninitv ::test_info_base::base}

test info-2.2a {info: public variables} {
    ti info variable pubv
} {public variable ::test_info::pubv public {set pubv "public: $pubv"} new-public}

test info-2.2b {info: public variables} -body {
    list [ti info variable pubv -protection] \
         [ti info variable pubv -type] \
         [ti info variable pubv -name] \
         [ti info variable pubv -init] \
         [ti info variable pubv -config] \
         [ti info variable pubv -value] \
         [ti info variable pubv -scope] \
} -match glob -result {public variable ::test_info::pubv public {set pubv "public: $pubv"} new-public ::itcl::internal::variables::oo::Obj*::test_info::pubv}

test info-2.3a {info: protected variables} {
    ti info variable prov
} {protected variable ::test_info::prov protected new-protected}

test info-2.3b {info: protected variables} -body {
    list [ti info variable prov -protection] \
         [ti info variable prov -type] \
         [ti info variable prov -name] \
         [ti info variable prov -init] \
         [ti info variable prov -value] \
         [ti info variable prov -scope] \
} -match glob -result {protected variable ::test_info::prov protected new-protected ::itcl::internal::variables::oo::Obj*::test_info::prov}

test info-2.4a {info: private variables} {
    ti info variable priv
} {private variable ::test_info::priv private new-private}

test info-2.4b {info: private variables} -body {
    list [ti info variable priv -protection] \
         [ti info variable priv -type] \
         [ti info variable priv -name] \
         [ti info variable priv -init] \
         [ti info variable priv -value] \
         [ti info variable priv -scope] \
} -match glob -result {private variable ::test_info::priv private new-private ::itcl::internal::variables::oo::Obj*::test_info::priv}

test info-2.5 {"this" variable is built in} {
    ti info variable this
} {protected variable ::test_info::this ::ti ::ti}

test info-2.6 {info: protected/private variables have no "config" code} {
    list [ti info variable prov -config] [ti info variable priv -config]

test info-2.9b {info: public common variables} {
    list [ti info variable pubc -protection] \
         [ti info variable pubc -type] \
         [ti info variable pubc -name] \
         [ti info variable pubc -init] \
         [ti info variable pubc -value] \
         [ti info variable pubc -scope] \
} {public common ::test_info::pubc public new-public ::test_info::pubc}

test info-2.10a {info: protected common variables} {
    ti info variable proc
} {protected common ::test_info::proc protected new-protected}

test info-2.10b {info: protected common variables} {
    list [ti info variable proc -protection] \
         [ti info variable proc -type] \
         [ti info variable proc -name] \
         [ti info variable proc -init] \
         [ti info variable proc -value] \
         [ti info variable proc -scope] \
} {protected common ::test_info::proc protected new-protected ::itcl::internal::variables::test_info::proc}

test info-2.11a {info: private common variables} {
    ti info variable pric
} {private common ::test_info::pric private new-private}

test info-2.11b {info: private common variables} {
    list [ti info variable pric -protection] \
         [ti info variable pric -type] \
         [ti info variable pric -name] \
         [ti info variable pric -init] \
         [ti info variable pric -value] \
         [ti info variable pric -scope] \
} {private common ::test_info::pric private new-private ::itcl::internal::variables::test_info::pric}

test info-2.12 {info: public/protected/private vars have no "config" code} {
    list [ti info variable pubc -config] \
         [ti info variable proc -config] \
         [ti info variable pric -config]
} {{} {} {}}

    list [namespace eval test_info {lsort [array names uninitc]}] \
         [namespace eval test_info {set uninitc(0)}] \
         [namespace eval test_info {set uninitc(1)}]
} {{0 1} zero one}

test info-2.16 {flag syntax errors} {
    list [catch {ti info variable defv -xyzzy} msg] $msg
} {1 {bad option "-xyzzy": must be -config, -init, -name, -protection, -type, -value, or -scope}}

# ----------------------------------------------------------------------
#  Member functions
# ----------------------------------------------------------------------
test info-3.1 {info: all functions} {
    lsort [ti info function]
} {::test_info::constructor ::test_info::defm ::test_info::defp ::test_info::destructor ::test_info::prim ::test_info::prip ::test_info::prom ::test_info::prop ::test_info::pubm ::test_info::pubp ::test_info::uninitm ::test_info::uninitp ::test_info_base::base ::test_info_base::cget ::test_info_base::configure ::test_info_base::do ::test_info_base::isa}

  info options ?pattern?
  info type
  info typemethod ?name? ?-protection? ?-type? ?-name? ?-args? ?-body?
  info typemethods ?pattern?
  info types ?pattern?
  info typevariable ?name? ?-protection? ?-type? ?-name? ?-init? ?-value?
  info typevars ?pattern?
  info variable ?name? ?-protection? ?-type? ?-name? ?-init? ?-value? ?-config? ?-scope?
  info variables ?pattern?
...and others described on the man page}

test iinfo-1.3 {object info too many args} -body {
    type dog { }

    dog create spot

  info options ?pattern?
  info type
  info typemethod ?name? ?-protection? ?-type? ?-name? ?-args? ?-body?
  info typemethods ?pattern?
  info types ?pattern?
  info typevariable ?name? ?-protection? ?-type? ?-name? ?-init? ?-value?
  info typevars ?pattern?
  info variable ?name? ?-protection? ?-type? ?-name? ?-init? ?-value? ?-config? ?-scope?
  info variables ?pattern?
...and others described on the man page}


test tinfo-1.3 {type info too many args} -body {
    type dog { }

        $(TMP_DIR)\itclUtil.obj \
!if !$(STATIC_BUILD)
	$(TMP_DIR)\dllEntryPoint.obj \
!endif

PRJ_STUBOBJS = $(TMP_DIR)\itclStubLib.obj

PRJ_DEFINES = /D_CRT_SECURE_NO_WARNINGS
!if $(DEBUG)
PRJ_DEFINES = $(PRJ_DEFINES) /DITCL_DEBUG
!endif

PRJ_HEADERS_PUBLIC = \
	$(GENERICDIR)\itcl.h \
	$(GENERICDIR)\itclDecls.h

# lflags - complete linker switches (subsumes ldebug) except subsystem type
# dlllflags - complete linker switches to build DLLs (subsumes lflags)
# conlflags - complete linker switches for console program (subsumes lflags)
# guilflags - complete linker switches for GUI program (subsumes lflags)
# baselibs - minimum Windows libraries required. Parent makefile can
#    define PRJ_LIBS before including rules.rc if additional libs are needed

OPTDEFINES	= /DTCL_CFGVAL_ENCODING=$(CFG_ENCODING) /DSTDC_HEADERS

!if $(TCL_MEM_DEBUG)
OPTDEFINES	= $(OPTDEFINES) /DTCL_MEM_DEBUG
!endif
!if $(TCL_COMPILE_DEBUG)
OPTDEFINES	= $(OPTDEFINES) /DTCL_COMPILE_DEBUG /DTCL_COMPILE_STATS
!endif
!if $(TCL_THREADS) && $(TCL_VERSION) < 87
OPTDEFINES	= $(OPTDEFINES) /DTCL_THREADS=1
!if $(USE_THREAD_ALLOC) && $(TCL_VERSION) < 87
OPTDEFINES	= $(OPTDEFINES) /DUSE_THREAD_ALLOC=1
!endif
!endif
!if $(STATIC_BUILD)
OPTDEFINES	= $(OPTDEFINES) /DSTATIC_BUILD
!endif
!if $(TCL_NO_DEPRECATED)
OPTDEFINES	= $(OPTDEFINES) /DTCL_NO_DEPRECATED
!endif

!if $(USE_STUBS)
# Note we do not define USE_TCL_STUBS even when building tk since some
# test targets in tk do not use stubs
!if ! $(DOING_TCL)
USE_STUBS_DEFS  = /DUSE_TCL_STUBS /DUSE_TCLOO_STUBS
!if $(NEED_TK)
USE_STUBS_DEFS  = $(USE_STUBS_DEFS) /DUSE_TK_STUBS
!endif
!endif
!endif # USE_STUBS

!if !$(DEBUG)
OPTDEFINES	= $(OPTDEFINES) /DNDEBUG
!if $(OPTIMIZING)
OPTDEFINES	= $(OPTDEFINES) /DTCL_CFG_OPTIMIZED
!endif
!endif
!if $(PROFILE)
OPTDEFINES	= $(OPTDEFINES) /DTCL_CFG_PROFILED
!endif
!if "$(MACHINE)" == "AMD64"
OPTDEFINES	= $(OPTDEFINES) /DTCL_CFG_DO64BIT
!endif
!if $(VCVERSION) < 1300
OPTDEFINES	= $(OPTDEFINES) /DNO_STRTOI64
!endif

!if "$(_USE_64BIT_TIME_T)" == "1"
OPTDEFINES	= $(OPTDEFINES) /D_USE_64BIT_TIME_T
!endif

# _ATL_XP_TARGETING - Newer SDK's need this to build for XP
COMPILERFLAGS  = /D_ATL_XP_TARGETING

# Like the TEA system only set this non empty for non-Tk extensions
# Note: some extensions use PACKAGE_NAME and others use PACKAGE_TCLNAME
# so we pass both
!if !$(DOING_TCL) && !$(DOING_TK)
PKGNAMEFLAGS = /DPACKAGE_NAME="\"$(PRJ_PACKAGE_TCLNAME)\"" \
               /DPACKAGE_TCLNAME="\"$(PRJ_PACKAGE_TCLNAME)\"" \
               /DPACKAGE_VERSION="\"$(DOTVERSION)\"" \
               /DMODULE_SCOPE=extern
!endif

# crt picks the C run time based on selected OPTS
!if $(MSVCRT)
!if $(DEBUG) && !$(UNCHECKED)
crt = -MDd
!else

# output increasing chance of a real warning getting lost. So disable them.
# Eventually some day, Tcl will be 64-bit clean.
cwarn = $(cwarn) -wd4311 -wd4312
!endif

### Common compiler options that are architecture specific
!if "$(MACHINE)" == "ARM"
carch = /D_ARM_WINAPI_PARTITION_DESKTOP_SDK_AVAILABLE
!else
carch =
!endif

!if $(DEBUG)
# Turn warnings into errors
cwarn = $(cwarn) -WX

# object files (e.g. tclsh, or wish) pkgcflags contains $(cflags) plus
# flags used for building shared object files The two differ in the
# BUILD_$(PROJECT) macro which should be defined only for the shared
# library *implementation* and not for its caller interface

appcflags_nostubs = $(cflags) $(crt) $(INCLUDES) $(TCL_DEFINES) $(PRJ_DEFINES) $(OPTDEFINES)
appcflags = $(appcflags_nostubs) $(USE_STUBS_DEFS)
pkgcflags = $(appcflags) $(PKGNAMEFLAGS) /DBUILD_$(PROJECT)
pkgcflags_nostubs = $(appcflags_nostubs) $(PKGNAMEFLAGS) /DBUILD_$(PROJECT)

# stubscflags contains $(cflags) plus flags used for building a stubs
# library for the package.  Note: /DSTATIC_BUILD is defined in
# $(OPTDEFINES) only if the OPTS configuration indicates a static
# library. However the stubs library is ALWAYS static hence included
# here irrespective of the OPTS setting.
#
# TBD - tclvfs has a comment that stubs libs should not be compiled with -GL
# without stating why. Tcl itself compiled stubs libs with this flag.
# so we do not remove it from cflags. -GL may prevent extensions
# compiled with one VC version to fail to link against stubs library
# compiled with another VC version. Check for this and fix accordingly.
stubscflags = $(cflags) $(PKGNAMEFLAGS) $(PRJ_DEFINES) $(OPTDEFINES) -Zl /DSTATIC_BUILD $(INCLUDES) $(USE_STUBS_DEFS)

# Link flags

!if $(DEBUG)
ldebug	= -debug -debugtype:cv
!else
ldebug	= -release -opt:ref -opt:icf,3

LIBCMD = $(lib32) -nologo $(LINKERFLAGS) -out:$@
DLLCMD = $(link32) $(dlllflags) -out:$@ $(baselibs) $(tcllibs) $(tklibs)

CONEXECMD = $(link32) $(conlflags) -out:$@ $(baselibs) $(tcllibs) $(tklibs)
GUIEXECMD = $(link32) $(guilflags) -out:$@ $(baselibs) $(tcllibs) $(tklibs)
RESCMD  = $(rc32) -fo $@ -r -i "$(GENERICDIR)" -i "$(TMP_DIR)" \
	    $(TCL_INCLUDES) \
	    /DDEBUG=$(DEBUG) -d UNCHECKED=$(UNCHECKED) \
	    /DCOMMAVERSION=$(DOTVERSION:.=,),0 \
	    /DDOTVERSION=\"$(DOTVERSION)\" \
	    /DVERSION=\"$(VERSION)\" \
	    /DSUFX=\"$(SUFX)\" \
	    /DPROJECT=\"$(PROJECT)\" \
	    /DPRJLIBNAME=\"$(PRJLIBNAME)\"

!ifndef DEFAULT_BUILD_TARGET
DEFAULT_BUILD_TARGET = $(PROJECT)
!endif

default-target: $(DEFAULT_BUILD_TARGET)