diff options
Diffstat (limited to 'generic/tclOOCall.c')
| -rw-r--r-- | generic/tclOOCall.c | 803 |
1 files changed, 803 insertions, 0 deletions
diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c new file mode 100644 index 0000000..71663e4 --- /dev/null +++ b/generic/tclOOCall.c @@ -0,0 +1,803 @@ +/* + * tclOO.c -- + * + * This file contains the method call chain management code for the + * object-system core. + * + * Copyright (c) 2005-2006 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. + * + * RCS: @(#) $Id: tclOOCall.c,v 1.2 2006/10/20 14:04:01 dkf Exp $ + */ + +#include "tclInt.h" +#include "tclOO.h" + +/* + * Extra flags used for call chain management. + */ + +#define DEFINITE_PRIVATE 0x100000 +#define DEFINITE_PUBLIC 0x200000 +#define KNOWN_STATE (DEFINITE_PRIVATE | DEFINITE_PUBLIC) +#define SPECIAL (CONSTRUCTOR | DESTRUCTOR) + +/* + * Function declarations for things defined in this file. + */ + +static void AddClassFiltersToCallContext(Object *oPtr, + Class *clsPtr, CallContext *contextPtr, + Tcl_HashTable *doneFilters); +static void AddClassMethodNames(Class *clsPtr, int publicOnly, + Tcl_HashTable *namesPtr); +static void AddMethodToCallChain(Method *mPtr, + CallContext *contextPtr, + Tcl_HashTable *doneFilters); +static void AddSimpleChainToCallContext(Object *oPtr, + Tcl_Obj *methodNameObj, CallContext *contextPtr, + Tcl_HashTable *doneFilters, int isPublic); +static void AddSimpleClassChainToCallContext(Class *classPtr, + Tcl_Obj *methodNameObj, CallContext *contextPtr, + Tcl_HashTable *doneFilters, int isPublic); +static int CmpStr(const void *ptr1, const void *ptr2); +static void InitClassHierarchy(Foundation *fPtr, Class *classPtr); + +/* + * ---------------------------------------------------------------------- + * + * TclOODeleteContext -- + * + * Destroys a method call-chain context, which should not be in use. + * + * ---------------------------------------------------------------------- + */ + +void +TclOODeleteContext( + CallContext *contextPtr) +{ + if (contextPtr->callChain != contextPtr->staticCallChain) { + ckfree((char *) contextPtr->callChain); + } + ckfree((char *) contextPtr); +} + +/* + * ---------------------------------------------------------------------- + * + * 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( + Tcl_Interp *interp, /* Interpreter for error reporting, and many + * other sorts of context handling (e.g., + * commands, variables) depending on method + * implementation. */ + CallContext *contextPtr, /* The method call context. */ + int objc, /* The number of arguments. */ + Tcl_Obj *const *objv) /* The arguments as actually seen. */ +{ + Method *mPtr = contextPtr->callChain[contextPtr->index].mPtr; + int result, isFirst = (contextPtr->index == 0); + int isFilter = contextPtr->callChain[contextPtr->index].isFilter; + int wasFilter; + + /* + * 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 (isFirst) { + int i; + + for (i=0 ; i<contextPtr->numCallChain ; i++) { + Tcl_Preserve(contextPtr->callChain[i].mPtr); + } + } + + /* + * Save whether we were in a filter and set up whether we are now. + */ + + wasFilter = contextPtr->oPtr->flags & FILTER_HANDLING; + if (isFilter || contextPtr->flags & FILTER_HANDLING) { + contextPtr->oPtr->flags |= FILTER_HANDLING; + } else { + contextPtr->oPtr->flags &= ~FILTER_HANDLING; + } + + /* + * Run the method implementation. + */ + + result = mPtr->typePtr->callProc(mPtr->clientData, interp, + (Tcl_ObjectContext) contextPtr, objc, objv); + + /* + * Restore the old filter-ness, release any locks on method + * implementations, and return the result code. + */ + + if (wasFilter) { + contextPtr->oPtr->flags |= FILTER_HANDLING; + } else { + contextPtr->oPtr->flags &= ~FILTER_HANDLING; + } + if (isFirst) { + int i; + + for (i=0 ; i<contextPtr->numCallChain ; i++) { + Tcl_Release(contextPtr->callChain[i].mPtr); + } + } + return result; +} + +static void +InitClassHierarchy( + Foundation *fPtr, + Class *classPtr) +{ + if (classPtr == fPtr->objectCls) { + return; + } + if (classPtr->classHierarchyEpoch != fPtr->epoch) { + int i; + Class *superPtr; + + if (classPtr->classHierarchy.num != 0) { + ckfree((char *) classPtr->classHierarchy.list); + } + FOREACH(superPtr, classPtr->superclasses) { + InitClassHierarchy(fPtr, superPtr); + } + if (i == 1) { + Class **hierlist = (Class **) + ckalloc(sizeof(Class*) * (1+superPtr->classHierarchy.num)); + + hierlist[0] = superPtr; + memcpy(hierlist+1, superPtr->classHierarchy.list, + sizeof(Class*) * superPtr->classHierarchy.num); + classPtr->classHierarchy.num = 1 + superPtr->classHierarchy.num; + classPtr->classHierarchy.list = hierlist; + classPtr->classHierarchyEpoch = fPtr->epoch; + return; + } else { + int num = classPtr->superclasses.num, j = 0, k, realNum; + Class **hierlist; /* Temporary work space. */ + + FOREACH(superPtr, classPtr->superclasses) { + num += superPtr->classHierarchy.num; + } + hierlist = (Class **) ckalloc(sizeof(Class *) * num); + FOREACH(superPtr, classPtr->superclasses) { + hierlist[j++] = superPtr; + if (superPtr == fPtr->objectCls) { + continue; + } + memcpy(hierlist+j, superPtr->classHierarchy.list, + sizeof(Class *) * superPtr->classHierarchy.num); + j += superPtr->classHierarchy.num; + } + realNum = num; + for (j=0 ; j<num-1 ; j++) { + for (k=num-1 ; k>j ; k--) { + if (hierlist[j] == hierlist[k]) { + hierlist[j] = NULL; + realNum--; + break; + } + } + } + classPtr->classHierarchy.num = realNum; + classPtr->classHierarchy.list = (Class **) + ckalloc(sizeof(Class *) * realNum); + for (j=k=0 ; j<num ; j++) { + if (hierlist[j] != NULL) { + classPtr->classHierarchy.list[k++] = hierlist[j]; + } + } + ckfree((char *) hierlist); + } + } +} + +/* + * ---------------------------------------------------------------------- + * + * TclOOGetSortedMethodList -- + * + * Discovers the list of method names supported by an object. + * + * ---------------------------------------------------------------------- + */ + +int +TclOOGetSortedMethodList( + Object *oPtr, /* The object to get the method names for. */ + int publicOnly, /* 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; + FOREACH_HASH_DECLS; + int i; + const char **strings; + Class *mixinPtr; + Tcl_Obj *namePtr; + Method *mPtr; + void *isWanted; + + Tcl_InitObjHashTable(&names); + + FOREACH_HASH(namePtr, mPtr, &oPtr->methods) { + int isNew; + + hPtr = Tcl_CreateHashEntry(&names, (char *) namePtr, &isNew); + if (isNew) { + isWanted = (void *) (!publicOnly || mPtr->flags & PUBLIC_METHOD); + Tcl_SetHashValue(hPtr, isWanted); + } + } + + AddClassMethodNames(oPtr->selfCls, publicOnly, &names); + FOREACH(mixinPtr, oPtr->mixins) { + AddClassMethodNames(mixinPtr, publicOnly, &names); + } + + if (names.numEntries == 0) { + Tcl_DeleteHashTable(&names); + return 0; + } + + strings = (const char **) ckalloc(sizeof(char *) * names.numEntries); + i = 0; + FOREACH_HASH(namePtr, isWanted, &names) { + if (!publicOnly || isWanted) { + strings[i++] = TclGetString(namePtr); + } + } + + /* + * Note that 'i' may well be less than names.numEntries when we are + * dealing with public method names. + */ + + qsort(strings, (unsigned) i, sizeof(char *), CmpStr); + + Tcl_DeleteHashTable(&names); + *stringsPtr = strings; + 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 publicOnly, /* 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, publicOnly, 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 = (!publicOnly || mPtr->flags & PUBLIC_METHOD); + + Tcl_SetHashValue(hPtr, (void *) 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, publicOnly, namesPtr); + } + } +} + +/* + * ---------------------------------------------------------------------- + * + * 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( + Foundation *fPtr, /* The foundation of the object system. */ + 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 OO_PUBLIC_METHOD, + * CONSTRUCTOR, DESTRUCTOR and FILTER_HANDLING + * are useful. */ + Tcl_HashTable *cachePtr) /* Where to cache the chain. Ignored for both + * constructors and destructors. */ +{ + CallContext *contextPtr; + int i, count, doFilters; + Tcl_HashEntry *hPtr; + Tcl_HashTable doneFilters; + + if (flags&(SPECIAL|FILTER_HANDLING) || (oPtr->flags&FILTER_HANDLING)) { + hPtr = NULL; + doFilters = 0; + } else { + doFilters = 1; + hPtr = Tcl_FindHashEntry(cachePtr, (char *) methodNameObj); + if (hPtr != NULL && Tcl_GetHashValue(hPtr) != NULL) { + contextPtr = Tcl_GetHashValue(hPtr); + Tcl_SetHashValue(hPtr, NULL); + if ((contextPtr->globalEpoch == fPtr->epoch) + && (contextPtr->localEpoch == oPtr->epoch)) { + return contextPtr; + } + TclOODeleteContext(contextPtr); + } + } + contextPtr = (CallContext *) ckalloc(sizeof(CallContext)); + contextPtr->numCallChain = 0; + contextPtr->callChain = contextPtr->staticCallChain; + contextPtr->filterLength = 0; + contextPtr->globalEpoch = fPtr->epoch; + contextPtr->localEpoch = oPtr->epoch; + contextPtr->flags = 0; + contextPtr->skip = 2; + if (flags & (PUBLIC_METHOD | SPECIAL | FILTER_HANDLING)) { + contextPtr->flags |= flags & (PUBLIC_METHOD|SPECIAL|FILTER_HANDLING); + } + contextPtr->oPtr = oPtr; + contextPtr->index = 0; + + /* + * Ensure that the class hierarchy is trivially iterable. + */ + + InitClassHierarchy(fPtr, oPtr->selfCls); + + /* + * 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, contextPtr, + &doneFilters); + } + FOREACH(filterObj, oPtr->filters) { + AddSimpleChainToCallContext(oPtr, filterObj, contextPtr, + &doneFilters, 0); + } + AddClassFiltersToCallContext(oPtr, oPtr->selfCls, contextPtr, + &doneFilters); + Tcl_DeleteHashTable(&doneFilters); + } + count = contextPtr->filterLength = contextPtr->numCallChain; + + /* + * Add the actual method implementations. + */ + + AddSimpleChainToCallContext(oPtr, methodNameObj, contextPtr, NULL, flags); + + /* + * 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 == contextPtr->numCallChain) { + /* + * Method does not actually exist. If we're dealing with constructors + * or destructors, this isn't a problem. + */ + + if (flags & SPECIAL) { + TclOODeleteContext(contextPtr); + return NULL; + } + AddSimpleChainToCallContext(oPtr, fPtr->unknownMethodNameObj, + contextPtr, NULL, 0); + contextPtr->flags |= OO_UNKNOWN_METHOD; + contextPtr->globalEpoch = -1; + if (count == contextPtr->numCallChain) { + TclOODeleteContext(contextPtr); + return NULL; + } + } else if (doFilters) { + if (hPtr == NULL) { + hPtr = Tcl_CreateHashEntry(cachePtr, (char *) methodNameObj, &i); + } + Tcl_SetHashValue(hPtr, NULL); + } + return contextPtr; +} + +/* + * ---------------------------------------------------------------------- + * + * 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. */ + CallContext *const contextPtr, + /* 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; + Tcl_Obj *filterObj; + + tailRecurse: + if (clsPtr == NULL) { + return; + } + + /* + * 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, contextPtr, + doneFilters, 0); + } + } + + /* + * 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, contextPtr, + doneFilters); + } + case 0: + return; + } +} + +/* + * ---------------------------------------------------------------------- + * + * 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 void +AddSimpleChainToCallContext( + Object *oPtr, /* Object to add call chain entries for. */ + Tcl_Obj *methodNameObj, /* Name of method to add the call chain + * entries for. */ + CallContext *contextPtr, /* Where to add the call chain entries. */ + Tcl_HashTable *doneFilters, /* Where to record what call chain entries + * have been processed. */ + int flags) /* What sort of call chain are we building. */ +{ + int i; + + if (!(flags & (KNOWN_STATE | SPECIAL))) { + Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&oPtr->methods, + (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_PRIVATE; + } + } + } + if (!(flags & SPECIAL)) { + Tcl_HashEntry *hPtr; + Class *mixinPtr, *superPtr; + + FOREACH(mixinPtr, oPtr->mixins) { + AddSimpleClassChainToCallContext(mixinPtr, methodNameObj, + contextPtr, doneFilters, flags); + } + FOREACH(mixinPtr, oPtr->selfCls->mixins) { + AddSimpleClassChainToCallContext(mixinPtr, methodNameObj, + contextPtr, doneFilters, flags); + } + FOREACH(superPtr, oPtr->selfCls->classHierarchy) { + int j=i;// HACK: save index so we can nest FOREACHes + FOREACH(mixinPtr, superPtr->mixins) { + AddSimpleClassChainToCallContext(mixinPtr, methodNameObj, + contextPtr, doneFilters, flags); + } + i=j; + } + hPtr = Tcl_FindHashEntry(&oPtr->methods, (char *) methodNameObj); + if (hPtr != NULL) { + AddMethodToCallChain(Tcl_GetHashValue(hPtr), contextPtr, + doneFilters); + } + } + AddSimpleClassChainToCallContext(oPtr->selfCls, methodNameObj, contextPtr, + doneFilters, flags); +} + +/* + * ---------------------------------------------------------------------- + * + * 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. */ + CallContext *const contextPtr, + /* 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. */ +{ + /* + * 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: + if (flags & CONSTRUCTOR) { + AddMethodToCallChain(classPtr->constructorPtr, contextPtr, + doneFilters); + } else if (flags & DESTRUCTOR) { + AddMethodToCallChain(classPtr->destructorPtr, contextPtr, + doneFilters); + } 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_PRIVATE; + } + } + AddMethodToCallChain(mPtr, contextPtr, doneFilters); + } + } + + switch (classPtr->superclasses.num) { + case 1: + classPtr = classPtr->superclasses.list[0]; + goto tailRecurse; + default: + { + int i; + Class *superPtr; + + FOREACH(superPtr, classPtr->superclasses) { + AddSimpleClassChainToCallContext(superPtr, methodNameObj, + contextPtr, doneFilters, flags); + } + } + case 0: + return; + } +} + +/* + * ---------------------------------------------------------------------- + * + * AddMethodToCallChain -- + * + * Utility method that manages the adding of a particular method + * implementation to a call-chain. + * + * ---------------------------------------------------------------------- + */ + +static void +AddMethodToCallChain( + Method *mPtr, /* Actual method implementation to add to call + * chain (or NULL, a no-op). */ + CallContext *contextPtr, /* The call chain to add the method + * implementation to. */ + Tcl_HashTable *doneFilters) /* Where to record what filters have been + * processed. If NULL, not processing filters. + * Note that this function does not update + * this hashtable. */ +{ + 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; + } + + /* + * First test whether the method is already in the call chain. Skip over + * any leading filters. + */ + + for (i=contextPtr->filterLength ; i<contextPtr->numCallChain ; i++) { + if (contextPtr->callChain[i].mPtr == mPtr + && contextPtr->callChain[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. + */ + + for (; i+1<contextPtr->numCallChain ; i++) { + contextPtr->callChain[i] = contextPtr->callChain[i+1]; + } + contextPtr->callChain[i].mPtr = mPtr; + contextPtr->callChain[i].isFilter = (doneFilters != NULL); + 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 (contextPtr->numCallChain == CALL_CHAIN_STATIC_SIZE) { + contextPtr->callChain = (struct MInvoke *) + ckalloc(sizeof(struct MInvoke)*(contextPtr->numCallChain+1)); + memcpy(contextPtr->callChain, contextPtr->staticCallChain, + sizeof(struct MInvoke) * (contextPtr->numCallChain + 1)); + } else if (contextPtr->numCallChain > CALL_CHAIN_STATIC_SIZE) { + contextPtr->callChain = (struct MInvoke *) + ckrealloc((char *) contextPtr->callChain, + sizeof(struct MInvoke) * (contextPtr->numCallChain + 1)); + } + contextPtr->callChain[contextPtr->numCallChain].mPtr = mPtr; + contextPtr->callChain[contextPtr->numCallChain].isFilter = + (doneFilters != NULL); + contextPtr->numCallChain++; +} + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |