summaryrefslogtreecommitdiffstats
path: root/generic/tclOOCall.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclOOCall.c')
-rw-r--r--generic/tclOOCall.c223
1 files changed, 221 insertions, 2 deletions
diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c
index 1e8d1a3..3954a6b 100644
--- a/generic/tclOOCall.c
+++ b/generic/tclOOCall.c
@@ -104,8 +104,10 @@ TclOODeleteContext(
register Object *oPtr = contextPtr->oPtr;
TclOODeleteChain(contextPtr->callPtr);
- TclStackFree(oPtr->fPtr->interp, contextPtr);
- DelRef(oPtr);
+ if (oPtr != NULL) {
+ TclStackFree(oPtr->fPtr->interp, contextPtr);
+ DelRef(oPtr);
+ }
}
/*
@@ -1099,6 +1101,137 @@ TclOOGetCallContext(
/*
* ----------------------------------------------------------------------
*
+ * 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 = (CallChain *) 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 = (Tcl_HashTable *)
+ 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
@@ -1256,6 +1389,92 @@ AddSimpleClassChainToCallContext(
}
/*
+ * ----------------------------------------------------------------------
+ *
+ * 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);
+ Tcl_IncrRefCount(objv[i]);
+ }
+
+ /*
+ * 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