diff options
Diffstat (limited to 'generic/tclOOCall.c')
| -rw-r--r-- | generic/tclOOCall.c | 1495 |
1 files changed, 1495 insertions, 0 deletions
diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c new file mode 100644 index 0000000..26fd09f --- /dev/null +++ b/generic/tclOOCall.c @@ -0,0 +1,1495 @@ +/* + * tclOOCall.c -- + * + * This file contains the method call chain management code for the + * object-system core. + * + * Copyright (c) 2005-2012 by Donal K. Fellows + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include "tclInt.h" +#include "tclOOInt.h" + +/* + * Structure containing a CallContext and any other values needed only during + * the construction of the CallContext. + */ + +struct ChainBuilder { + CallChain *callChainPtr; /* The call chain being built. */ + int filterLength; /* Number of entries in the call chain that + * are due to processing filters and not the + * main call chain. */ + Object *oPtr; /* The object that we are building the chain + * for. */ +}; + +/* + * Extra flags used for call chain management. + */ + +#define DEFINITE_PROTECTED 0x100000 +#define DEFINITE_PUBLIC 0x200000 +#define KNOWN_STATE (DEFINITE_PROTECTED | DEFINITE_PUBLIC) +#define SPECIAL (CONSTRUCTOR | DESTRUCTOR | FORCE_UNKNOWN) + +/* + * Function declarations for things defined in this file. + */ + +static void AddClassFiltersToCallContext(Object *const oPtr, + Class *clsPtr, struct ChainBuilder *const cbPtr, + Tcl_HashTable *const doneFilters); +static void AddClassMethodNames(Class *clsPtr, const int flags, + Tcl_HashTable *const namesPtr); +static inline void AddMethodToCallChain(Method *const mPtr, + struct ChainBuilder *const cbPtr, + Tcl_HashTable *const doneFilters, + Class *const filterDecl); +static inline void AddSimpleChainToCallContext(Object *const oPtr, + Tcl_Obj *const methodNameObj, + struct ChainBuilder *const cbPtr, + Tcl_HashTable *const doneFilters, int flags, + Class *const filterDecl); +static void AddSimpleClassChainToCallContext(Class *classPtr, + Tcl_Obj *const methodNameObj, + struct ChainBuilder *const cbPtr, + Tcl_HashTable *const doneFilters, int flags, + Class *const filterDecl); +static int CmpStr(const void *ptr1, const void *ptr2); +static void DupMethodNameRep(Tcl_Obj *srcPtr, Tcl_Obj *dstPtr); +static int FinalizeMethodRefs(ClientData data[], + Tcl_Interp *interp, int result); +static void FreeMethodNameRep(Tcl_Obj *objPtr); +static inline int IsStillValid(CallChain *callPtr, Object *oPtr, + int flags, int reuseMask); +static int ResetFilterFlags(ClientData data[], + Tcl_Interp *interp, int result); +static int SetFilterFlags(ClientData data[], + Tcl_Interp *interp, int result); +static inline void StashCallChain(Tcl_Obj *objPtr, CallChain *callPtr); + +/* + * Object type used to manage type caches attached to method names. + */ + +static const Tcl_ObjType methodNameType = { + "TclOO method name", + FreeMethodNameRep, + DupMethodNameRep, + NULL, + NULL +}; + +/* + * ---------------------------------------------------------------------- + * + * TclOODeleteContext -- + * + * Destroys a method call-chain context, which should not be in use. + * + * ---------------------------------------------------------------------- + */ + +void +TclOODeleteContext( + CallContext *contextPtr) +{ + register Object *oPtr = contextPtr->oPtr; + + TclOODeleteChain(contextPtr->callPtr); + if (oPtr != NULL) { + TclStackFree(oPtr->fPtr->interp, contextPtr); + DelRef(oPtr); + } +} + +/* + * ---------------------------------------------------------------------- + * + * TclOODeleteChainCache -- + * + * Destroy the cache of method call-chains. + * + * ---------------------------------------------------------------------- + */ + +void +TclOODeleteChainCache( + Tcl_HashTable *tablePtr) +{ + FOREACH_HASH_DECLS; + CallChain *callPtr; + + FOREACH_HASH_VALUE(callPtr, tablePtr) { + if (callPtr) { + TclOODeleteChain(callPtr); + } + } + Tcl_DeleteHashTable(tablePtr); + ckfree(tablePtr); +} + +/* + * ---------------------------------------------------------------------- + * + * TclOODeleteChain -- + * + * Destroys a method call-chain. + * + * ---------------------------------------------------------------------- + */ + +void +TclOODeleteChain( + CallChain *callPtr) +{ + if (--callPtr->refCount >= 1) { + return; + } + if (callPtr->chain != callPtr->staticChain) { + ckfree(callPtr->chain); + } + ckfree(callPtr); +} + +/* + * ---------------------------------------------------------------------- + * + * TclOOStashContext -- + * + * Saves a reference to a method call context in a Tcl_Obj's internal + * representation. + * + * ---------------------------------------------------------------------- + */ + +static inline void +StashCallChain( + Tcl_Obj *objPtr, + CallChain *callPtr) +{ + callPtr->refCount++; + TclFreeIntRep(objPtr); + objPtr->typePtr = &methodNameType; + objPtr->internalRep.twoPtrValue.ptr1 = callPtr; +} + +void +TclOOStashContext( + Tcl_Obj *objPtr, + CallContext *contextPtr) +{ + StashCallChain(objPtr, contextPtr->callPtr); +} + +/* + * ---------------------------------------------------------------------- + * + * DupMethodNameRep, FreeMethodNameRep -- + * + * Functions to implement the required parts of the Tcl_Obj guts needed + * for caching of method contexts in Tcl_Objs. + * + * ---------------------------------------------------------------------- + */ + +static void +DupMethodNameRep( + Tcl_Obj *srcPtr, + Tcl_Obj *dstPtr) +{ + register CallChain *callPtr = srcPtr->internalRep.twoPtrValue.ptr1; + + dstPtr->typePtr = &methodNameType; + dstPtr->internalRep.twoPtrValue.ptr1 = callPtr; + callPtr->refCount++; +} + +static void +FreeMethodNameRep( + Tcl_Obj *objPtr) +{ + register CallChain *callPtr = objPtr->internalRep.twoPtrValue.ptr1; + + TclOODeleteChain(callPtr); + objPtr->typePtr = NULL; +} + +/* + * ---------------------------------------------------------------------- + * + * TclOOInvokeContext -- + * + * Invokes a single step along a method call-chain context. Note that the + * invokation of a step along the chain can cause further steps along the + * chain to be invoked. Note that this function is written to be as light + * in stack usage as possible. + * + * ---------------------------------------------------------------------- + */ + +int +TclOOInvokeContext( + ClientData clientData, /* The method call context. */ + Tcl_Interp *interp, /* Interpreter for error reporting, and many + * other sorts of context handling (e.g., + * commands, variables) depending on method + * implementation. */ + int objc, /* The number of arguments. */ + Tcl_Obj *const objv[]) /* The arguments as actually seen. */ +{ + register CallContext *const contextPtr = clientData; + Method *const mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr; + const int isFilter = + contextPtr->callPtr->chain[contextPtr->index].isFilter; + + /* + * If this is the first step along the chain, we preserve the method + * entries in the chain so that they do not get deleted out from under our + * feet. + */ + + if (contextPtr->index == 0) { + int i; + + for (i=0 ; i<contextPtr->callPtr->numChain ; i++) { + AddRef(contextPtr->callPtr->chain[i].mPtr); + } + + /* + * Ensure that the method name itself is part of the arguments when + * we're doing unknown processing. + */ + + if (contextPtr->callPtr->flags & OO_UNKNOWN_METHOD) { + contextPtr->skip--; + } + + /* + * Add a callback to ensure that method references are dropped once + * this call is finished. + */ + + TclNRAddCallback(interp, FinalizeMethodRefs, contextPtr, NULL, NULL, + NULL); + } + + /* + * Save whether we were in a filter and set up whether we are now. + */ + + if (contextPtr->oPtr->flags & FILTER_HANDLING) { + TclNRAddCallback(interp, SetFilterFlags, contextPtr, NULL,NULL,NULL); + } else { + TclNRAddCallback(interp, ResetFilterFlags,contextPtr,NULL,NULL,NULL); + } + if (isFilter || contextPtr->callPtr->flags & FILTER_HANDLING) { + contextPtr->oPtr->flags |= FILTER_HANDLING; + } else { + contextPtr->oPtr->flags &= ~FILTER_HANDLING; + } + + /* + * Run the method implementation. + */ + + return mPtr->typePtr->callProc(mPtr->clientData, interp, + (Tcl_ObjectContext) contextPtr, objc, objv); +} + +static int +SetFilterFlags( + ClientData data[], + Tcl_Interp *interp, + int result) +{ + CallContext *contextPtr = data[0]; + + contextPtr->oPtr->flags |= FILTER_HANDLING; + return result; +} + +static int +ResetFilterFlags( + ClientData data[], + Tcl_Interp *interp, + int result) +{ + CallContext *contextPtr = data[0]; + + contextPtr->oPtr->flags &= ~FILTER_HANDLING; + return result; +} + +static int +FinalizeMethodRefs( + ClientData data[], + Tcl_Interp *interp, + int result) +{ + CallContext *contextPtr = data[0]; + int i; + + for (i=0 ; i<contextPtr->callPtr->numChain ; i++) { + TclOODelMethodRef(contextPtr->callPtr->chain[i].mPtr); + } + return result; +} + +/* + * ---------------------------------------------------------------------- + * + * TclOOGetSortedMethodList, TclOOGetSortedClassMethodList -- + * + * Discovers the list of method names supported by an object or class. + * + * ---------------------------------------------------------------------- + */ + +int +TclOOGetSortedMethodList( + Object *oPtr, /* The object to get the method names for. */ + int flags, /* Whether we just want the public method + * names. */ + const char ***stringsPtr) /* Where to write a pointer to the array of + * strings to. */ +{ + Tcl_HashTable names; /* Tcl_Obj* method name to "wanted in list" + * mapping. */ + FOREACH_HASH_DECLS; + int i; + Class *mixinPtr; + Tcl_Obj *namePtr; + Method *mPtr; + int isWantedIn; + void *isWanted; + + Tcl_InitObjHashTable(&names); + + /* + * Name the bits used in the names table values. + */ +#define IN_LIST 1 +#define NO_IMPLEMENTATION 2 + + /* + * Process method names due to the object. + */ + + if (oPtr->methodsPtr) { + FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) { + int isNew; + + if ((mPtr->flags & PRIVATE_METHOD) && !(flags & PRIVATE_METHOD)) { + continue; + } + hPtr = Tcl_CreateHashEntry(&names, (char *) namePtr, &isNew); + if (isNew) { + isWantedIn = ((!(flags & PUBLIC_METHOD) + || mPtr->flags & PUBLIC_METHOD) ? IN_LIST : 0); + isWantedIn |= (mPtr->typePtr == NULL ? NO_IMPLEMENTATION : 0); + Tcl_SetHashValue(hPtr, INT2PTR(isWantedIn)); + } + } + } + + /* + * Process method names due to private methods on the object's class. + */ + + if (flags & PRIVATE_METHOD) { + FOREACH_HASH(namePtr, mPtr, &oPtr->selfCls->classMethods) { + if (mPtr->flags & PRIVATE_METHOD) { + int isNew; + + hPtr = Tcl_CreateHashEntry(&names, (char *) namePtr, &isNew); + if (isNew) { + isWantedIn = IN_LIST; + if (mPtr->typePtr == NULL) { + isWantedIn |= NO_IMPLEMENTATION; + } + Tcl_SetHashValue(hPtr, INT2PTR(isWantedIn)); + } else if (mPtr->typePtr != NULL) { + isWantedIn = PTR2INT(Tcl_GetHashValue(hPtr)); + if (isWantedIn & NO_IMPLEMENTATION) { + isWantedIn &= ~NO_IMPLEMENTATION; + Tcl_SetHashValue(hPtr, INT2PTR(isWantedIn)); + } + } + } + } + } + + /* + * Process (normal) method names from the class hierarchy and the mixin + * hierarchy. + */ + + AddClassMethodNames(oPtr->selfCls, flags, &names); + FOREACH(mixinPtr, oPtr->mixins) { + AddClassMethodNames(mixinPtr, flags, &names); + } + + /* + * See how many (visible) method names there are. If none, we do not (and + * should not) try to sort the list of them. + */ + + i = 0; + if (names.numEntries != 0) { + const char **strings; + + /* + * We need to build the list of methods to sort. We will be using + * qsort() for this, because it is very unlikely that the list will be + * heavily sorted when it is long enough to matter. + */ + + strings = ckalloc(sizeof(char *) * names.numEntries); + FOREACH_HASH(namePtr, isWanted, &names) { + if (!(flags & PUBLIC_METHOD) || (PTR2INT(isWanted) & IN_LIST)) { + if (PTR2INT(isWanted) & NO_IMPLEMENTATION) { + continue; + } + strings[i++] = TclGetString(namePtr); + } + } + + /* + * Note that 'i' may well be less than names.numEntries when we are + * dealing with public method names. + */ + + if (i > 0) { + if (i > 1) { + qsort((void *) strings, (unsigned) i, sizeof(char *), CmpStr); + } + *stringsPtr = strings; + } else { + ckfree(strings); + } + } + + Tcl_DeleteHashTable(&names); + return i; +} + +int +TclOOGetSortedClassMethodList( + Class *clsPtr, /* The class to get the method names for. */ + int flags, /* Whether we just want the public method + * names. */ + const char ***stringsPtr) /* Where to write a pointer to the array of + * strings to. */ +{ + Tcl_HashTable names; /* Tcl_Obj* method name to "wanted in list" + * mapping. */ + FOREACH_HASH_DECLS; + int i; + Tcl_Obj *namePtr; + void *isWanted; + + Tcl_InitObjHashTable(&names); + + /* + * Process method names from the class hierarchy and the mixin hierarchy. + */ + + AddClassMethodNames(clsPtr, flags, &names); + + /* + * See how many (visible) method names there are. If none, we do not (and + * should not) try to sort the list of them. + */ + + i = 0; + if (names.numEntries != 0) { + const char **strings; + + /* + * We need to build the list of methods to sort. We will be using + * qsort() for this, because it is very unlikely that the list will be + * heavily sorted when it is long enough to matter. + */ + + strings = ckalloc(sizeof(char *) * names.numEntries); + FOREACH_HASH(namePtr, isWanted, &names) { + if (!(flags & PUBLIC_METHOD) || (PTR2INT(isWanted) & IN_LIST)) { + if (PTR2INT(isWanted) & NO_IMPLEMENTATION) { + continue; + } + strings[i++] = TclGetString(namePtr); + } + } + + /* + * Note that 'i' may well be less than names.numEntries when we are + * dealing with public method names. + */ + + if (i > 0) { + if (i > 1) { + qsort((void *) strings, (unsigned) i, sizeof(char *), CmpStr); + } + *stringsPtr = strings; + } else { + ckfree(strings); + } + } + + Tcl_DeleteHashTable(&names); + return i; +} + +/* Comparator for GetSortedMethodList */ +static int +CmpStr( + const void *ptr1, + const void *ptr2) +{ + const char **strPtr1 = (const char **) ptr1; + const char **strPtr2 = (const char **) ptr2; + + return TclpUtfNcmp2(*strPtr1, *strPtr2, strlen(*strPtr1)+1); +} + +/* + * ---------------------------------------------------------------------- + * + * AddClassMethodNames -- + * + * Adds the method names defined by a class (or its superclasses) to the + * collection being built. The collection is built in a hash table to + * ensure that duplicates are excluded. Helper for GetSortedMethodList(). + * + * ---------------------------------------------------------------------- + */ + +static void +AddClassMethodNames( + Class *clsPtr, /* Class to get method names from. */ + const int flags, /* Whether we are interested in just the + * public method names. */ + Tcl_HashTable *const namesPtr) + /* Reference to the hash table to put the + * information in. The hash table maps the + * Tcl_Obj * method name to an integral value + * describing whether the method is wanted. + * This ensures that public/private override + * semantics are handled correctly.*/ +{ + /* + * Scope all declarations so that the compiler can stand a good chance of + * making the recursive step highly efficient. We also hand-implement the + * tail-recursive case using a while loop; C compilers typically cannot do + * tail-recursion optimization usefully. + */ + + if (clsPtr->mixins.num != 0) { + Class *mixinPtr; + int i; + + /* TODO: Beware of infinite loops! */ + FOREACH(mixinPtr, clsPtr->mixins) { + AddClassMethodNames(mixinPtr, flags, namesPtr); + } + } + + while (1) { + FOREACH_HASH_DECLS; + Tcl_Obj *namePtr; + Method *mPtr; + + FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) { + int isNew; + + hPtr = Tcl_CreateHashEntry(namesPtr, (char *) namePtr, &isNew); + if (isNew) { + int isWanted = (!(flags & PUBLIC_METHOD) + || (mPtr->flags & PUBLIC_METHOD)) ? IN_LIST : 0; + + Tcl_SetHashValue(hPtr, INT2PTR(isWanted)); + } else if ((PTR2INT(Tcl_GetHashValue(hPtr)) & NO_IMPLEMENTATION) + && mPtr->typePtr != NULL) { + int isWanted = PTR2INT(Tcl_GetHashValue(hPtr)); + + isWanted &= ~NO_IMPLEMENTATION; + Tcl_SetHashValue(hPtr, INT2PTR(isWanted)); + } + } + + if (clsPtr->superclasses.num != 1) { + break; + } + clsPtr = clsPtr->superclasses.list[0]; + } + if (clsPtr->superclasses.num != 0) { + Class *superPtr; + int i; + + FOREACH(superPtr, clsPtr->superclasses) { + AddClassMethodNames(superPtr, flags, namesPtr); + } + } +} + +/* + * ---------------------------------------------------------------------- + * + * AddSimpleChainToCallContext -- + * + * The core of the call-chain construction engine, this handles calling a + * particular method on a particular object. Note that filters and + * unknown handling are already handled by the logic that uses this + * function. + * + * ---------------------------------------------------------------------- + */ + +static inline void +AddSimpleChainToCallContext( + Object *const oPtr, /* Object to add call chain entries for. */ + Tcl_Obj *const methodNameObj, + /* Name of method to add the call chain + * entries for. */ + struct ChainBuilder *const cbPtr, + /* Where to add the call chain entries. */ + Tcl_HashTable *const doneFilters, + /* Where to record what call chain entries + * have been processed. */ + int flags, /* What sort of call chain are we building. */ + Class *const filterDecl) /* The class that declared the filter. If + * NULL, either the filter was declared by the + * object or this isn't a filter. */ +{ + int i; + + if (!(flags & (KNOWN_STATE | SPECIAL)) && oPtr->methodsPtr) { + Tcl_HashEntry *hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, + (char *) methodNameObj); + + if (hPtr != NULL) { + Method *mPtr = Tcl_GetHashValue(hPtr); + + if (flags & PUBLIC_METHOD) { + if (!(mPtr->flags & PUBLIC_METHOD)) { + return; + } else { + flags |= DEFINITE_PUBLIC; + } + } else { + flags |= DEFINITE_PROTECTED; + } + } + } + if (!(flags & SPECIAL)) { + Tcl_HashEntry *hPtr; + Class *mixinPtr; + + FOREACH(mixinPtr, oPtr->mixins) { + AddSimpleClassChainToCallContext(mixinPtr, methodNameObj, cbPtr, + doneFilters, flags, filterDecl); + } + if (oPtr->methodsPtr) { + hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char*) methodNameObj); + if (hPtr != NULL) { + AddMethodToCallChain(Tcl_GetHashValue(hPtr), cbPtr, + doneFilters, filterDecl); + } + } + } + AddSimpleClassChainToCallContext(oPtr->selfCls, methodNameObj, cbPtr, + doneFilters, flags, filterDecl); +} + +/* + * ---------------------------------------------------------------------- + * + * AddMethodToCallChain -- + * + * Utility method that manages the adding of a particular method + * implementation to a call-chain. + * + * ---------------------------------------------------------------------- + */ + +static inline void +AddMethodToCallChain( + Method *const mPtr, /* Actual method implementation to add to call + * chain (or NULL, a no-op). */ + struct ChainBuilder *const cbPtr, + /* The call chain to add the method + * implementation to. */ + Tcl_HashTable *const doneFilters, + /* Where to record what filters have been + * processed. If NULL, not processing filters. + * Note that this function does not update + * this hashtable. */ + Class *const filterDecl) /* The class that declared the filter. If + * NULL, either the filter was declared by the + * object or this isn't a filter. */ +{ + register CallChain *callPtr = cbPtr->callChainPtr; + int i; + + /* + * Return if this is just an entry used to record whether this is a public + * method. If so, there's nothing real to call and so nothing to add to + * the call chain. + */ + + if (mPtr == NULL || mPtr->typePtr == NULL) { + return; + } + + /* + * Enforce real private method handling here. We will skip adding this + * method IF + * 1) we are not allowing private methods, AND + * 2) this is a private method, AND + * 3) this is a class method, AND + * 4) this method was not declared by the class of the current object. + * + * This does mean that only classes really handle private methods. This + * should be sufficient for [incr Tcl] support though. + */ + + if (!(callPtr->flags & PRIVATE_METHOD) + && (mPtr->flags & PRIVATE_METHOD) + && (mPtr->declaringClassPtr != NULL) + && (mPtr->declaringClassPtr != cbPtr->oPtr->selfCls)) { + return; + } + + /* + * First test whether the method is already in the call chain. Skip over + * any leading filters. + */ + + for (i=cbPtr->filterLength ; i<callPtr->numChain ; i++) { + if (callPtr->chain[i].mPtr == mPtr && + callPtr->chain[i].isFilter == (doneFilters != NULL)) { + /* + * Call chain semantics states that methods come as *late* in the + * call chain as possible. This is done by copying down the + * following methods. Note that this does not change the number of + * method invokations in the call chain; it just rearranges them. + */ + + Class *declCls = callPtr->chain[i].filterDeclarer; + + for (; i+1<callPtr->numChain ; i++) { + callPtr->chain[i] = callPtr->chain[i+1]; + } + callPtr->chain[i].mPtr = mPtr; + callPtr->chain[i].isFilter = (doneFilters != NULL); + callPtr->chain[i].filterDeclarer = declCls; + return; + } + } + + /* + * Need to really add the method. This is made a bit more complex by the + * fact that we are using some "static" space initially, and only start + * realloc-ing if the chain gets long. + */ + + if (callPtr->numChain == CALL_CHAIN_STATIC_SIZE) { + callPtr->chain = + ckalloc(sizeof(struct MInvoke) * (callPtr->numChain+1)); + memcpy(callPtr->chain, callPtr->staticChain, + sizeof(struct MInvoke) * callPtr->numChain); + } else if (callPtr->numChain > CALL_CHAIN_STATIC_SIZE) { + callPtr->chain = ckrealloc(callPtr->chain, + sizeof(struct MInvoke) * (callPtr->numChain + 1)); + } + callPtr->chain[i].mPtr = mPtr; + callPtr->chain[i].isFilter = (doneFilters != NULL); + callPtr->chain[i].filterDeclarer = filterDecl; + callPtr->numChain++; +} + +/* + * ---------------------------------------------------------------------- + * + * InitCallChain -- + * Encoding of the policy of how to set up a call chain. Doesn't populate + * the chain with the method implementation data. + * + * ---------------------------------------------------------------------- + */ + +static inline void +InitCallChain( + CallChain *callPtr, + Object *oPtr, + int flags) +{ + callPtr->flags = flags & + (PUBLIC_METHOD | PRIVATE_METHOD | SPECIAL | FILTER_HANDLING); + if (oPtr->flags & USE_CLASS_CACHE) { + oPtr = oPtr->selfCls->thisPtr; + callPtr->flags |= USE_CLASS_CACHE; + } + callPtr->epoch = oPtr->fPtr->epoch; + callPtr->objectCreationEpoch = oPtr->creationEpoch; + callPtr->objectEpoch = oPtr->epoch; + callPtr->refCount = 1; + callPtr->numChain = 0; + callPtr->chain = callPtr->staticChain; +} + +/* + * ---------------------------------------------------------------------- + * + * IsStillValid -- + * Calculates whether the given call chain can be used for executing a + * method for the given object. The condition on a chain from a cached + * location being reusable is: + * - Refers to the same object (same creation epoch), and + * - Still across the same class structure (same global epoch), and + * - Still across the same object strucutre (same local epoch), and + * - No public/private/filter magic leakage (same flags, modulo the fact + * that a public chain will satisfy a non-public call). + * + * ---------------------------------------------------------------------- + */ + +static inline int +IsStillValid( + CallChain *callPtr, + Object *oPtr, + int flags, + int mask) +{ + if ((oPtr->flags & USE_CLASS_CACHE)) { + oPtr = oPtr->selfCls->thisPtr; + flags |= USE_CLASS_CACHE; + } + return ((callPtr->objectCreationEpoch == oPtr->creationEpoch) + && (callPtr->epoch == oPtr->fPtr->epoch) + && (callPtr->objectEpoch == oPtr->epoch) + && ((callPtr->flags & mask) == (flags & mask))); +} + +/* + * ---------------------------------------------------------------------- + * + * TclOOGetCallContext -- + * + * Responsible for constructing the call context, an ordered list of all + * method implementations to be called as part of a method invokation. + * This method is central to the whole operation of the OO system. + * + * ---------------------------------------------------------------------- + */ + +CallContext * +TclOOGetCallContext( + Object *oPtr, /* The object to get the context for. */ + Tcl_Obj *methodNameObj, /* The name of the method to get the context + * for. NULL when getting a constructor or + * destructor chain. */ + int flags, /* What sort of context are we looking for. + * Only the bits PUBLIC_METHOD, CONSTRUCTOR, + * PRIVATE_METHOD, DESTRUCTOR and + * FILTER_HANDLING are useful. */ + Tcl_Obj *cacheInThisObj) /* What object to cache in, or NULL if it is + * to be in the same object as the + * methodNameObj. */ +{ + CallContext *contextPtr; + CallChain *callPtr; + struct ChainBuilder cb; + int i, count, doFilters; + Tcl_HashEntry *hPtr; + Tcl_HashTable doneFilters; + + if (cacheInThisObj == NULL) { + cacheInThisObj = methodNameObj; + } + if (flags&(SPECIAL|FILTER_HANDLING) || (oPtr->flags&FILTER_HANDLING)) { + hPtr = NULL; + doFilters = 0; + + /* + * Check if we have a cached valid constructor or destructor. + */ + + if (flags & CONSTRUCTOR) { + callPtr = oPtr->selfCls->constructorChainPtr; + if ((callPtr != NULL) + && (callPtr->objectEpoch == oPtr->selfCls->thisPtr->epoch) + && (callPtr->epoch == oPtr->fPtr->epoch)) { + callPtr->refCount++; + goto returnContext; + } + } else if (flags & DESTRUCTOR) { + callPtr = oPtr->selfCls->destructorChainPtr; + if ((oPtr->mixins.num == 0) && (callPtr != NULL) + && (callPtr->objectEpoch == oPtr->selfCls->thisPtr->epoch) + && (callPtr->epoch == oPtr->fPtr->epoch)) { + callPtr->refCount++; + goto returnContext; + } + } + } else { + /* + * Check if we can get the chain out of the Tcl_Obj method name or out + * of the cache. This is made a bit more complex by the fact that + * there are multiple different layers of cache (in the Tcl_Obj, in + * the object, and in the class). + */ + + const int reuseMask = ((flags & PUBLIC_METHOD) ? ~0 : ~PUBLIC_METHOD); + + if (cacheInThisObj->typePtr == &methodNameType) { + callPtr = cacheInThisObj->internalRep.twoPtrValue.ptr1; + if (IsStillValid(callPtr, oPtr, flags, reuseMask)) { + callPtr->refCount++; + goto returnContext; + } + FreeMethodNameRep(cacheInThisObj); + } + + if (oPtr->flags & USE_CLASS_CACHE) { + if (oPtr->selfCls->classChainCache != NULL) { + hPtr = Tcl_FindHashEntry(oPtr->selfCls->classChainCache, + (char *) methodNameObj); + } else { + hPtr = NULL; + } + } else { + if (oPtr->chainCache != NULL) { + hPtr = Tcl_FindHashEntry(oPtr->chainCache, + (char *) methodNameObj); + } else { + hPtr = NULL; + } + } + + if (hPtr != NULL && Tcl_GetHashValue(hPtr) != NULL) { + callPtr = Tcl_GetHashValue(hPtr); + if (IsStillValid(callPtr, oPtr, flags, reuseMask)) { + callPtr->refCount++; + goto returnContext; + } + Tcl_SetHashValue(hPtr, NULL); + TclOODeleteChain(callPtr); + } + + doFilters = 1; + } + + callPtr = ckalloc(sizeof(CallChain)); + InitCallChain(callPtr, oPtr, flags); + + cb.callChainPtr = callPtr; + cb.filterLength = 0; + cb.oPtr = oPtr; + + /* + * If we're working with a forced use of unknown, do that now. + */ + + if (flags & FORCE_UNKNOWN) { + AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj, + &cb, NULL, 0, NULL); + callPtr->flags |= OO_UNKNOWN_METHOD; + callPtr->epoch = -1; + if (callPtr->numChain == 0) { + TclOODeleteChain(callPtr); + return NULL; + } + goto returnContext; + } + + /* + * Add all defined filters (if any, and if we're going to be processing + * them; they're not processed for constructors, destructors or when we're + * in the middle of processing a filter). + */ + + if (doFilters) { + Tcl_Obj *filterObj; + Class *mixinPtr; + + doFilters = 1; + Tcl_InitObjHashTable(&doneFilters); + FOREACH(mixinPtr, oPtr->mixins) { + AddClassFiltersToCallContext(oPtr, mixinPtr, &cb, &doneFilters); + } + FOREACH(filterObj, oPtr->filters) { + AddSimpleChainToCallContext(oPtr, filterObj, &cb, &doneFilters, 0, + NULL); + } + AddClassFiltersToCallContext(oPtr, oPtr->selfCls, &cb, &doneFilters); + Tcl_DeleteHashTable(&doneFilters); + } + count = cb.filterLength = callPtr->numChain; + + /* + * Add the actual method implementations. + */ + + AddSimpleChainToCallContext(oPtr, methodNameObj, &cb, NULL, flags, NULL); + + /* + * Check to see if the method has no implementation. If so, we probably + * need to add in a call to the unknown method. Otherwise, set up the + * cacheing of the method implementation (if relevant). + */ + + if (count == callPtr->numChain) { + /* + * Method does not actually exist. If we're dealing with constructors + * or destructors, this isn't a problem. + */ + + if (flags & SPECIAL) { + TclOODeleteChain(callPtr); + return NULL; + } + AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj, + &cb, NULL, 0, NULL); + callPtr->flags |= OO_UNKNOWN_METHOD; + callPtr->epoch = -1; + if (count == callPtr->numChain) { + TclOODeleteChain(callPtr); + return NULL; + } + } else if (doFilters) { + if (hPtr == NULL) { + if (oPtr->flags & USE_CLASS_CACHE) { + if (oPtr->selfCls->classChainCache == NULL) { + oPtr->selfCls->classChainCache = + ckalloc(sizeof(Tcl_HashTable)); + + Tcl_InitObjHashTable(oPtr->selfCls->classChainCache); + } + hPtr = Tcl_CreateHashEntry(oPtr->selfCls->classChainCache, + (char *) methodNameObj, &i); + } else { + if (oPtr->chainCache == NULL) { + oPtr->chainCache = ckalloc(sizeof(Tcl_HashTable)); + + Tcl_InitObjHashTable(oPtr->chainCache); + } + hPtr = Tcl_CreateHashEntry(oPtr->chainCache, + (char *) methodNameObj, &i); + } + } + callPtr->refCount++; + Tcl_SetHashValue(hPtr, callPtr); + StashCallChain(cacheInThisObj, callPtr); + } else if (flags & CONSTRUCTOR) { + if (oPtr->selfCls->constructorChainPtr) { + TclOODeleteChain(oPtr->selfCls->constructorChainPtr); + } + oPtr->selfCls->constructorChainPtr = callPtr; + callPtr->refCount++; + } else if ((flags & DESTRUCTOR) && oPtr->mixins.num == 0) { + if (oPtr->selfCls->destructorChainPtr) { + TclOODeleteChain(oPtr->selfCls->destructorChainPtr); + } + oPtr->selfCls->destructorChainPtr = callPtr; + callPtr->refCount++; + } + + returnContext: + contextPtr = TclStackAlloc(oPtr->fPtr->interp, sizeof(CallContext)); + contextPtr->oPtr = oPtr; + AddRef(oPtr); + contextPtr->callPtr = callPtr; + contextPtr->skip = 2; + contextPtr->index = 0; + return contextPtr; +} + +/* + * ---------------------------------------------------------------------- + * + * TclOOGetStereotypeCallChain -- + * + * Construct a call-chain for a method that would be used by a + * stereotypical instance of the given class (i.e., where the object has + * no definitions special to itself). + * + * ---------------------------------------------------------------------- + */ + +CallChain * +TclOOGetStereotypeCallChain( + Class *clsPtr, /* The object to get the context for. */ + Tcl_Obj *methodNameObj, /* The name of the method to get the context + * for. NULL when getting a constructor or + * destructor chain. */ + int flags) /* What sort of context are we looking for. + * Only the bits PUBLIC_METHOD, CONSTRUCTOR, + * PRIVATE_METHOD, DESTRUCTOR and + * FILTER_HANDLING are useful. */ +{ + CallChain *callPtr; + struct ChainBuilder cb; + int i, count; + Foundation *fPtr = clsPtr->thisPtr->fPtr; + Tcl_HashEntry *hPtr; + Tcl_HashTable doneFilters; + Object obj; + + /* + * Synthesize a temporary stereotypical object so that we can use existing + * machinery to produce the stereotypical call chain. + */ + + memset(&obj, 0, sizeof(Object)); + obj.fPtr = fPtr; + obj.selfCls = clsPtr; + obj.refCount = 1; + obj.flags = USE_CLASS_CACHE; + + /* + * Check if we can get the chain out of the Tcl_Obj method name or out of + * the cache. This is made a bit more complex by the fact that there are + * multiple different layers of cache (in the Tcl_Obj, in the object, and + * in the class). + */ + + if (clsPtr->classChainCache != NULL) { + hPtr = Tcl_FindHashEntry(clsPtr->classChainCache, + (char *) methodNameObj); + if (hPtr != NULL && Tcl_GetHashValue(hPtr) != NULL) { + const int reuseMask = + ((flags & PUBLIC_METHOD) ? ~0 : ~PUBLIC_METHOD); + + callPtr = Tcl_GetHashValue(hPtr); + if (IsStillValid(callPtr, &obj, flags, reuseMask)) { + callPtr->refCount++; + return callPtr; + } + Tcl_SetHashValue(hPtr, NULL); + TclOODeleteChain(callPtr); + } + } else { + hPtr = NULL; + } + + callPtr = ckalloc(sizeof(CallChain)); + memset(callPtr, 0, sizeof(CallChain)); + callPtr->flags = flags & (PUBLIC_METHOD|PRIVATE_METHOD|FILTER_HANDLING); + callPtr->epoch = fPtr->epoch; + callPtr->objectCreationEpoch = fPtr->tsdPtr->nsCount; + callPtr->objectEpoch = clsPtr->thisPtr->epoch; + callPtr->refCount = 1; + callPtr->chain = callPtr->staticChain; + + cb.callChainPtr = callPtr; + cb.filterLength = 0; + cb.oPtr = &obj; + + /* + * Add all defined filters (if any, and if we're going to be processing + * them; they're not processed for constructors, destructors or when we're + * in the middle of processing a filter). + */ + + Tcl_InitObjHashTable(&doneFilters); + AddClassFiltersToCallContext(&obj, clsPtr, &cb, &doneFilters); + Tcl_DeleteHashTable(&doneFilters); + count = cb.filterLength = callPtr->numChain; + + /* + * Add the actual method implementations. + */ + + AddSimpleChainToCallContext(&obj, methodNameObj, &cb, NULL, flags, NULL); + + /* + * Check to see if the method has no implementation. If so, we probably + * need to add in a call to the unknown method. Otherwise, set up the + * cacheing of the method implementation (if relevant). + */ + + if (count == callPtr->numChain) { + AddSimpleChainToCallContext(&obj, fPtr->unknownMethodNameObj, &cb, + NULL, 0, NULL); + callPtr->flags |= OO_UNKNOWN_METHOD; + callPtr->epoch = -1; + if (count == callPtr->numChain) { + TclOODeleteChain(callPtr); + return NULL; + } + } else { + if (hPtr == NULL) { + if (clsPtr->classChainCache == NULL) { + clsPtr->classChainCache = ckalloc(sizeof(Tcl_HashTable)); + Tcl_InitObjHashTable(clsPtr->classChainCache); + } + hPtr = Tcl_CreateHashEntry(clsPtr->classChainCache, + (char *) methodNameObj, &i); + } + callPtr->refCount++; + Tcl_SetHashValue(hPtr, callPtr); + StashCallChain(methodNameObj, callPtr); + } + return callPtr; +} + +/* + * ---------------------------------------------------------------------- + * + * AddClassFiltersToCallContext -- + * + * Logic to make extracting all the filters from the class context much + * easier. + * + * ---------------------------------------------------------------------- + */ + +static void +AddClassFiltersToCallContext( + Object *const oPtr, /* Object that the filters operate on. */ + Class *clsPtr, /* Class to get the filters from. */ + struct ChainBuilder *const cbPtr, + /* Context to fill with call chain entries. */ + Tcl_HashTable *const doneFilters) + /* Where to record what filters have been + * processed. Keys are objects, values are + * ignored. */ +{ + int i; + Class *superPtr, *mixinPtr; + Tcl_Obj *filterObj; + + tailRecurse: + if (clsPtr == NULL) { + return; + } + + /* + * Add all the filters defined by classes mixed into the main class + * hierarchy. + */ + + FOREACH(mixinPtr, clsPtr->mixins) { + AddClassFiltersToCallContext(oPtr, mixinPtr, cbPtr, doneFilters); + } + + /* + * Add all the class filters from the current class. Note that the filters + * are added starting at the object root, as this allows the object to + * override how filters work to extend their behaviour. + */ + + FOREACH(filterObj, clsPtr->filters) { + int isNew; + + (void) Tcl_CreateHashEntry(doneFilters, (char *) filterObj, &isNew); + if (isNew) { + AddSimpleChainToCallContext(oPtr, filterObj, cbPtr, doneFilters, + 0, clsPtr); + } + } + + /* + * Now process the recursive case. Notice the tail-call optimization. + */ + + switch (clsPtr->superclasses.num) { + case 1: + clsPtr = clsPtr->superclasses.list[0]; + goto tailRecurse; + default: + FOREACH(superPtr, clsPtr->superclasses) { + AddClassFiltersToCallContext(oPtr, superPtr, cbPtr, doneFilters); + } + case 0: + return; + } +} + +/* + * ---------------------------------------------------------------------- + * + * AddSimpleClassChainToCallContext -- + * + * Construct a call-chain from a class hierarchy. + * + * ---------------------------------------------------------------------- + */ + +static void +AddSimpleClassChainToCallContext( + Class *classPtr, /* Class to add the call chain entries for. */ + Tcl_Obj *const methodNameObj, + /* Name of method to add the call chain + * entries for. */ + struct ChainBuilder *const cbPtr, + /* Where to add the call chain entries. */ + Tcl_HashTable *const doneFilters, + /* Where to record what call chain entries + * have been processed. */ + int flags, /* What sort of call chain are we building. */ + Class *const filterDecl) /* The class that declared the filter. If + * NULL, either the filter was declared by the + * object or this isn't a filter. */ +{ + int i; + Class *superPtr; + + /* + * We hard-code the tail-recursive form. It's by far the most common case + * *and* it is much more gentle on the stack. + * + * Note that mixins must be processed before the main class hierarchy. + * [Bug 1998221] + */ + + tailRecurse: + FOREACH(superPtr, classPtr->mixins) { + AddSimpleClassChainToCallContext(superPtr, methodNameObj, cbPtr, + doneFilters, flags, filterDecl); + } + + if (flags & CONSTRUCTOR) { + AddMethodToCallChain(classPtr->constructorPtr, cbPtr, doneFilters, + filterDecl); + + } else if (flags & DESTRUCTOR) { + AddMethodToCallChain(classPtr->destructorPtr, cbPtr, doneFilters, + filterDecl); + } else { + Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods, + (char *) methodNameObj); + + if (hPtr != NULL) { + register Method *mPtr = Tcl_GetHashValue(hPtr); + + if (!(flags & KNOWN_STATE)) { + if (flags & PUBLIC_METHOD) { + if (mPtr->flags & PUBLIC_METHOD) { + flags |= DEFINITE_PUBLIC; + } else { + return; + } + } else { + flags |= DEFINITE_PROTECTED; + } + } + AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl); + } + } + + switch (classPtr->superclasses.num) { + case 1: + classPtr = classPtr->superclasses.list[0]; + goto tailRecurse; + default: + FOREACH(superPtr, classPtr->superclasses) { + AddSimpleClassChainToCallContext(superPtr, methodNameObj, cbPtr, + doneFilters, flags, filterDecl); + } + case 0: + return; + } +} + +/* + * ---------------------------------------------------------------------- + * + * TclOORenderCallChain -- + * + * Create a description of a call chain. Used in [info object call], + * [info class call], and [self call]. + * + * ---------------------------------------------------------------------- + */ + +Tcl_Obj * +TclOORenderCallChain( + Tcl_Interp *interp, + CallChain *callPtr) +{ + Tcl_Obj *filterLiteral, *methodLiteral, *objectLiteral; + Tcl_Obj *resultObj, *descObjs[4], **objv; + Foundation *fPtr = TclOOGetFoundation(interp); + int i; + + /* + * Allocate the literals (potentially) used in our description. + */ + + filterLiteral = Tcl_NewStringObj("filter", -1); + Tcl_IncrRefCount(filterLiteral); + methodLiteral = Tcl_NewStringObj("method", -1); + Tcl_IncrRefCount(methodLiteral); + objectLiteral = Tcl_NewStringObj("object", -1); + Tcl_IncrRefCount(objectLiteral); + + /* + * Do the actual construction of the descriptions. They consist of a list + * of triples that describe the details of how a method is understood. For + * each triple, the first word is the type of invokation ("method" is + * normal, "unknown" is special because it adds the method name as an + * extra argument when handled by some method types, and "filter" is + * special because it's a filter method). The second word is the name of + * the method in question (which differs for "unknown" and "filter" types) + * and the third word is the full name of the class that declares the + * method (or "object" if it is declared on the instance). + */ + + objv = TclStackAlloc(interp, callPtr->numChain * sizeof(Tcl_Obj *)); + for (i=0 ; i<callPtr->numChain ; i++) { + struct MInvoke *miPtr = &callPtr->chain[i]; + + descObjs[0] = miPtr->isFilter + ? filterLiteral + : callPtr->flags & OO_UNKNOWN_METHOD + ? fPtr->unknownMethodNameObj + : methodLiteral; + descObjs[1] = callPtr->flags & CONSTRUCTOR + ? fPtr->constructorName + : callPtr->flags & DESTRUCTOR + ? fPtr->destructorName + : miPtr->mPtr->namePtr; + descObjs[2] = miPtr->mPtr->declaringClassPtr + ? Tcl_GetObjectName(interp, + (Tcl_Object) miPtr->mPtr->declaringClassPtr->thisPtr) + : objectLiteral; + descObjs[3] = Tcl_NewStringObj(miPtr->mPtr->typePtr->name, -1); + + objv[i] = Tcl_NewListObj(4, descObjs); + } + + /* + * Drop the local references to the literals; if they're actually used, + * they'll live on the description itself. + */ + + Tcl_DecrRefCount(filterLiteral); + Tcl_DecrRefCount(methodLiteral); + Tcl_DecrRefCount(objectLiteral); + + /* + * Finish building the description and return it. + */ + + resultObj = Tcl_NewListObj(callPtr->numChain, objv); + TclStackFree(interp, objv); + return resultObj; +} + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |