/* * tclOOCall.c -- * * This file contains the method call chain management code for the * object-system core. * * Copyright © 2005-2012 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" #include /* * 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. */ size_t 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. */ }; /* * Structures used for traversing the class hierarchy to find out where * definitions are supposed to be done. */ typedef struct { Class *definerCls; Tcl_Obj *namespaceName; } DefineEntry; typedef struct { DefineEntry *list; int num; int size; } DefineChain; /* * 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) #define BUILDING_MIXINS 0x400000 #define TRAVERSED_MIXIN 0x800000 #define OBJECT_MIXIN 0x1000000 #define MIXIN_CONSISTENT(flags) \ (((flags) & OBJECT_MIXIN) || \ !((flags) & BUILDING_MIXINS) == !((flags) & TRAVERSED_MIXIN)) /* * Note that the flag bit PRIVATE_METHOD has a confusing name; it's just for * Itcl's special type of private. */ #define IS_PUBLIC(mPtr) \ (((mPtr)->flags & PUBLIC_METHOD) != 0) #define IS_UNEXPORTED(mPtr) \ (((mPtr)->flags & SCOPE_FLAGS) == 0) #define IS_ITCLPRIVATE(mPtr) \ (((mPtr)->flags & PRIVATE_METHOD) != 0) #define IS_PRIVATE(mPtr) \ (((mPtr)->flags & TRUE_PRIVATE_METHOD) != 0) #define WANT_PUBLIC(flags) \ (((flags) & PUBLIC_METHOD) != 0) #define WANT_UNEXPORTED(flags) \ (((flags) & (PRIVATE_METHOD | TRUE_PRIVATE_METHOD)) == 0) #define WANT_ITCLPRIVATE(flags) \ (((flags) & PRIVATE_METHOD) != 0) #define WANT_PRIVATE(flags) \ (((flags) & TRUE_PRIVATE_METHOD) != 0) /* * Function declarations for things defined in this file. */ static void AddClassFiltersToCallContext(Object *const oPtr, Class *clsPtr, struct ChainBuilder *const cbPtr, Tcl_HashTable *const doneFilters, int flags); static void AddClassMethodNames(Class *clsPtr, int flags, Tcl_HashTable *const namesPtr, Tcl_HashTable *const examinedClassesPtr); static inline void AddDefinitionNamespaceToChain(Class *const definerCls, Tcl_Obj *const namespaceName, DefineChain *const definePtr, int flags); static inline void AddMethodToCallChain(Method *const mPtr, struct ChainBuilder *const cbPtr, Tcl_HashTable *const doneFilters, Class *const filterDecl, int flags); static inline int AddInstancePrivateToCallContext(Object *const oPtr, Tcl_Obj *const methodNameObj, struct ChainBuilder *const cbPtr, int flags); static inline void AddStandardMethodName(int flags, Tcl_Obj *namePtr, Method *mPtr, Tcl_HashTable *namesPtr); static inline void AddPrivateMethodNames(Tcl_HashTable *methodsTablePtr, Tcl_HashTable *namesPtr); static inline int AddSimpleChainToCallContext(Object *const oPtr, Class *const contextCls, Tcl_Obj *const methodNameObj, struct ChainBuilder *const cbPtr, Tcl_HashTable *const doneFilters, int flags, Class *const filterDecl); static int AddPrivatesFromClassChainToCallContext(Class *classPtr, Class *const contextCls, Tcl_Obj *const methodNameObj, struct ChainBuilder *const cbPtr, Tcl_HashTable *const doneFilters, int flags, Class *const filterDecl); static int AddSimpleClassChainToCallContext(Class *classPtr, Tcl_Obj *const methodNameObj, struct ChainBuilder *const cbPtr, Tcl_HashTable *const doneFilters, int flags, Class *const filterDecl); static void AddSimpleClassDefineNamespaces(Class *classPtr, DefineChain *const definePtr, int flags); static inline void AddSimpleDefineNamespaces(Object *const oPtr, DefineChain *const definePtr, int flags); static int CmpStr(const void *ptr1, const void *ptr2); static void DupMethodNameRep(Tcl_Obj *srcPtr, Tcl_Obj *dstPtr); static Tcl_NRPostProc FinalizeMethodRefs; static void FreeMethodNameRep(Tcl_Obj *objPtr); static inline int IsStillValid(CallChain *callPtr, Object *oPtr, int flags, int reuseMask); static Tcl_NRPostProc ResetFilterFlags; static Tcl_NRPostProc SetFilterFlags; static size_t SortMethodNames(Tcl_HashTable *namesPtr, int flags, const char ***stringsPtr); 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, TCL_OBJTYPE_V0 }; /* * ---------------------------------------------------------------------- * * TclOODeleteContext -- * * Destroys a method call-chain context, which should not be in use. * * ---------------------------------------------------------------------- */ void TclOODeleteContext( CallContext *contextPtr) { Object *oPtr = contextPtr->oPtr; TclOODeleteChain(contextPtr->callPtr); if (oPtr != NULL) { TclStackFree(oPtr->fPtr->interp, contextPtr); /* * Corresponding AddRef() in TclOO.c/TclOOObjectCmdCore */ TclOODecrRefCount(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); Tcl_Free(tablePtr); } /* * ---------------------------------------------------------------------- * * TclOODeleteChain -- * * Destroys a method call-chain. * * ---------------------------------------------------------------------- */ void TclOODeleteChain( CallChain *callPtr) { if (callPtr == NULL || callPtr->refCount-- > 1) { return; } if (callPtr->chain != callPtr->staticChain) { Tcl_Free(callPtr->chain); } Tcl_Free(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) { Tcl_ObjInternalRep ir; callPtr->refCount++; TclGetString(objPtr); ir.twoPtrValue.ptr1 = callPtr; Tcl_StoreInternalRep(objPtr, &methodNameType, &ir); } 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) { StashCallChain(dstPtr, (CallChain *)TclFetchInternalRep(srcPtr, &methodNameType)->twoPtrValue.ptr1); } static void FreeMethodNameRep( Tcl_Obj *objPtr) { TclOODeleteChain( (CallChain *)TclFetchInternalRep(objPtr, &methodNameType)->twoPtrValue.ptr1); } /* * ---------------------------------------------------------------------- * * TclOOInvokeContext -- * * Invokes a single step along a method call-chain context. Note that the * invocation 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( void *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. */ { CallContext *const contextPtr = (CallContext *)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) { size_t 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. */ if (mPtr->typePtr->version < TCL_OO_METHOD_VERSION_2) { return (mPtr->typePtr->callProc)(mPtr->clientData, interp, (Tcl_ObjectContext) contextPtr, objc, objv); } return ((Tcl_MethodCallProc2 *)(void *)(mPtr->typePtr->callProc))(mPtr->clientData, interp, (Tcl_ObjectContext) contextPtr, objc, objv); } static int SetFilterFlags( void *data[], TCL_UNUSED(Tcl_Interp *), int result) { CallContext *contextPtr = (CallContext *)data[0]; contextPtr->oPtr->flags |= FILTER_HANDLING; return result; } static int ResetFilterFlags( void *data[], TCL_UNUSED(Tcl_Interp *), int result) { CallContext *contextPtr = (CallContext *)data[0]; contextPtr->oPtr->flags &= ~FILTER_HANDLING; return result; } static int FinalizeMethodRefs( void *data[], TCL_UNUSED(Tcl_Interp *), int result) { CallContext *contextPtr = (CallContext *)data[0]; size_t 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. */ Object *contextObj, /* From what context object we are inquiring. * NULL when the context shouldn't see * object-level private methods. Note that * flags can override this. */ Class *contextCls, /* From what context class we are inquiring. * NULL when the context shouldn't see * class-level private methods. Note that * flags can override this. */ 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. */ Tcl_HashTable examinedClasses; /* Used to track what classes have been looked * at. Is set-like in nature and keyed by * pointer to class. */ FOREACH_HASH_DECLS; size_t i, numStrings; Class *mixinPtr; Tcl_Obj *namePtr; Method *mPtr; Tcl_InitObjHashTable(&names); Tcl_InitHashTable(&examinedClasses, TCL_ONE_WORD_KEYS); /* * 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) { if (IS_PRIVATE(mPtr)) { continue; } if (IS_UNEXPORTED(mPtr) && !WANT_UNEXPORTED(flags)) { continue; } AddStandardMethodName(flags, namePtr, mPtr, &names); } } /* * Process method names due to private methods on the object's class. */ if (WANT_UNEXPORTED(flags)) { FOREACH_HASH(namePtr, mPtr, &oPtr->selfCls->classMethods) { if (IS_UNEXPORTED(mPtr)) { AddStandardMethodName(flags, namePtr, mPtr, &names); } } } /* * Process method names due to private methods on the context's object or * class. Which must be correct if either are not NULL. */ if (contextObj && contextObj->methodsPtr) { AddPrivateMethodNames(contextObj->methodsPtr, &names); } if (contextCls) { AddPrivateMethodNames(&contextCls->classMethods, &names); } /* * Process (normal) method names from the class hierarchy and the mixin * hierarchy. */ AddClassMethodNames(oPtr->selfCls, flags, &names, &examinedClasses); FOREACH(mixinPtr, oPtr->mixins) { AddClassMethodNames(mixinPtr, flags | TRAVERSED_MIXIN, &names, &examinedClasses); } /* * Tidy up, sort the names and resolve finally whether we really want * them (processing export layering). */ Tcl_DeleteHashTable(&examinedClasses); numStrings = SortMethodNames(&names, flags, stringsPtr); Tcl_DeleteHashTable(&names); return numStrings; } size_t 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. */ Tcl_HashTable examinedClasses; /* Used to track what classes have been looked * at. Is set-like in nature and keyed by * pointer to class. */ size_t numStrings; Tcl_InitObjHashTable(&names); Tcl_InitHashTable(&examinedClasses, TCL_ONE_WORD_KEYS); /* * Process method names from the class hierarchy and the mixin hierarchy. */ AddClassMethodNames(clsPtr, flags, &names, &examinedClasses); Tcl_DeleteHashTable(&examinedClasses); /* * Process private method names if we should. [TIP 500] */ if (WANT_PRIVATE(flags)) { AddPrivateMethodNames(&clsPtr->classMethods, &names); flags &= ~TRUE_PRIVATE_METHOD; } /* * Tidy up, sort the names and resolve finally whether we really want * them (processing export layering). */ numStrings = SortMethodNames(&names, flags, stringsPtr); Tcl_DeleteHashTable(&names); return numStrings; } /* * ---------------------------------------------------------------------- * * SortMethodNames -- * * Shared helper for TclOOGetSortedMethodList etc. that knows the method * sorting rules. * * Returns: * The length of the sorted list. * * ---------------------------------------------------------------------- */ static size_t SortMethodNames( Tcl_HashTable *namesPtr, /* The table of names; unsorted, but contains * whether the names are wanted and under what * circumstances. */ int flags, /* Whether we are looking for unexported * methods. Full private methods are handled * on insertion to the table. */ const char ***stringsPtr) /* Where to store the sorted list of strings * that we produce. Tcl_Alloced() */ { const char **strings; FOREACH_HASH_DECLS; Tcl_Obj *namePtr; void *isWanted; size_t i = 0; /* * See how many (visible) method names there are. If none, we do not (and * should not) try to sort the list of them. */ if (namesPtr->numEntries == 0) { *stringsPtr = NULL; return 0; } /* * 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 = (const char **)Tcl_Alloc(sizeof(char *) * namesPtr->numEntries); FOREACH_HASH(namePtr, isWanted, namesPtr) { if (!WANT_PUBLIC(flags) || (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. We don't sort unless there's at least * two method names. */ if (i > 0) { if (i > 1) { qsort((void *) strings, i, sizeof(char *), CmpStr); } *stringsPtr = strings; } else { Tcl_Free((void *)strings); *stringsPtr = NULL; } return i; } /* * Comparator for SortMethodNames */ 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. */ 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. */ Tcl_HashTable *const examinedClassesPtr) /* Hash table that tracks what classes have * already been looked at. The keys are the * pointers to the classes, and the values are * immaterial. */ { size_t i; /* * If we've already started looking at this class, stop working on it now * to prevent repeated work. */ if (Tcl_FindHashEntry(examinedClassesPtr, clsPtr)) { return; } /* * 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. */ while (1) { FOREACH_HASH_DECLS; Tcl_Obj *namePtr; Method *mPtr; int isNew; (void) Tcl_CreateHashEntry(examinedClassesPtr, clsPtr, &isNew); if (!isNew) { break; } if (clsPtr->mixins.num != 0) { Class *mixinPtr; FOREACH(mixinPtr, clsPtr->mixins) { if (mixinPtr != clsPtr) { AddClassMethodNames(mixinPtr, flags|TRAVERSED_MIXIN, namesPtr, examinedClassesPtr); } } } FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) { AddStandardMethodName(flags, namePtr, mPtr, namesPtr); } if (clsPtr->superclasses.num != 1) { break; } clsPtr = clsPtr->superclasses.list[0]; } if (clsPtr->superclasses.num != 0) { Class *superPtr; FOREACH(superPtr, clsPtr->superclasses) { AddClassMethodNames(superPtr, flags, namesPtr, examinedClassesPtr); } } } /* * ---------------------------------------------------------------------- * * AddPrivateMethodNames, AddStandardMethodName -- * * Factored-out helpers for the sorted name list production functions. * * ---------------------------------------------------------------------- */ static inline void AddPrivateMethodNames( Tcl_HashTable *methodsTablePtr, Tcl_HashTable *namesPtr) { FOREACH_HASH_DECLS; Method *mPtr; Tcl_Obj *namePtr; FOREACH_HASH(namePtr, mPtr, methodsTablePtr) { if (IS_PRIVATE(mPtr)) { int isNew; hPtr = Tcl_CreateHashEntry(namesPtr, namePtr, &isNew); Tcl_SetHashValue(hPtr, INT2PTR(IN_LIST)); } } } static inline void AddStandardMethodName( int flags, Tcl_Obj *namePtr, Method *mPtr, Tcl_HashTable *namesPtr) { if (!IS_PRIVATE(mPtr)) { int isNew; Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(namesPtr, namePtr, &isNew); if (isNew) { int isWanted = (!WANT_PUBLIC(flags) || IS_PUBLIC(mPtr)) ? IN_LIST : 0; isWanted |= (mPtr->typePtr == NULL ? NO_IMPLEMENTATION : 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)); } } } #undef IN_LIST #undef NO_IMPLEMENTATION /* * ---------------------------------------------------------------------- * * AddInstancePrivateToCallContext -- * * Add private methods from the instance. Called when the calling Tcl * context is a TclOO method declared by an object that is the same as * the current object. Returns true iff a private method was actually * found and added to the call chain (as this suppresses caching). * * ---------------------------------------------------------------------- */ static inline int AddInstancePrivateToCallContext( Object *const oPtr, /* Object to add call chain entries for. */ Tcl_Obj *const methodName, /* Name of method to add the call chain * entries for. */ struct ChainBuilder *const cbPtr, /* Where to add the call chain entries. */ int flags) /* What sort of call chain are we building. */ { Tcl_HashEntry *hPtr; Method *mPtr; int donePrivate = 0; if (oPtr->methodsPtr) { hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, methodName); if (hPtr != NULL) { mPtr = (Method *)Tcl_GetHashValue(hPtr); if (IS_PRIVATE(mPtr)) { AddMethodToCallChain(mPtr, cbPtr, NULL, NULL, flags); donePrivate = 1; } } } return donePrivate; } /* * ---------------------------------------------------------------------- * * 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. Returns true if a private method was one of those found. * * ---------------------------------------------------------------------- */ static inline int AddSimpleChainToCallContext( Object *const oPtr, /* Object to add call chain entries for. */ Class *const contextCls, /* Context class; the currently considered * class is equal to this, private methods may * also be added. [TIP 500] */ 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. */ { size_t i; int foundPrivate = 0, blockedUnexported = 0; Tcl_HashEntry *hPtr; Method *mPtr; if (!(flags & (KNOWN_STATE | SPECIAL)) && oPtr->methodsPtr) { hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, methodNameObj); if (hPtr != NULL) { mPtr = (Method *)Tcl_GetHashValue(hPtr); if (!IS_PRIVATE(mPtr)) { if (WANT_PUBLIC(flags)) { if (!IS_PUBLIC(mPtr)) { blockedUnexported = 1; } else { flags |= DEFINITE_PUBLIC; } } else { flags |= DEFINITE_PROTECTED; } } } } if (!(flags & SPECIAL)) { Class *mixinPtr; FOREACH(mixinPtr, oPtr->mixins) { if (contextCls) { foundPrivate |= AddPrivatesFromClassChainToCallContext( mixinPtr, contextCls, methodNameObj, cbPtr, doneFilters, flags|TRAVERSED_MIXIN, filterDecl); } foundPrivate |= AddSimpleClassChainToCallContext(mixinPtr, methodNameObj, cbPtr, doneFilters, flags | TRAVERSED_MIXIN, filterDecl); } if (oPtr->methodsPtr && !blockedUnexported) { hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, methodNameObj); if (hPtr != NULL) { mPtr = (Method *)Tcl_GetHashValue(hPtr); if (!IS_PRIVATE(mPtr)) { AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl, flags); } } } } if (contextCls) { foundPrivate |= AddPrivatesFromClassChainToCallContext(oPtr->selfCls, contextCls, methodNameObj, cbPtr, doneFilters, flags, filterDecl); } if (!blockedUnexported) { foundPrivate |= AddSimpleClassChainToCallContext(oPtr->selfCls, methodNameObj, cbPtr, doneFilters, flags, filterDecl); } return foundPrivate; } /* * ---------------------------------------------------------------------- * * 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. */ int flags) /* Used to check if we're mixin-consistent * only. Mixin-consistent means that either * we're looking to add things from a mixin * and we have passed a mixin, or we're not * looking to add things from a mixin and have * not passed a mixin. */ { CallChain *callPtr = cbPtr->callChainPtr; size_t 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. * * This is also where we enforce mixin-consistency. */ if (mPtr == NULL || mPtr->typePtr == NULL || !MIXIN_CONSISTENT(flags)) { 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 (!WANT_UNEXPORTED(callPtr->flags) && IS_UNEXPORTED(mPtr) && (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 invocations 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 = (struct MInvoke *)Tcl_Alloc(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 = (struct MInvoke *)Tcl_Realloc(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 structure (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 invocation. * 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. */ Object *contextObj, /* Context object; when equal to oPtr, it * means that private methods may also be * added. [TIP 500] */ Class *contextCls, /* Context class; the currently considered * class is equal to this, private methods may * also be added. [TIP 500] */ 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; size_t i, count; int doFilters, donePrivate = 0; 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 Tcl_ObjInternalRep *irPtr; const int reuseMask = (WANT_PUBLIC(flags) ? ~0 : ~PUBLIC_METHOD); if ((irPtr = TclFetchInternalRep(cacheInThisObj, &methodNameType))) { callPtr = (CallChain *)irPtr->twoPtrValue.ptr1; if (IsStillValid(callPtr, oPtr, flags, reuseMask)) { callPtr->refCount++; goto returnContext; } Tcl_StoreInternalRep(cacheInThisObj, &methodNameType, NULL); } if (oPtr->flags & USE_CLASS_CACHE) { if (oPtr->selfCls->classChainCache != NULL) { hPtr = Tcl_FindHashEntry(oPtr->selfCls->classChainCache, methodNameObj); } else { hPtr = NULL; } } else { if (oPtr->chainCache != NULL) { hPtr = Tcl_FindHashEntry(oPtr->chainCache, methodNameObj); } else { hPtr = NULL; } } if (hPtr != NULL && Tcl_GetHashValue(hPtr) != NULL) { callPtr = (CallChain *)Tcl_GetHashValue(hPtr); if (IsStillValid(callPtr, oPtr, flags, reuseMask)) { callPtr->refCount++; goto returnContext; } Tcl_SetHashValue(hPtr, NULL); TclOODeleteChain(callPtr); } doFilters = 1; } callPtr = (CallChain *)Tcl_Alloc(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, NULL, oPtr->fPtr->unknownMethodNameObj, &cb, NULL, BUILDING_MIXINS, NULL); AddSimpleChainToCallContext(oPtr, NULL, oPtr->fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL); callPtr->flags |= OO_UNKNOWN_METHOD; callPtr->epoch = 0; 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, TRAVERSED_MIXIN|BUILDING_MIXINS|OBJECT_MIXIN); AddClassFiltersToCallContext(oPtr, mixinPtr, &cb, &doneFilters, OBJECT_MIXIN); } FOREACH(filterObj, oPtr->filters) { donePrivate |= AddSimpleChainToCallContext(oPtr, contextCls, filterObj, &cb, &doneFilters, BUILDING_MIXINS, NULL); donePrivate |= AddSimpleChainToCallContext(oPtr, contextCls, filterObj, &cb, &doneFilters, 0, NULL); } AddClassFiltersToCallContext(oPtr, oPtr->selfCls, &cb, &doneFilters, BUILDING_MIXINS); AddClassFiltersToCallContext(oPtr, oPtr->selfCls, &cb, &doneFilters, 0); Tcl_DeleteHashTable(&doneFilters); } count = cb.filterLength = callPtr->numChain; /* * Add the actual method implementations. We have to do this twice to * handle class mixins right. */ if (oPtr == contextObj) { donePrivate |= AddInstancePrivateToCallContext(oPtr, methodNameObj, &cb, flags); donePrivate |= (contextObj->flags & HAS_PRIVATE_METHODS); } donePrivate |= AddSimpleChainToCallContext(oPtr, contextCls, methodNameObj, &cb, NULL, flags|BUILDING_MIXINS, NULL); donePrivate |= AddSimpleChainToCallContext(oPtr, contextCls, 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, NULL, oPtr->fPtr->unknownMethodNameObj, &cb, NULL, BUILDING_MIXINS, NULL); AddSimpleChainToCallContext(oPtr, NULL, oPtr->fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL); callPtr->flags |= OO_UNKNOWN_METHOD; callPtr->epoch = 0; if (count == callPtr->numChain) { TclOODeleteChain(callPtr); return NULL; } } else if (doFilters && !donePrivate) { if (hPtr == NULL) { int isNew; if (oPtr->flags & USE_CLASS_CACHE) { if (oPtr->selfCls->classChainCache == NULL) { oPtr->selfCls->classChainCache = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitObjHashTable(oPtr->selfCls->classChainCache); } hPtr = Tcl_CreateHashEntry(oPtr->selfCls->classChainCache, methodNameObj, &isNew); } else { if (oPtr->chainCache == NULL) { oPtr->chainCache = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitObjHashTable(oPtr->chainCache); } hPtr = Tcl_CreateHashEntry(oPtr->chainCache, methodNameObj, &isNew); } } 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 = (CallContext *)TclStackAlloc(oPtr->fPtr->interp, sizeof(CallContext)); contextPtr->oPtr = oPtr; /* * Corresponding TclOODecrRefCount() in TclOODeleteContext */ 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; size_t 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, methodNameObj); if (hPtr != NULL && Tcl_GetHashValue(hPtr) != NULL) { const int reuseMask = (WANT_PUBLIC(flags) ? ~0 : ~PUBLIC_METHOD); callPtr = (CallChain *)Tcl_GetHashValue(hPtr); if (IsStillValid(callPtr, &obj, flags, reuseMask)) { callPtr->refCount++; return callPtr; } Tcl_SetHashValue(hPtr, NULL); TclOODeleteChain(callPtr); } } else { hPtr = NULL; } callPtr = (CallChain *)Tcl_Alloc(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, BUILDING_MIXINS); AddClassFiltersToCallContext(&obj, clsPtr, &cb, &doneFilters, 0); Tcl_DeleteHashTable(&doneFilters); count = cb.filterLength = callPtr->numChain; /* * Add the actual method implementations. */ AddSimpleChainToCallContext(&obj, NULL, methodNameObj, &cb, NULL, flags|BUILDING_MIXINS, NULL); AddSimpleChainToCallContext(&obj, NULL, 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, NULL, fPtr->unknownMethodNameObj, &cb, NULL, BUILDING_MIXINS, NULL); AddSimpleChainToCallContext(&obj, NULL, fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL); callPtr->flags |= OO_UNKNOWN_METHOD; callPtr->epoch = 0; if (count == callPtr->numChain) { TclOODeleteChain(callPtr); return NULL; } } else { if (hPtr == NULL) { int isNew; if (clsPtr->classChainCache == NULL) { clsPtr->classChainCache = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitObjHashTable(clsPtr->classChainCache); } hPtr = Tcl_CreateHashEntry(clsPtr->classChainCache, methodNameObj, &isNew); } 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 flags) /* Whether we've gone along a mixin link * yet. */ { size_t i; int clearedFlags = flags & ~(TRAVERSED_MIXIN|OBJECT_MIXIN|BUILDING_MIXINS); 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, flags|TRAVERSED_MIXIN); } /* * 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. */ if (MIXIN_CONSISTENT(flags)) { FOREACH(filterObj, clsPtr->filters) { int isNew; (void) Tcl_CreateHashEntry(doneFilters, filterObj, &isNew); if (isNew) { AddSimpleChainToCallContext(oPtr, NULL, filterObj, cbPtr, doneFilters, clearedFlags|BUILDING_MIXINS, clsPtr); AddSimpleChainToCallContext(oPtr, NULL, filterObj, cbPtr, doneFilters, clearedFlags, 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, flags); } case 0: return; } } /* * ---------------------------------------------------------------------- * * AddPrivatesFromClassChainToCallContext -- * * Helper for AddSimpleChainToCallContext that is used to find private * methds and add them to the call chain. Returns true when a private * method is found and added. [TIP 500] * * ---------------------------------------------------------------------- */ static int AddPrivatesFromClassChainToCallContext( Class *classPtr, /* Class to add the call chain entries for. */ Class *const contextCls, /* Context class; the currently considered * class is equal to this, private methods may * also be added. */ Tcl_Obj *const methodName, /* 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. */ { size_t 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) { if (AddPrivatesFromClassChainToCallContext(superPtr, contextCls, methodName, cbPtr, doneFilters, flags|TRAVERSED_MIXIN, filterDecl)) { return 1; } } if (classPtr == contextCls) { Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods, methodName); if (hPtr != NULL) { Method *mPtr = (Method *)Tcl_GetHashValue(hPtr); if (IS_PRIVATE(mPtr)) { AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl, flags); return 1; } } } switch (classPtr->superclasses.num) { case 1: classPtr = classPtr->superclasses.list[0]; goto tailRecurse; default: FOREACH(superPtr, classPtr->superclasses) { if (AddPrivatesFromClassChainToCallContext(superPtr, contextCls, methodName, cbPtr, doneFilters, flags, filterDecl)) { return 1; } } /* FALLTHRU */ case 0: return 0; } } /* * ---------------------------------------------------------------------- * * AddSimpleClassChainToCallContext -- * * Construct a call-chain from a class hierarchy. * * ---------------------------------------------------------------------- */ static int 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. */ { size_t i; int privateDanger = 0; 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) { privateDanger |= AddSimpleClassChainToCallContext(superPtr, methodNameObj, cbPtr, doneFilters, flags | TRAVERSED_MIXIN, filterDecl); } if (flags & CONSTRUCTOR) { AddMethodToCallChain(classPtr->constructorPtr, cbPtr, doneFilters, filterDecl, flags); } else if (flags & DESTRUCTOR) { AddMethodToCallChain(classPtr->destructorPtr, cbPtr, doneFilters, filterDecl, flags); } else { Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods, methodNameObj); if (classPtr->flags & HAS_PRIVATE_METHODS) { privateDanger |= 1; } if (hPtr != NULL) { Method *mPtr = (Method *)Tcl_GetHashValue(hPtr); if (!IS_PRIVATE(mPtr)) { if (!(flags & KNOWN_STATE)) { if (flags & PUBLIC_METHOD) { if (!IS_PUBLIC(mPtr)) { return privateDanger; } flags |= DEFINITE_PUBLIC; } else { flags |= DEFINITE_PROTECTED; } } AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl, flags); } } } switch (classPtr->superclasses.num) { case 1: classPtr = classPtr->superclasses.list[0]; goto tailRecurse; default: FOREACH(superPtr, classPtr->superclasses) { privateDanger |= AddSimpleClassChainToCallContext(superPtr, methodNameObj, cbPtr, doneFilters, flags, filterDecl); } /* FALLTHRU */ case 0: return privateDanger; } } /* * ---------------------------------------------------------------------- * * 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, *privateLiteral; Tcl_Obj *resultObj, *descObjs[4], **objv; Foundation *fPtr = TclOOGetFoundation(interp); size_t i; /* * Allocate the literals (potentially) used in our description. */ TclNewLiteralStringObj(filterLiteral, "filter"); Tcl_IncrRefCount(filterLiteral); TclNewLiteralStringObj(methodLiteral, "method"); Tcl_IncrRefCount(methodLiteral); TclNewLiteralStringObj(objectLiteral, "object"); Tcl_IncrRefCount(objectLiteral); TclNewLiteralStringObj(privateLiteral, "private"); Tcl_IncrRefCount(privateLiteral); /* * 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 invocation ("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 = (Tcl_Obj **)TclStackAlloc(interp, callPtr->numChain * sizeof(Tcl_Obj *)); for (i = 0 ; i < (size_t)callPtr->numChain ; i++) { struct MInvoke *miPtr = &callPtr->chain[i]; descObjs[0] = miPtr->isFilter ? filterLiteral : callPtr->flags & OO_UNKNOWN_METHOD ? fPtr->unknownMethodNameObj : IS_PRIVATE(miPtr->mPtr) ? privateLiteral : 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); Tcl_DecrRefCount(privateLiteral); /* * Finish building the description and return it. */ resultObj = Tcl_NewListObj(callPtr->numChain, objv); TclStackFree(interp, objv); return resultObj; } /* * ---------------------------------------------------------------------- * * TclOOGetDefineContextNamespace -- * * Responsible for determining which namespace to use for definitions. * This is done by building a define chain, which models (strongly!) the * way that a call chain works but with a different internal model. * * Then it walks the chain to find the first namespace name that actually * resolves to an existing namespace. * * Returns: * Name of namespace, or NULL if none can be found. Note that this * function does *not* set an error message in the interpreter on failure. * * ---------------------------------------------------------------------- */ #define DEFINE_CHAIN_STATIC_SIZE 4 /* Enough space to store most cases. */ Tcl_Namespace * TclOOGetDefineContextNamespace( Tcl_Interp *interp, /* In what interpreter should namespace names * actually be resolved. */ Object *oPtr, /* The object to get the context for. */ int forClass) /* What sort of context are we looking for. * If true, we are going to use this for * [oo::define], otherwise, we are going to * use this for [oo::objdefine]. */ { DefineChain define; DefineEntry staticSpace[DEFINE_CHAIN_STATIC_SIZE]; DefineEntry *entryPtr; Tcl_Namespace *nsPtr = NULL; int i; define.list = staticSpace; define.num = 0; define.size = DEFINE_CHAIN_STATIC_SIZE; /* * Add the actual define locations. We have to do this twice to handle * class mixins right. */ AddSimpleDefineNamespaces(oPtr, &define, forClass | BUILDING_MIXINS); AddSimpleDefineNamespaces(oPtr, &define, forClass); /* * Go through the list until we find a namespace whose name we can * resolve. */ FOREACH_STRUCT(entryPtr, define) { if (TclGetNamespaceFromObj(interp, entryPtr->namespaceName, &nsPtr) == TCL_OK) { break; } Tcl_ResetResult(interp); } if (define.list != staticSpace) { Tcl_Free(define.list); } return nsPtr; } /* * ---------------------------------------------------------------------- * * AddSimpleDefineNamespaces -- * * Adds to the definition chain all the definitions provided by an * object's class and its mixins, taking into account everything they * inherit from. * * ---------------------------------------------------------------------- */ static inline void AddSimpleDefineNamespaces( Object *const oPtr, /* Object to add define chain entries for. */ DefineChain *const definePtr, /* Where to add the define chain entries. */ int flags) /* What sort of define chain are we * building. */ { Class *mixinPtr; size_t i; FOREACH(mixinPtr, oPtr->mixins) { AddSimpleClassDefineNamespaces(mixinPtr, definePtr, flags | TRAVERSED_MIXIN); } AddSimpleClassDefineNamespaces(oPtr->selfCls, definePtr, flags); } /* * ---------------------------------------------------------------------- * * AddSimpleClassDefineNamespaces -- * * Adds to the definition chain all the definitions provided by a class * and its superclasses and its class mixins. * * ---------------------------------------------------------------------- */ static void AddSimpleClassDefineNamespaces( Class *classPtr, /* Class to add the define chain entries for. */ DefineChain *const definePtr, /* Where to add the define chain entries. */ int flags) /* What sort of define chain are we * building. */ { size_t 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. */ tailRecurse: FOREACH(superPtr, classPtr->mixins) { AddSimpleClassDefineNamespaces(superPtr, definePtr, flags | TRAVERSED_MIXIN); } if (flags & ~(TRAVERSED_MIXIN | BUILDING_MIXINS)) { AddDefinitionNamespaceToChain(classPtr, classPtr->clsDefinitionNs, definePtr, flags); } else { AddDefinitionNamespaceToChain(classPtr, classPtr->objDefinitionNs, definePtr, flags); } switch (classPtr->superclasses.num) { case 1: classPtr = classPtr->superclasses.list[0]; goto tailRecurse; default: FOREACH(superPtr, classPtr->superclasses) { AddSimpleClassDefineNamespaces(superPtr, definePtr, flags); } case 0: return; } } /* * ---------------------------------------------------------------------- * * AddDefinitionNamespaceToChain -- * * Adds a single item to the definition chain (if it is meaningful), * reallocating the space for the chain if necessary. * * ---------------------------------------------------------------------- */ static inline void AddDefinitionNamespaceToChain( Class *const definerCls, /* What class defines this entry. */ Tcl_Obj *const namespaceName, /* The name for this entry (or NULL, a * no-op). */ DefineChain *const definePtr, /* The define chain to add the method * implementation to. */ int flags) /* Used to check if we're mixin-consistent * only. Mixin-consistent means that either * we're looking to add things from a mixin * and we have passed a mixin, or we're not * looking to add things from a mixin and have * not passed a mixin. */ { int i; /* * Return if this entry is blank. This is also where we enforce * mixin-consistency. */ if (namespaceName == NULL || !MIXIN_CONSISTENT(flags)) { return; } /* * First test whether the method is already in the call chain. */ for (i=0 ; inum ; i++) { if (definePtr->list[i].definerCls == definerCls) { /* * 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 invocations in the call chain; it just rearranges them. * * We skip changing anything if the place we found was already at * the end of the list. */ if (i < definePtr->num - 1) { memmove(&definePtr->list[i], &definePtr->list[i + 1], sizeof(DefineEntry) * (definePtr->num - i - 1)); definePtr->list[i].definerCls = definerCls; definePtr->list[i].namespaceName = namespaceName; } return; } } /* * Need to really add the define. 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 (definePtr->num == definePtr->size) { definePtr->size *= 2; if (definePtr->num == DEFINE_CHAIN_STATIC_SIZE) { DefineEntry *staticList = definePtr->list; definePtr->list = (DefineEntry *)Tcl_Alloc(sizeof(DefineEntry) * definePtr->size); memcpy(definePtr->list, staticList, sizeof(DefineEntry) * definePtr->num); } else { definePtr->list = (DefineEntry *)Tcl_Realloc(definePtr->list, sizeof(DefineEntry) * definePtr->size); } } definePtr->list[i].definerCls = definerCls; definePtr->list[i].namespaceName = namespaceName; definePtr->num++; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */