itcl_class.c

linux 下的源代码分析阅读器 red hat公司新版

     *  least specific.  Add a lookup entry for each variable
     *  into the table.
     */
    Itcl_InitHierIter(&hier, cdefnPtr);
    cdPtr = Itcl_AdvanceHierIter(&hier);
    while (cdPtr != NULL) {
        entry = Tcl_FirstHashEntry(&cdPtr->variables, &place);
        while (entry) {
            vdefn = (ItclVarDefn*)Tcl_GetHashValue(entry);

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

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

            /*
             *  If this is a common variable, then keep a reference to
             *  the variable directly.  Otherwise, keep an index into
             *  the object's variable table.
             */
            if ((vdefn->member->flags & ITCL_COMMON) != 0) {
                nsPtr = (Namespace*)cdPtr->namesp;
                hPtr = Tcl_FindHashEntry(&nsPtr->varTable, vdefn->member->name);
                assert(hPtr != NULL);

                vlookup->var.common = (Tcl_Var)Tcl_GetHashValue(hPtr);
            }
            else {
                /*
                 *  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 ((vdefn->member->flags & ITCL_THIS_VAR) != 0) {
                    vlookup->var.index = 0;
                }
                else {
                    vlookup->var.index = cdefnPtr->numInstanceVars++;
                }
            }

            /*
             *  Create all possible names for this variable and enter
             *  them into the variable resolution table:
             *     var
             *     class::var
             *     namesp1::class::var
             *     namesp2::namesp1::class::var
             *     ...
             */
            Tcl_DStringSetLength(&buffer, 0);
            Tcl_DStringAppend(&buffer, vdefn->member->name, -1);
            nsPtr = (Namespace*)cdPtr->namesp;

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

                if (newEntry) {
                    Tcl_SetHashValue(entry, (ClientData)vlookup);
                    vlookup->usage++;

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

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

                nsPtr = nsPtr->parentPtr;
            }

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

    /*
     *  Clear the command resolution table.
     */
    Tcl_DeleteHashTable(&cdefnPtr->resolveCmds);
    Tcl_InitHashTable(&cdefnPtr->resolveCmds, TCL_STRING_KEYS);

    /*
     *  Scan through all classes in the hierarchy, from most to
     *  least specific.  Look for the first (most-specific) definition
     *  of each member function, and enter it into the table.
     */
    Itcl_InitHierIter(&hier, cdefnPtr);
    cdPtr = Itcl_AdvanceHierIter(&hier);
    while (cdPtr != NULL) {
        entry = Tcl_FirstHashEntry(&cdPtr->functions, &place);
        while (entry) {
            mfunc = (ItclMemberFunc*)Tcl_GetHashValue(entry);

            /*
             *  Create all possible names for this function and enter
             *  them into the command resolution table:
             *     func
             *     class::func
             *     namesp1::class::func
             *     namesp2::namesp1::class::func
             *     ...
             */
            Tcl_DStringSetLength(&buffer, 0);
            Tcl_DStringAppend(&buffer, mfunc->member->name, -1);
            nsPtr = (Namespace*)cdPtr->namesp;

            while (1) {
                entry = Tcl_CreateHashEntry(&cdefnPtr->resolveCmds,
                    Tcl_DStringValue(&buffer), &newEntry);

                if (newEntry) {
                    Tcl_SetHashValue(entry, (ClientData)mfunc);
                }

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

                nsPtr = nsPtr->parentPtr;
            }
            entry = Tcl_NextHashEntry(&place);
        }
        cdPtr = Itcl_AdvanceHierIter(&hier);
    }
    Itcl_DeleteHierIter(&hier);

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


/*
 * ------------------------------------------------------------------------
 *  Itcl_CreateVarDefn()
 *
 *  Creates a new class variable definition.  If this is a public
 *  variable, it may have a bit of "config" code that is used to
 *  update the object whenever the variable is modified via the
 *  built-in "configure" method.
 *
 *  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 variable definition in "vdefnPtr".
 * ------------------------------------------------------------------------
 */
int
Itcl_CreateVarDefn(interp, cdefn, name, init, config, vdefnPtr)
    Tcl_Interp *interp;       /* interpreter managing this transaction */
    ItclClass* cdefn;         /* class containing this variable */
    char* name;               /* variable name */
    char* init;               /* initial value */
    char* config;             /* code invoked when variable is configured */
    ItclVarDefn** vdefnPtr;   /* returns: new variable definition */
{
    int newEntry;
    ItclVarDefn *vdefn;
    ItclMemberCode *mcode;
    Tcl_HashEntry *entry;

    /*
     *  Add this variable to the variable table for the class.
     *  Make sure that the variable name does not already exist.
     */
    entry = Tcl_CreateHashEntry(&cdefn->variables, name, &newEntry);
    if (!newEntry) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "variable name \"", name, "\" already defined in class \"",
            cdefn->fullname, "\"",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  If this variable has some "config" code, try to capture
     *  its implementation.
     */
    if (config) {
        if (Itcl_CreateMemberCode(interp, cdefn, (char*)NULL, config,
            &mcode) != TCL_OK) {

            Tcl_DeleteHashEntry(entry);
            return TCL_ERROR;
        }
        Itcl_PreserveData((ClientData)mcode);
        Itcl_EventuallyFree((ClientData)mcode, Itcl_DeleteMemberCode);
    }
    else {
        mcode = NULL;
    }
        

    /*
     *  If everything looks good, create the variable definition.
     */
    vdefn = (ItclVarDefn*)ckalloc(sizeof(ItclVarDefn));
    vdefn->member = Itcl_CreateMember(interp, cdefn, name);
    vdefn->member->code = mcode;

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

    if (init) {
        vdefn->init = (char*)ckalloc((unsigned)(strlen(init)+1));
        strcpy(vdefn->init, init);
    }
    else {
        vdefn->init = NULL;
    }

    Tcl_SetHashValue(entry, (ClientData)vdefn);

    *vdefnPtr = vdefn;
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_DeleteVarDefn()
 *
 *  Destroys a variable definition created by Itcl_CreateVarDefn(),
 *  freeing all resources associated with it.
 * ------------------------------------------------------------------------
 */
void
Itcl_DeleteVarDefn(vdefn)
    ItclVarDefn *vdefn;   /* variable definition to be destroyed */
{
    Itcl_DeleteMember(vdefn->member);

    if (vdefn->init) {
        ckfree(vdefn->init);
    }
    ckfree((char*)vdefn);
}


/*
 * ------------------------------------------------------------------------
 *  Itcl_GetCommonVar()
 *
 *  Returns the current value for a common class variable.  The member
 *  name is interpreted with respect to the given class scope.  That
 *  scope is installed as the current context before querying the
 *  variable.  This by-passes the protection level in case the variable
 *  is "private".
 *
 *  If successful, this procedure returns a pointer to a string value
 *  which remains alive until the variable changes it value.  If
 *  anything goes wrong, this returns NULL.
 * ------------------------------------------------------------------------
 */
char*
Itcl_GetCommonVar(interp, name, contextClass)
    Tcl_Interp *interp;        /* current interpreter */
    char *name;                /* name of desired instance variable */
    ItclClass *contextClass;   /* name is interpreted in this scope */
{
    char *val = NULL;
    int result;
    Tcl_CallFrame frame;

    /*
     *  Activate the namespace for the given class.  That installs
     *  the appropriate name resolution rules and by-passes any
     *  security restrictions.
     */
    result = Tcl_PushCallFrame(interp, &frame,
                 contextClass->namesp, /*isProcCallFrame*/ 0);

    if (result == TCL_OK) {
        val = Tcl_GetVar2(interp, name, (char*)NULL, 0);
        Tcl_PopCallFrame(interp);
    }
    return val;
}


/*
 * ------------------------------------------------------------------------
 *  Itcl_CreateMember()
 *
 *  Creates the data record representing a class member.  This is the
 *  generic representation for a data member or member function.
 *  Returns a pointer to the new representation.
 * ------------------------------------------------------------------------
 */
ItclMember*
Itcl_CreateMember(interp, cdefn, name)
    Tcl_Interp* interp;            /* interpreter managing this action */
    ItclClass *cdefn;              /* class definition */
    char* name;                    /* name of new member */
{
    ItclMember *memPtr;
    int fullsize;

    /*
     *  Allocate the memory for a class member and fill in values.
     */
    memPtr = (ItclMember*)ckalloc(sizeof(ItclMember));
    memPtr->interp       = interp;
    memPtr->classDefn    = cdefn;
    memPtr->flags        = 0;
    memPtr->protection   = Itcl_Protection(interp, 0);
    memPtr->code         = NULL;

    fullsize = strlen(cdefn->fullname) + strlen(name) + 2;
    memPtr->fullname = (char*)ckalloc((unsigned)(fullsize+1));
    strcpy(memPtr->fullname, cdefn->fullname);
    strcat(memPtr->fullname, "::");
    strcat(memPtr->fullname, name);

    memPtr->name = (char*)ckalloc((unsigned)(strlen(name)+1));
    strcpy(memPtr->name, name);

    return memPtr;
}


/*
 * ------------------------------------------------------------------------
 *  Itcl_DeleteMember()
 *
 *  Destroys all data associated with the given member function definition.
 *  Usually invoked by the interpreter when a member function is deleted.
 * ------------------------------------------------------------------------
 */
void
Itcl_DeleteMember(memPtr)
    ItclMember *memPtr;  /* pointer to member function definition */
{
    if (memPtr) {
        ckfree(memPtr->name);
        ckfree(memPtr->fullname);

        if (memPtr->code) {
            Itcl_ReleaseData((ClientData)memPtr->code);
        }
        memPtr->code = NULL;

        ckfree((char*)memPtr);
    }
}


/*
 * ------------------------------------------------------------------------
 *  Itcl_InitHierIter()
 *
 *  Initializes an iterator for traversing the hierarchy of the given
 *  class.  Subsequent calls to Itcl_AdvanceHierIter() will return
 *  the base classes in order from most-to-least specific.
 * ------------------------------------------------------------------------
 */
void
Itcl_InitHierIter(iter,cdefn)
    ItclHierIter *iter;   /* iterator used for traversal */
    ItclClass *cdefn;     /* class definition for start of traversal */
{
    Itcl_InitStack(&iter->stack);
    Itcl_PushStack((ClientData)cdefn, &iter->stack);
    iter->current = cdefn;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_DeleteHierIter()
 *
 *  Destroys an iterator for traversing class hierarchies, freeing
 *  all memory associated with it.
 * ------------------------------------------------------------------------
 */
void
Itcl_DeleteHierIter(iter)
    ItclHierIter *iter;  /* iterator used for traversal */
{
    Itcl_DeleteStack(&iter->stack);
    iter->current = NULL;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_AdvanceHierIter()
 *
 *  Moves a class hierarchy iterator forward to the next base class.
 *  Returns a pointer to the current class definition, or NULL when
 *  the end of the hierarchy has been reached.
 * ------------------------------------------------------------------------
 */
ItclClass*
Itcl_AdvanceHierIter(iter)
    ItclHierIter *iter;  /* iterator used for traversal */
{
    register Itcl_ListElem *elem;
    ItclClass *cdPtr;

    iter->current = (ItclClass*)Itcl_PopStack(&iter->stack);

    /*
     *  Push classes onto the stack in reverse order, so that
     *  they will be popped off in the proper order.
     */
    if (iter->current) {
        cdPtr = (ItclClass*)iter->current;
        elem = Itcl_LastListElem(&cdPtr->bases);
        while (elem) {
            Itcl_PushStack(Itcl_GetListValue(elem), &iter->stack);
            elem = Itcl_PrevListElem(elem);
        }
    }
    return iter->current;
}