1 /*
2 * tclOOCall.c --
3 *
4 * This file contains the method call chain management code for the
5 * object-system core.
6 *
7 * Copyright (c) 2005-2012 by Donal K. Fellows
8 *
9 * See the file "license.terms" for information on usage and redistribution of
10 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
11 */
12
13 #ifdef HAVE_CONFIG_H
14 #include "config.h"
15 #endif
16 #include "tclInt.h"
17 #include "tclOOInt.h"
18
19 /*
20 * Structure containing a CallContext and any other values needed only during
21 * the construction of the CallContext.
22 */
23
24 struct ChainBuilder {
25 CallChain *callChainPtr; /* The call chain being built. */
26 int filterLength; /* Number of entries in the call chain that
27 * are due to processing filters and not the
28 * main call chain. */
29 Object *oPtr; /* The object that we are building the chain
30 * for. */
31 };
32
33 /*
34 * Extra flags used for call chain management.
35 */
36
37 #define DEFINITE_PROTECTED 0x100000
38 #define DEFINITE_PUBLIC 0x200000
39 #define KNOWN_STATE (DEFINITE_PROTECTED | DEFINITE_PUBLIC)
40 #define SPECIAL (CONSTRUCTOR | DESTRUCTOR | FORCE_UNKNOWN)
41 #define BUILDING_MIXINS 0x400000
42 #define TRAVERSED_MIXIN 0x800000
43 #define OBJECT_MIXIN 0x1000000
44 #define MIXIN_CONSISTENT(flags) \
45 (((flags) & OBJECT_MIXIN) || \
46 !((flags) & BUILDING_MIXINS) == !((flags) & TRAVERSED_MIXIN))
47
48 /*
49 * Function declarations for things defined in this file.
50 */
51
52 static void AddClassFiltersToCallContext(Object *const oPtr,
53 Class *clsPtr, struct ChainBuilder *const cbPtr,
54 Tcl_HashTable *const doneFilters, int flags);
55 static void AddClassMethodNames(Class *clsPtr, const int flags,
56 Tcl_HashTable *const namesPtr,
57 Tcl_HashTable *const examinedClassesPtr);
58 static inline void AddMethodToCallChain(Method *const mPtr,
59 struct ChainBuilder *const cbPtr,
60 Tcl_HashTable *const doneFilters,
61 Class *const filterDecl, int flags);
62 static inline void AddSimpleChainToCallContext(Object *const oPtr,
63 Tcl_Obj *const methodNameObj,
64 struct ChainBuilder *const cbPtr,
65 Tcl_HashTable *const doneFilters, int flags,
66 Class *const filterDecl);
67 static void AddSimpleClassChainToCallContext(Class *classPtr,
68 Tcl_Obj *const methodNameObj,
69 struct ChainBuilder *const cbPtr,
70 Tcl_HashTable *const doneFilters, int flags,
71 Class *const filterDecl);
72 static int CmpStr(const void *ptr1, const void *ptr2);
73 static void DupMethodNameRep(Tcl_Obj *srcPtr, Tcl_Obj *dstPtr);
74 static Tcl_NRPostProc FinalizeMethodRefs;
75 static void FreeMethodNameRep(Tcl_Obj *objPtr);
76 static inline int IsStillValid(CallChain *callPtr, Object *oPtr,
77 int flags, int reuseMask);
78 static Tcl_NRPostProc ResetFilterFlags;
79 static Tcl_NRPostProc SetFilterFlags;
80 static inline void StashCallChain(Tcl_Obj *objPtr, CallChain *callPtr);
81
82 /*
83 * Object type used to manage type caches attached to method names.
84 */
85
86 static const Tcl_ObjType methodNameType = {
87 "TclOO method name",
88 FreeMethodNameRep,
89 DupMethodNameRep,
90 NULL,
91 NULL
92 };
93
94 /*
95 * ----------------------------------------------------------------------
96 *
97 * TclOODeleteContext --
98 *
99 * Destroys a method call-chain context, which should not be in use.
100 *
101 * ----------------------------------------------------------------------
102 */
103
104 void
TclOODeleteContext(CallContext * contextPtr)105 TclOODeleteContext(
106 CallContext *contextPtr)
107 {
108 Object *oPtr = contextPtr->oPtr;
109
110 TclOODeleteChain(contextPtr->callPtr);
111 if (oPtr != NULL) {
112 TclStackFree(oPtr->fPtr->interp, contextPtr);
113
114 /*
115 * Corresponding AddRef() in TclOO.c/TclOOObjectCmdCore
116 */
117
118 TclOODecrRefCount(oPtr);
119 }
120 }
121
122 /*
123 * ----------------------------------------------------------------------
124 *
125 * TclOODeleteChainCache --
126 *
127 * Destroy the cache of method call-chains.
128 *
129 * ----------------------------------------------------------------------
130 */
131
132 void
TclOODeleteChainCache(Tcl_HashTable * tablePtr)133 TclOODeleteChainCache(
134 Tcl_HashTable *tablePtr)
135 {
136 FOREACH_HASH_DECLS;
137 CallChain *callPtr;
138
139 FOREACH_HASH_VALUE(callPtr, tablePtr) {
140 if (callPtr) {
141 TclOODeleteChain(callPtr);
142 }
143 }
144 Tcl_DeleteHashTable(tablePtr);
145 ckfree(tablePtr);
146 }
147
148 /*
149 * ----------------------------------------------------------------------
150 *
151 * TclOODeleteChain --
152 *
153 * Destroys a method call-chain.
154 *
155 * ----------------------------------------------------------------------
156 */
157
158 void
TclOODeleteChain(CallChain * callPtr)159 TclOODeleteChain(
160 CallChain *callPtr)
161 {
162 if (callPtr == NULL || callPtr->refCount-- > 1) {
163 return;
164 }
165 if (callPtr->chain != callPtr->staticChain) {
166 ckfree(callPtr->chain);
167 }
168 ckfree(callPtr);
169 }
170
171 /*
172 * ----------------------------------------------------------------------
173 *
174 * TclOOStashContext --
175 *
176 * Saves a reference to a method call context in a Tcl_Obj's internal
177 * representation.
178 *
179 * ----------------------------------------------------------------------
180 */
181
182 static inline void
StashCallChain(Tcl_Obj * objPtr,CallChain * callPtr)183 StashCallChain(
184 Tcl_Obj *objPtr,
185 CallChain *callPtr)
186 {
187 callPtr->refCount++;
188 TclGetString(objPtr);
189 TclFreeIntRep(objPtr);
190 objPtr->typePtr = &methodNameType;
191 objPtr->internalRep.twoPtrValue.ptr1 = callPtr;
192 }
193
194 void
TclOOStashContext(Tcl_Obj * objPtr,CallContext * contextPtr)195 TclOOStashContext(
196 Tcl_Obj *objPtr,
197 CallContext *contextPtr)
198 {
199 StashCallChain(objPtr, contextPtr->callPtr);
200 }
201
202 /*
203 * ----------------------------------------------------------------------
204 *
205 * DupMethodNameRep, FreeMethodNameRep --
206 *
207 * Functions to implement the required parts of the Tcl_Obj guts needed
208 * for caching of method contexts in Tcl_Objs.
209 *
210 * ----------------------------------------------------------------------
211 */
212
213 static void
DupMethodNameRep(Tcl_Obj * srcPtr,Tcl_Obj * dstPtr)214 DupMethodNameRep(
215 Tcl_Obj *srcPtr,
216 Tcl_Obj *dstPtr)
217 {
218 CallChain *callPtr = srcPtr->internalRep.twoPtrValue.ptr1;
219
220 dstPtr->typePtr = &methodNameType;
221 dstPtr->internalRep.twoPtrValue.ptr1 = callPtr;
222 callPtr->refCount++;
223 }
224
225 static void
FreeMethodNameRep(Tcl_Obj * objPtr)226 FreeMethodNameRep(
227 Tcl_Obj *objPtr)
228 {
229 CallChain *callPtr = objPtr->internalRep.twoPtrValue.ptr1;
230
231 TclOODeleteChain(callPtr);
232 objPtr->typePtr = NULL;
233 }
234
235 /*
236 * ----------------------------------------------------------------------
237 *
238 * TclOOInvokeContext --
239 *
240 * Invokes a single step along a method call-chain context. Note that the
241 * invocation of a step along the chain can cause further steps along the
242 * chain to be invoked. Note that this function is written to be as light
243 * in stack usage as possible.
244 *
245 * ----------------------------------------------------------------------
246 */
247
248 int
TclOOInvokeContext(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])249 TclOOInvokeContext(
250 ClientData clientData, /* The method call context. */
251 Tcl_Interp *interp, /* Interpreter for error reporting, and many
252 * other sorts of context handling (e.g.,
253 * commands, variables) depending on method
254 * implementation. */
255 int objc, /* The number of arguments. */
256 Tcl_Obj *const objv[]) /* The arguments as actually seen. */
257 {
258 CallContext *const contextPtr = clientData;
259 Method *const mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
260 const int isFilter =
261 contextPtr->callPtr->chain[contextPtr->index].isFilter;
262
263 /*
264 * If this is the first step along the chain, we preserve the method
265 * entries in the chain so that they do not get deleted out from under our
266 * feet.
267 */
268
269 if (contextPtr->index == 0) {
270 int i;
271
272 for (i = 0 ; i < contextPtr->callPtr->numChain ; i++) {
273 AddRef(contextPtr->callPtr->chain[i].mPtr);
274 }
275
276 /*
277 * Ensure that the method name itself is part of the arguments when
278 * we're doing unknown processing.
279 */
280
281 if (contextPtr->callPtr->flags & OO_UNKNOWN_METHOD) {
282 contextPtr->skip--;
283 }
284
285 /*
286 * Add a callback to ensure that method references are dropped once
287 * this call is finished.
288 */
289
290 TclNRAddCallback(interp, FinalizeMethodRefs, contextPtr, NULL, NULL,
291 NULL);
292 }
293
294 /*
295 * Save whether we were in a filter and set up whether we are now.
296 */
297
298 if (contextPtr->oPtr->flags & FILTER_HANDLING) {
299 TclNRAddCallback(interp, SetFilterFlags, contextPtr, NULL,NULL,NULL);
300 } else {
301 TclNRAddCallback(interp, ResetFilterFlags,contextPtr,NULL,NULL,NULL);
302 }
303 if (isFilter || contextPtr->callPtr->flags & FILTER_HANDLING) {
304 contextPtr->oPtr->flags |= FILTER_HANDLING;
305 } else {
306 contextPtr->oPtr->flags &= ~FILTER_HANDLING;
307 }
308
309 /*
310 * Run the method implementation.
311 */
312
313 return mPtr->typePtr->callProc(mPtr->clientData, interp,
314 (Tcl_ObjectContext) contextPtr, objc, objv);
315 }
316
317 static int
SetFilterFlags(ClientData data[],Tcl_Interp * interp,int result)318 SetFilterFlags(
319 ClientData data[],
320 Tcl_Interp *interp,
321 int result)
322 {
323 CallContext *contextPtr = data[0];
324
325 contextPtr->oPtr->flags |= FILTER_HANDLING;
326 return result;
327 }
328
329 static int
ResetFilterFlags(ClientData data[],Tcl_Interp * interp,int result)330 ResetFilterFlags(
331 ClientData data[],
332 Tcl_Interp *interp,
333 int result)
334 {
335 CallContext *contextPtr = data[0];
336
337 contextPtr->oPtr->flags &= ~FILTER_HANDLING;
338 return result;
339 }
340
341 static int
FinalizeMethodRefs(ClientData data[],Tcl_Interp * interp,int result)342 FinalizeMethodRefs(
343 ClientData data[],
344 Tcl_Interp *interp,
345 int result)
346 {
347 CallContext *contextPtr = data[0];
348 int i;
349
350 for (i = 0 ; i < contextPtr->callPtr->numChain ; i++) {
351 TclOODelMethodRef(contextPtr->callPtr->chain[i].mPtr);
352 }
353 return result;
354 }
355
356 /*
357 * ----------------------------------------------------------------------
358 *
359 * TclOOGetSortedMethodList, TclOOGetSortedClassMethodList --
360 *
361 * Discovers the list of method names supported by an object or class.
362 *
363 * ----------------------------------------------------------------------
364 */
365
366 int
TclOOGetSortedMethodList(Object * oPtr,int flags,const char *** stringsPtr)367 TclOOGetSortedMethodList(
368 Object *oPtr, /* The object to get the method names for. */
369 int flags, /* Whether we just want the public method
370 * names. */
371 const char ***stringsPtr) /* Where to write a pointer to the array of
372 * strings to. */
373 {
374 Tcl_HashTable names; /* Tcl_Obj* method name to "wanted in list"
375 * mapping. */
376 Tcl_HashTable examinedClasses;
377 /* Used to track what classes have been looked
378 * at. Is set-like in nature and keyed by
379 * pointer to class. */
380 FOREACH_HASH_DECLS;
381 int i;
382 Class *mixinPtr;
383 Tcl_Obj *namePtr;
384 Method *mPtr;
385 int isWantedIn;
386 void *isWanted;
387
388 Tcl_InitObjHashTable(&names);
389 Tcl_InitHashTable(&examinedClasses, TCL_ONE_WORD_KEYS);
390
391 /*
392 * Name the bits used in the names table values.
393 */
394 #define IN_LIST 1
395 #define NO_IMPLEMENTATION 2
396
397 /*
398 * Process method names due to the object.
399 */
400
401 if (oPtr->methodsPtr) {
402 FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) {
403 int isNew;
404
405 if ((mPtr->flags & PRIVATE_METHOD) && !(flags & PRIVATE_METHOD)) {
406 continue;
407 }
408 hPtr = Tcl_CreateHashEntry(&names, (char *) namePtr, &isNew);
409 if (isNew) {
410 isWantedIn = ((!(flags & PUBLIC_METHOD)
411 || mPtr->flags & PUBLIC_METHOD) ? IN_LIST : 0);
412 isWantedIn |= (mPtr->typePtr == NULL ? NO_IMPLEMENTATION : 0);
413 Tcl_SetHashValue(hPtr, INT2PTR(isWantedIn));
414 }
415 }
416 }
417
418 /*
419 * Process method names due to private methods on the object's class.
420 */
421
422 if (flags & PRIVATE_METHOD) {
423 FOREACH_HASH(namePtr, mPtr, &oPtr->selfCls->classMethods) {
424 if (mPtr->flags & PRIVATE_METHOD) {
425 int isNew;
426
427 hPtr = Tcl_CreateHashEntry(&names, (char *) namePtr, &isNew);
428 if (isNew) {
429 isWantedIn = IN_LIST;
430 if (mPtr->typePtr == NULL) {
431 isWantedIn |= NO_IMPLEMENTATION;
432 }
433 Tcl_SetHashValue(hPtr, INT2PTR(isWantedIn));
434 } else if (mPtr->typePtr != NULL) {
435 isWantedIn = PTR2INT(Tcl_GetHashValue(hPtr));
436 if (isWantedIn & NO_IMPLEMENTATION) {
437 isWantedIn &= ~NO_IMPLEMENTATION;
438 Tcl_SetHashValue(hPtr, INT2PTR(isWantedIn));
439 }
440 }
441 }
442 }
443 }
444
445 /*
446 * Process (normal) method names from the class hierarchy and the mixin
447 * hierarchy.
448 */
449
450 AddClassMethodNames(oPtr->selfCls, flags, &names, &examinedClasses);
451 FOREACH(mixinPtr, oPtr->mixins) {
452 AddClassMethodNames(mixinPtr, flags|TRAVERSED_MIXIN, &names,
453 &examinedClasses);
454 }
455
456 Tcl_DeleteHashTable(&examinedClasses);
457
458 /*
459 * See how many (visible) method names there are. If none, we do not (and
460 * should not) try to sort the list of them.
461 */
462
463 i = 0;
464 if (names.numEntries != 0) {
465 const char **strings;
466
467 /*
468 * We need to build the list of methods to sort. We will be using
469 * qsort() for this, because it is very unlikely that the list will be
470 * heavily sorted when it is long enough to matter.
471 */
472
473 strings = ckalloc(sizeof(char *) * names.numEntries);
474 FOREACH_HASH(namePtr, isWanted, &names) {
475 if (!(flags & PUBLIC_METHOD) || (PTR2INT(isWanted) & IN_LIST)) {
476 if (PTR2INT(isWanted) & NO_IMPLEMENTATION) {
477 continue;
478 }
479 strings[i++] = TclGetString(namePtr);
480 }
481 }
482
483 /*
484 * Note that 'i' may well be less than names.numEntries when we are
485 * dealing with public method names.
486 */
487
488 if (i > 0) {
489 if (i > 1) {
490 qsort((void *) strings, i, sizeof(char *), CmpStr);
491 }
492 *stringsPtr = strings;
493 } else {
494 ckfree(strings);
495 }
496 }
497
498 Tcl_DeleteHashTable(&names);
499 return i;
500 }
501
502 int
TclOOGetSortedClassMethodList(Class * clsPtr,int flags,const char *** stringsPtr)503 TclOOGetSortedClassMethodList(
504 Class *clsPtr, /* The class to get the method names for. */
505 int flags, /* Whether we just want the public method
506 * names. */
507 const char ***stringsPtr) /* Where to write a pointer to the array of
508 * strings to. */
509 {
510 Tcl_HashTable names; /* Tcl_Obj* method name to "wanted in list"
511 * mapping. */
512 Tcl_HashTable examinedClasses;
513 /* Used to track what classes have been looked
514 * at. Is set-like in nature and keyed by
515 * pointer to class. */
516 FOREACH_HASH_DECLS;
517 int i;
518 Tcl_Obj *namePtr;
519 void *isWanted;
520
521 Tcl_InitObjHashTable(&names);
522 Tcl_InitHashTable(&examinedClasses, TCL_ONE_WORD_KEYS);
523
524 /*
525 * Process method names from the class hierarchy and the mixin hierarchy.
526 */
527
528 AddClassMethodNames(clsPtr, flags, &names, &examinedClasses);
529 Tcl_DeleteHashTable(&examinedClasses);
530
531 /*
532 * See how many (visible) method names there are. If none, we do not (and
533 * should not) try to sort the list of them.
534 */
535
536 i = 0;
537 if (names.numEntries != 0) {
538 const char **strings;
539
540 /*
541 * We need to build the list of methods to sort. We will be using
542 * qsort() for this, because it is very unlikely that the list will be
543 * heavily sorted when it is long enough to matter.
544 */
545
546 strings = ckalloc(sizeof(char *) * names.numEntries);
547 FOREACH_HASH(namePtr, isWanted, &names) {
548 if (!(flags & PUBLIC_METHOD) || (PTR2INT(isWanted) & IN_LIST)) {
549 if (PTR2INT(isWanted) & NO_IMPLEMENTATION) {
550 continue;
551 }
552 strings[i++] = TclGetString(namePtr);
553 }
554 }
555
556 /*
557 * Note that 'i' may well be less than names.numEntries when we are
558 * dealing with public method names.
559 */
560
561 if (i > 0) {
562 if (i > 1) {
563 qsort((void *) strings, i, sizeof(char *), CmpStr);
564 }
565 *stringsPtr = strings;
566 } else {
567 ckfree(strings);
568 }
569 }
570
571 Tcl_DeleteHashTable(&names);
572 return i;
573 }
574
575 /*
576 * Comparator for GetSortedMethodList
577 */
578
579 static int
CmpStr(const void * ptr1,const void * ptr2)580 CmpStr(
581 const void *ptr1,
582 const void *ptr2)
583 {
584 const char **strPtr1 = (const char **) ptr1;
585 const char **strPtr2 = (const char **) ptr2;
586
587 return TclpUtfNcmp2(*strPtr1, *strPtr2, strlen(*strPtr1) + 1);
588 }
589
590 /*
591 * ----------------------------------------------------------------------
592 *
593 * AddClassMethodNames --
594 *
595 * Adds the method names defined by a class (or its superclasses) to the
596 * collection being built. The collection is built in a hash table to
597 * ensure that duplicates are excluded. Helper for GetSortedMethodList().
598 *
599 * ----------------------------------------------------------------------
600 */
601
602 static void
AddClassMethodNames(Class * clsPtr,const int flags,Tcl_HashTable * const namesPtr,Tcl_HashTable * const examinedClassesPtr)603 AddClassMethodNames(
604 Class *clsPtr, /* Class to get method names from. */
605 const int flags, /* Whether we are interested in just the
606 * public method names. */
607 Tcl_HashTable *const namesPtr,
608 /* Reference to the hash table to put the
609 * information in. The hash table maps the
610 * Tcl_Obj * method name to an integral value
611 * describing whether the method is wanted.
612 * This ensures that public/private override
613 * semantics are handled correctly. */
614 Tcl_HashTable *const examinedClassesPtr)
615 /* Hash table that tracks what classes have
616 * already been looked at. The keys are the
617 * pointers to the classes, and the values are
618 * immaterial. */
619 {
620 /*
621 * If we've already started looking at this class, stop working on it now
622 * to prevent repeated work.
623 */
624
625 if (Tcl_FindHashEntry(examinedClassesPtr, (char *) clsPtr)) {
626 return;
627 }
628
629 /*
630 * Scope all declarations so that the compiler can stand a good chance of
631 * making the recursive step highly efficient. We also hand-implement the
632 * tail-recursive case using a while loop; C compilers typically cannot do
633 * tail-recursion optimization usefully.
634 */
635
636 while (1) {
637 FOREACH_HASH_DECLS;
638 Tcl_Obj *namePtr;
639 Method *mPtr;
640 int isNew;
641
642 (void) Tcl_CreateHashEntry(examinedClassesPtr, (char *) clsPtr,
643 &isNew);
644 if (!isNew) {
645 break;
646 }
647
648 if (clsPtr->mixins.num != 0) {
649 Class *mixinPtr;
650 int i;
651
652 FOREACH(mixinPtr, clsPtr->mixins) {
653 if (mixinPtr != clsPtr) {
654 AddClassMethodNames(mixinPtr, flags|TRAVERSED_MIXIN,
655 namesPtr, examinedClassesPtr);
656 }
657 }
658 }
659
660 FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) {
661 hPtr = Tcl_CreateHashEntry(namesPtr, (char *) namePtr, &isNew);
662 if (isNew) {
663 int isWanted = (!(flags & PUBLIC_METHOD)
664 || (mPtr->flags & PUBLIC_METHOD)) ? IN_LIST : 0;
665
666 isWanted |= (mPtr->typePtr == NULL ? NO_IMPLEMENTATION : 0);
667 Tcl_SetHashValue(hPtr, INT2PTR(isWanted));
668 } else if ((PTR2INT(Tcl_GetHashValue(hPtr)) & NO_IMPLEMENTATION)
669 && mPtr->typePtr != NULL) {
670 int isWanted = PTR2INT(Tcl_GetHashValue(hPtr));
671
672 isWanted &= ~NO_IMPLEMENTATION;
673 Tcl_SetHashValue(hPtr, INT2PTR(isWanted));
674 }
675 }
676
677 if (clsPtr->superclasses.num != 1) {
678 break;
679 }
680 clsPtr = clsPtr->superclasses.list[0];
681 }
682 if (clsPtr->superclasses.num != 0) {
683 Class *superPtr;
684 int i;
685
686 FOREACH(superPtr, clsPtr->superclasses) {
687 AddClassMethodNames(superPtr, flags, namesPtr,
688 examinedClassesPtr);
689 }
690 }
691 }
692
693 /*
694 * ----------------------------------------------------------------------
695 *
696 * AddSimpleChainToCallContext --
697 *
698 * The core of the call-chain construction engine, this handles calling a
699 * particular method on a particular object. Note that filters and
700 * unknown handling are already handled by the logic that uses this
701 * function.
702 *
703 * ----------------------------------------------------------------------
704 */
705
706 static inline void
AddSimpleChainToCallContext(Object * const oPtr,Tcl_Obj * const methodNameObj,struct ChainBuilder * const cbPtr,Tcl_HashTable * const doneFilters,int flags,Class * const filterDecl)707 AddSimpleChainToCallContext(
708 Object *const oPtr, /* Object to add call chain entries for. */
709 Tcl_Obj *const methodNameObj,
710 /* Name of method to add the call chain
711 * entries for. */
712 struct ChainBuilder *const cbPtr,
713 /* Where to add the call chain entries. */
714 Tcl_HashTable *const doneFilters,
715 /* Where to record what call chain entries
716 * have been processed. */
717 int flags, /* What sort of call chain are we building. */
718 Class *const filterDecl) /* The class that declared the filter. If
719 * NULL, either the filter was declared by the
720 * object or this isn't a filter. */
721 {
722 int i;
723
724 if (!(flags & (KNOWN_STATE | SPECIAL)) && oPtr->methodsPtr) {
725 Tcl_HashEntry *hPtr = Tcl_FindHashEntry(oPtr->methodsPtr,
726 (char *) methodNameObj);
727
728 if (hPtr != NULL) {
729 Method *mPtr = Tcl_GetHashValue(hPtr);
730
731 if (flags & PUBLIC_METHOD) {
732 if (!(mPtr->flags & PUBLIC_METHOD)) {
733 return;
734 } else {
735 flags |= DEFINITE_PUBLIC;
736 }
737 } else {
738 flags |= DEFINITE_PROTECTED;
739 }
740 }
741 }
742 if (!(flags & SPECIAL)) {
743 Tcl_HashEntry *hPtr;
744 Class *mixinPtr;
745
746 FOREACH(mixinPtr, oPtr->mixins) {
747 AddSimpleClassChainToCallContext(mixinPtr, methodNameObj, cbPtr,
748 doneFilters, flags|TRAVERSED_MIXIN, filterDecl);
749 }
750 if (oPtr->methodsPtr) {
751 hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char*) methodNameObj);
752 if (hPtr != NULL) {
753 AddMethodToCallChain(Tcl_GetHashValue(hPtr), cbPtr,
754 doneFilters, filterDecl, flags);
755 }
756 }
757 }
758 AddSimpleClassChainToCallContext(oPtr->selfCls, methodNameObj, cbPtr,
759 doneFilters, flags, filterDecl);
760 }
761
762 /*
763 * ----------------------------------------------------------------------
764 *
765 * AddMethodToCallChain --
766 *
767 * Utility method that manages the adding of a particular method
768 * implementation to a call-chain.
769 *
770 * ----------------------------------------------------------------------
771 */
772
773 static inline void
AddMethodToCallChain(Method * const mPtr,struct ChainBuilder * const cbPtr,Tcl_HashTable * const doneFilters,Class * const filterDecl,int flags)774 AddMethodToCallChain(
775 Method *const mPtr, /* Actual method implementation to add to call
776 * chain (or NULL, a no-op). */
777 struct ChainBuilder *const cbPtr,
778 /* The call chain to add the method
779 * implementation to. */
780 Tcl_HashTable *const doneFilters,
781 /* Where to record what filters have been
782 * processed. If NULL, not processing filters.
783 * Note that this function does not update
784 * this hashtable. */
785 Class *const filterDecl, /* The class that declared the filter. If
786 * NULL, either the filter was declared by the
787 * object or this isn't a filter. */
788 int flags) /* Used to check if we're mixin-consistent
789 * only. Mixin-consistent means that either
790 * we're looking to add things from a mixin
791 * and we have passed a mixin, or we're not
792 * looking to add things from a mixin and have
793 * not passed a mixin. */
794 {
795 CallChain *callPtr = cbPtr->callChainPtr;
796 int i;
797
798 /*
799 * Return if this is just an entry used to record whether this is a public
800 * method. If so, there's nothing real to call and so nothing to add to
801 * the call chain.
802 *
803 * This is also where we enforce mixin-consistency.
804 */
805
806 if (mPtr == NULL || mPtr->typePtr == NULL || !MIXIN_CONSISTENT(flags)) {
807 return;
808 }
809
810 /*
811 * Enforce real private method handling here. We will skip adding this
812 * method IF
813 * 1) we are not allowing private methods, AND
814 * 2) this is a private method, AND
815 * 3) this is a class method, AND
816 * 4) this method was not declared by the class of the current object.
817 *
818 * This does mean that only classes really handle private methods. This
819 * should be sufficient for [incr Tcl] support though.
820 */
821
822 if (!(callPtr->flags & PRIVATE_METHOD)
823 && (mPtr->flags & PRIVATE_METHOD)
824 && (mPtr->declaringClassPtr != NULL)
825 && (mPtr->declaringClassPtr != cbPtr->oPtr->selfCls)) {
826 return;
827 }
828
829 /*
830 * First test whether the method is already in the call chain. Skip over
831 * any leading filters.
832 */
833
834 for (i = cbPtr->filterLength ; i < callPtr->numChain ; i++) {
835 if (callPtr->chain[i].mPtr == mPtr &&
836 callPtr->chain[i].isFilter == (doneFilters != NULL)) {
837 /*
838 * Call chain semantics states that methods come as *late* in the
839 * call chain as possible. This is done by copying down the
840 * following methods. Note that this does not change the number of
841 * method invocations in the call chain; it just rearranges them.
842 */
843
844 Class *declCls = callPtr->chain[i].filterDeclarer;
845
846 for (; i + 1 < callPtr->numChain ; i++) {
847 callPtr->chain[i] = callPtr->chain[i + 1];
848 }
849 callPtr->chain[i].mPtr = mPtr;
850 callPtr->chain[i].isFilter = (doneFilters != NULL);
851 callPtr->chain[i].filterDeclarer = declCls;
852 return;
853 }
854 }
855
856 /*
857 * Need to really add the method. This is made a bit more complex by the
858 * fact that we are using some "static" space initially, and only start
859 * realloc-ing if the chain gets long.
860 */
861
862 if (callPtr->numChain == CALL_CHAIN_STATIC_SIZE) {
863 callPtr->chain =
864 ckalloc(sizeof(struct MInvoke) * (callPtr->numChain + 1));
865 memcpy(callPtr->chain, callPtr->staticChain,
866 sizeof(struct MInvoke) * callPtr->numChain);
867 } else if (callPtr->numChain > CALL_CHAIN_STATIC_SIZE) {
868 callPtr->chain = ckrealloc(callPtr->chain,
869 sizeof(struct MInvoke) * (callPtr->numChain + 1));
870 }
871 callPtr->chain[i].mPtr = mPtr;
872 callPtr->chain[i].isFilter = (doneFilters != NULL);
873 callPtr->chain[i].filterDeclarer = filterDecl;
874 callPtr->numChain++;
875 }
876
877 /*
878 * ----------------------------------------------------------------------
879 *
880 * InitCallChain --
881 * Encoding of the policy of how to set up a call chain. Doesn't populate
882 * the chain with the method implementation data.
883 *
884 * ----------------------------------------------------------------------
885 */
886
887 static inline void
InitCallChain(CallChain * callPtr,Object * oPtr,int flags)888 InitCallChain(
889 CallChain *callPtr,
890 Object *oPtr,
891 int flags)
892 {
893 callPtr->flags = flags &
894 (PUBLIC_METHOD | PRIVATE_METHOD | SPECIAL | FILTER_HANDLING);
895 if (oPtr->flags & USE_CLASS_CACHE) {
896 oPtr = oPtr->selfCls->thisPtr;
897 callPtr->flags |= USE_CLASS_CACHE;
898 }
899 callPtr->epoch = oPtr->fPtr->epoch;
900 callPtr->objectCreationEpoch = oPtr->creationEpoch;
901 callPtr->objectEpoch = oPtr->epoch;
902 callPtr->refCount = 1;
903 callPtr->numChain = 0;
904 callPtr->chain = callPtr->staticChain;
905 }
906
907 /*
908 * ----------------------------------------------------------------------
909 *
910 * IsStillValid --
911 * Calculates whether the given call chain can be used for executing a
912 * method for the given object. The condition on a chain from a cached
913 * location being reusable is:
914 * - Refers to the same object (same creation epoch), and
915 * - Still across the same class structure (same global epoch), and
916 * - Still across the same object strucutre (same local epoch), and
917 * - No public/private/filter magic leakage (same flags, modulo the fact
918 * that a public chain will satisfy a non-public call).
919 *
920 * ----------------------------------------------------------------------
921 */
922
923 static inline int
IsStillValid(CallChain * callPtr,Object * oPtr,int flags,int mask)924 IsStillValid(
925 CallChain *callPtr,
926 Object *oPtr,
927 int flags,
928 int mask)
929 {
930 if ((oPtr->flags & USE_CLASS_CACHE)) {
931 oPtr = oPtr->selfCls->thisPtr;
932 flags |= USE_CLASS_CACHE;
933 }
934 return ((callPtr->objectCreationEpoch == oPtr->creationEpoch)
935 && (callPtr->epoch == oPtr->fPtr->epoch)
936 && (callPtr->objectEpoch == oPtr->epoch)
937 && ((callPtr->flags & mask) == (flags & mask)));
938 }
939
940 /*
941 * ----------------------------------------------------------------------
942 *
943 * TclOOGetCallContext --
944 *
945 * Responsible for constructing the call context, an ordered list of all
946 * method implementations to be called as part of a method invocation.
947 * This method is central to the whole operation of the OO system.
948 *
949 * ----------------------------------------------------------------------
950 */
951
952 CallContext *
TclOOGetCallContext(Object * oPtr,Tcl_Obj * methodNameObj,int flags,Tcl_Obj * cacheInThisObj)953 TclOOGetCallContext(
954 Object *oPtr, /* The object to get the context for. */
955 Tcl_Obj *methodNameObj, /* The name of the method to get the context
956 * for. NULL when getting a constructor or
957 * destructor chain. */
958 int flags, /* What sort of context are we looking for.
959 * Only the bits PUBLIC_METHOD, CONSTRUCTOR,
960 * PRIVATE_METHOD, DESTRUCTOR and
961 * FILTER_HANDLING are useful. */
962 Tcl_Obj *cacheInThisObj) /* What object to cache in, or NULL if it is
963 * to be in the same object as the
964 * methodNameObj. */
965 {
966 CallContext *contextPtr;
967 CallChain *callPtr;
968 struct ChainBuilder cb;
969 int i, count, doFilters;
970 Tcl_HashEntry *hPtr;
971 Tcl_HashTable doneFilters;
972
973 if (cacheInThisObj == NULL) {
974 cacheInThisObj = methodNameObj;
975 }
976 if (flags&(SPECIAL|FILTER_HANDLING) || (oPtr->flags&FILTER_HANDLING)) {
977 hPtr = NULL;
978 doFilters = 0;
979
980 /*
981 * Check if we have a cached valid constructor or destructor.
982 */
983
984 if (flags & CONSTRUCTOR) {
985 callPtr = oPtr->selfCls->constructorChainPtr;
986 if ((callPtr != NULL)
987 && (callPtr->objectEpoch == oPtr->selfCls->thisPtr->epoch)
988 && (callPtr->epoch == oPtr->fPtr->epoch)) {
989 callPtr->refCount++;
990 goto returnContext;
991 }
992 } else if (flags & DESTRUCTOR) {
993 callPtr = oPtr->selfCls->destructorChainPtr;
994 if ((oPtr->mixins.num == 0) && (callPtr != NULL)
995 && (callPtr->objectEpoch == oPtr->selfCls->thisPtr->epoch)
996 && (callPtr->epoch == oPtr->fPtr->epoch)) {
997 callPtr->refCount++;
998 goto returnContext;
999 }
1000 }
1001 } else {
1002 /*
1003 * Check if we can get the chain out of the Tcl_Obj method name or out
1004 * of the cache. This is made a bit more complex by the fact that
1005 * there are multiple different layers of cache (in the Tcl_Obj, in
1006 * the object, and in the class).
1007 */
1008
1009 const int reuseMask = ((flags & PUBLIC_METHOD) ? ~0 : ~PUBLIC_METHOD);
1010
1011 if (cacheInThisObj->typePtr == &methodNameType) {
1012 callPtr = cacheInThisObj->internalRep.twoPtrValue.ptr1;
1013 if (IsStillValid(callPtr, oPtr, flags, reuseMask)) {
1014 callPtr->refCount++;
1015 goto returnContext;
1016 }
1017 FreeMethodNameRep(cacheInThisObj);
1018 }
1019
1020 if (oPtr->flags & USE_CLASS_CACHE) {
1021 if (oPtr->selfCls->classChainCache != NULL) {
1022 hPtr = Tcl_FindHashEntry(oPtr->selfCls->classChainCache,
1023 (char *) methodNameObj);
1024 } else {
1025 hPtr = NULL;
1026 }
1027 } else {
1028 if (oPtr->chainCache != NULL) {
1029 hPtr = Tcl_FindHashEntry(oPtr->chainCache,
1030 (char *) methodNameObj);
1031 } else {
1032 hPtr = NULL;
1033 }
1034 }
1035
1036 if (hPtr != NULL && Tcl_GetHashValue(hPtr) != NULL) {
1037 callPtr = Tcl_GetHashValue(hPtr);
1038 if (IsStillValid(callPtr, oPtr, flags, reuseMask)) {
1039 callPtr->refCount++;
1040 goto returnContext;
1041 }
1042 Tcl_SetHashValue(hPtr, NULL);
1043 TclOODeleteChain(callPtr);
1044 }
1045
1046 doFilters = 1;
1047 }
1048
1049 callPtr = ckalloc(sizeof(CallChain));
1050 InitCallChain(callPtr, oPtr, flags);
1051
1052 cb.callChainPtr = callPtr;
1053 cb.filterLength = 0;
1054 cb.oPtr = oPtr;
1055
1056 /*
1057 * If we're working with a forced use of unknown, do that now.
1058 */
1059
1060 if (flags & FORCE_UNKNOWN) {
1061 AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
1062 &cb, NULL, BUILDING_MIXINS, NULL);
1063 AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
1064 &cb, NULL, 0, NULL);
1065 callPtr->flags |= OO_UNKNOWN_METHOD;
1066 callPtr->epoch = -1;
1067 if (callPtr->numChain == 0) {
1068 TclOODeleteChain(callPtr);
1069 return NULL;
1070 }
1071 goto returnContext;
1072 }
1073
1074 /*
1075 * Add all defined filters (if any, and if we're going to be processing
1076 * them; they're not processed for constructors, destructors or when we're
1077 * in the middle of processing a filter).
1078 */
1079
1080 if (doFilters) {
1081 Tcl_Obj *filterObj;
1082 Class *mixinPtr;
1083
1084 doFilters = 1;
1085 Tcl_InitObjHashTable(&doneFilters);
1086 FOREACH(mixinPtr, oPtr->mixins) {
1087 AddClassFiltersToCallContext(oPtr, mixinPtr, &cb, &doneFilters,
1088 TRAVERSED_MIXIN|BUILDING_MIXINS|OBJECT_MIXIN);
1089 AddClassFiltersToCallContext(oPtr, mixinPtr, &cb, &doneFilters,
1090 OBJECT_MIXIN);
1091 }
1092 FOREACH(filterObj, oPtr->filters) {
1093 AddSimpleChainToCallContext(oPtr, filterObj, &cb, &doneFilters,
1094 BUILDING_MIXINS, NULL);
1095 AddSimpleChainToCallContext(oPtr, filterObj, &cb, &doneFilters, 0,
1096 NULL);
1097 }
1098 AddClassFiltersToCallContext(oPtr, oPtr->selfCls, &cb, &doneFilters,
1099 BUILDING_MIXINS);
1100 AddClassFiltersToCallContext(oPtr, oPtr->selfCls, &cb, &doneFilters,
1101 0);
1102 Tcl_DeleteHashTable(&doneFilters);
1103 }
1104 count = cb.filterLength = callPtr->numChain;
1105
1106 /*
1107 * Add the actual method implementations. We have to do this twice to
1108 * handle class mixins right.
1109 */
1110
1111 AddSimpleChainToCallContext(oPtr, methodNameObj, &cb, NULL,
1112 flags|BUILDING_MIXINS, NULL);
1113 AddSimpleChainToCallContext(oPtr, methodNameObj, &cb, NULL, flags, NULL);
1114
1115 /*
1116 * Check to see if the method has no implementation. If so, we probably
1117 * need to add in a call to the unknown method. Otherwise, set up the
1118 * cacheing of the method implementation (if relevant).
1119 */
1120
1121 if (count == callPtr->numChain) {
1122 /*
1123 * Method does not actually exist. If we're dealing with constructors
1124 * or destructors, this isn't a problem.
1125 */
1126
1127 if (flags & SPECIAL) {
1128 TclOODeleteChain(callPtr);
1129 return NULL;
1130 }
1131 AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
1132 &cb, NULL, BUILDING_MIXINS, NULL);
1133 AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
1134 &cb, NULL, 0, NULL);
1135 callPtr->flags |= OO_UNKNOWN_METHOD;
1136 callPtr->epoch = -1;
1137 if (count == callPtr->numChain) {
1138 TclOODeleteChain(callPtr);
1139 return NULL;
1140 }
1141 } else if (doFilters) {
1142 if (hPtr == NULL) {
1143 if (oPtr->flags & USE_CLASS_CACHE) {
1144 if (oPtr->selfCls->classChainCache == NULL) {
1145 oPtr->selfCls->classChainCache =
1146 ckalloc(sizeof(Tcl_HashTable));
1147
1148 Tcl_InitObjHashTable(oPtr->selfCls->classChainCache);
1149 }
1150 hPtr = Tcl_CreateHashEntry(oPtr->selfCls->classChainCache,
1151 (char *) methodNameObj, &i);
1152 } else {
1153 if (oPtr->chainCache == NULL) {
1154 oPtr->chainCache = ckalloc(sizeof(Tcl_HashTable));
1155
1156 Tcl_InitObjHashTable(oPtr->chainCache);
1157 }
1158 hPtr = Tcl_CreateHashEntry(oPtr->chainCache,
1159 (char *) methodNameObj, &i);
1160 }
1161 }
1162 callPtr->refCount++;
1163 Tcl_SetHashValue(hPtr, callPtr);
1164 StashCallChain(cacheInThisObj, callPtr);
1165 } else if (flags & CONSTRUCTOR) {
1166 if (oPtr->selfCls->constructorChainPtr) {
1167 TclOODeleteChain(oPtr->selfCls->constructorChainPtr);
1168 }
1169 oPtr->selfCls->constructorChainPtr = callPtr;
1170 callPtr->refCount++;
1171 } else if ((flags & DESTRUCTOR) && oPtr->mixins.num == 0) {
1172 if (oPtr->selfCls->destructorChainPtr) {
1173 TclOODeleteChain(oPtr->selfCls->destructorChainPtr);
1174 }
1175 oPtr->selfCls->destructorChainPtr = callPtr;
1176 callPtr->refCount++;
1177 }
1178
1179 returnContext:
1180 contextPtr = TclStackAlloc(oPtr->fPtr->interp, sizeof(CallContext));
1181 contextPtr->oPtr = oPtr;
1182
1183 /*
1184 * Corresponding TclOODecrRefCount() in TclOODeleteContext
1185 */
1186
1187 AddRef(oPtr);
1188 contextPtr->callPtr = callPtr;
1189 contextPtr->skip = 2;
1190 contextPtr->index = 0;
1191 return contextPtr;
1192 }
1193
1194 /*
1195 * ----------------------------------------------------------------------
1196 *
1197 * TclOOGetStereotypeCallChain --
1198 *
1199 * Construct a call-chain for a method that would be used by a
1200 * stereotypical instance of the given class (i.e., where the object has
1201 * no definitions special to itself).
1202 *
1203 * ----------------------------------------------------------------------
1204 */
1205
1206 CallChain *
TclOOGetStereotypeCallChain(Class * clsPtr,Tcl_Obj * methodNameObj,int flags)1207 TclOOGetStereotypeCallChain(
1208 Class *clsPtr, /* The object to get the context for. */
1209 Tcl_Obj *methodNameObj, /* The name of the method to get the context
1210 * for. NULL when getting a constructor or
1211 * destructor chain. */
1212 int flags) /* What sort of context are we looking for.
1213 * Only the bits PUBLIC_METHOD, CONSTRUCTOR,
1214 * PRIVATE_METHOD, DESTRUCTOR and
1215 * FILTER_HANDLING are useful. */
1216 {
1217 CallChain *callPtr;
1218 struct ChainBuilder cb;
1219 int i, count;
1220 Foundation *fPtr = clsPtr->thisPtr->fPtr;
1221 Tcl_HashEntry *hPtr;
1222 Tcl_HashTable doneFilters;
1223 Object obj;
1224
1225 /*
1226 * Synthesize a temporary stereotypical object so that we can use existing
1227 * machinery to produce the stereotypical call chain.
1228 */
1229
1230 memset(&obj, 0, sizeof(Object));
1231 obj.fPtr = fPtr;
1232 obj.selfCls = clsPtr;
1233 obj.refCount = 1;
1234 obj.flags = USE_CLASS_CACHE;
1235
1236 /*
1237 * Check if we can get the chain out of the Tcl_Obj method name or out of
1238 * the cache. This is made a bit more complex by the fact that there are
1239 * multiple different layers of cache (in the Tcl_Obj, in the object, and
1240 * in the class).
1241 */
1242
1243 if (clsPtr->classChainCache != NULL) {
1244 hPtr = Tcl_FindHashEntry(clsPtr->classChainCache,
1245 (char *) methodNameObj);
1246 if (hPtr != NULL && Tcl_GetHashValue(hPtr) != NULL) {
1247 const int reuseMask =
1248 ((flags & PUBLIC_METHOD) ? ~0 : ~PUBLIC_METHOD);
1249
1250 callPtr = Tcl_GetHashValue(hPtr);
1251 if (IsStillValid(callPtr, &obj, flags, reuseMask)) {
1252 callPtr->refCount++;
1253 return callPtr;
1254 }
1255 Tcl_SetHashValue(hPtr, NULL);
1256 TclOODeleteChain(callPtr);
1257 }
1258 } else {
1259 hPtr = NULL;
1260 }
1261
1262 callPtr = ckalloc(sizeof(CallChain));
1263 memset(callPtr, 0, sizeof(CallChain));
1264 callPtr->flags = flags & (PUBLIC_METHOD|PRIVATE_METHOD|FILTER_HANDLING);
1265 callPtr->epoch = fPtr->epoch;
1266 callPtr->objectCreationEpoch = fPtr->tsdPtr->nsCount;
1267 callPtr->objectEpoch = clsPtr->thisPtr->epoch;
1268 callPtr->refCount = 1;
1269 callPtr->chain = callPtr->staticChain;
1270
1271 cb.callChainPtr = callPtr;
1272 cb.filterLength = 0;
1273 cb.oPtr = &obj;
1274
1275 /*
1276 * Add all defined filters (if any, and if we're going to be processing
1277 * them; they're not processed for constructors, destructors or when we're
1278 * in the middle of processing a filter).
1279 */
1280
1281 Tcl_InitObjHashTable(&doneFilters);
1282 AddClassFiltersToCallContext(&obj, clsPtr, &cb, &doneFilters,
1283 BUILDING_MIXINS);
1284 AddClassFiltersToCallContext(&obj, clsPtr, &cb, &doneFilters, 0);
1285 Tcl_DeleteHashTable(&doneFilters);
1286 count = cb.filterLength = callPtr->numChain;
1287
1288 /*
1289 * Add the actual method implementations.
1290 */
1291
1292 AddSimpleChainToCallContext(&obj, methodNameObj, &cb, NULL,
1293 flags|BUILDING_MIXINS, NULL);
1294 AddSimpleChainToCallContext(&obj, methodNameObj, &cb, NULL, flags, NULL);
1295
1296 /*
1297 * Check to see if the method has no implementation. If so, we probably
1298 * need to add in a call to the unknown method. Otherwise, set up the
1299 * cacheing of the method implementation (if relevant).
1300 */
1301
1302 if (count == callPtr->numChain) {
1303 AddSimpleChainToCallContext(&obj, fPtr->unknownMethodNameObj, &cb,
1304 NULL, BUILDING_MIXINS, NULL);
1305 AddSimpleChainToCallContext(&obj, fPtr->unknownMethodNameObj, &cb,
1306 NULL, 0, NULL);
1307 callPtr->flags |= OO_UNKNOWN_METHOD;
1308 callPtr->epoch = -1;
1309 if (count == callPtr->numChain) {
1310 TclOODeleteChain(callPtr);
1311 return NULL;
1312 }
1313 } else {
1314 if (hPtr == NULL) {
1315 if (clsPtr->classChainCache == NULL) {
1316 clsPtr->classChainCache = ckalloc(sizeof(Tcl_HashTable));
1317 Tcl_InitObjHashTable(clsPtr->classChainCache);
1318 }
1319 hPtr = Tcl_CreateHashEntry(clsPtr->classChainCache,
1320 (char *) methodNameObj, &i);
1321 }
1322 callPtr->refCount++;
1323 Tcl_SetHashValue(hPtr, callPtr);
1324 StashCallChain(methodNameObj, callPtr);
1325 }
1326 return callPtr;
1327 }
1328
1329 /*
1330 * ----------------------------------------------------------------------
1331 *
1332 * AddClassFiltersToCallContext --
1333 *
1334 * Logic to make extracting all the filters from the class context much
1335 * easier.
1336 *
1337 * ----------------------------------------------------------------------
1338 */
1339
1340 static void
AddClassFiltersToCallContext(Object * const oPtr,Class * clsPtr,struct ChainBuilder * const cbPtr,Tcl_HashTable * const doneFilters,int flags)1341 AddClassFiltersToCallContext(
1342 Object *const oPtr, /* Object that the filters operate on. */
1343 Class *clsPtr, /* Class to get the filters from. */
1344 struct ChainBuilder *const cbPtr,
1345 /* Context to fill with call chain entries. */
1346 Tcl_HashTable *const doneFilters,
1347 /* Where to record what filters have been
1348 * processed. Keys are objects, values are
1349 * ignored. */
1350 int flags) /* Whether we've gone along a mixin link
1351 * yet. */
1352 {
1353 int i, clearedFlags =
1354 flags & ~(TRAVERSED_MIXIN|OBJECT_MIXIN|BUILDING_MIXINS);
1355 Class *superPtr, *mixinPtr;
1356 Tcl_Obj *filterObj;
1357
1358 tailRecurse:
1359 if (clsPtr == NULL) {
1360 return;
1361 }
1362
1363 /*
1364 * Add all the filters defined by classes mixed into the main class
1365 * hierarchy.
1366 */
1367
1368 FOREACH(mixinPtr, clsPtr->mixins) {
1369 AddClassFiltersToCallContext(oPtr, mixinPtr, cbPtr, doneFilters,
1370 flags|TRAVERSED_MIXIN);
1371 }
1372
1373 /*
1374 * Add all the class filters from the current class. Note that the filters
1375 * are added starting at the object root, as this allows the object to
1376 * override how filters work to extend their behaviour.
1377 */
1378
1379 if (MIXIN_CONSISTENT(flags)) {
1380 FOREACH(filterObj, clsPtr->filters) {
1381 int isNew;
1382
1383 (void) Tcl_CreateHashEntry(doneFilters, (char *) filterObj,
1384 &isNew);
1385 if (isNew) {
1386 AddSimpleChainToCallContext(oPtr, filterObj, cbPtr,
1387 doneFilters, clearedFlags|BUILDING_MIXINS, clsPtr);
1388 AddSimpleChainToCallContext(oPtr, filterObj, cbPtr,
1389 doneFilters, clearedFlags, clsPtr);
1390 }
1391 }
1392 }
1393
1394 /*
1395 * Now process the recursive case. Notice the tail-call optimization.
1396 */
1397
1398 switch (clsPtr->superclasses.num) {
1399 case 1:
1400 clsPtr = clsPtr->superclasses.list[0];
1401 goto tailRecurse;
1402 default:
1403 FOREACH(superPtr, clsPtr->superclasses) {
1404 AddClassFiltersToCallContext(oPtr, superPtr, cbPtr, doneFilters,
1405 flags);
1406 }
1407 case 0:
1408 return;
1409 }
1410 }
1411
1412 /*
1413 * ----------------------------------------------------------------------
1414 *
1415 * AddSimpleClassChainToCallContext --
1416 *
1417 * Construct a call-chain from a class hierarchy.
1418 *
1419 * ----------------------------------------------------------------------
1420 */
1421
1422 static void
AddSimpleClassChainToCallContext(Class * classPtr,Tcl_Obj * const methodNameObj,struct ChainBuilder * const cbPtr,Tcl_HashTable * const doneFilters,int flags,Class * const filterDecl)1423 AddSimpleClassChainToCallContext(
1424 Class *classPtr, /* Class to add the call chain entries for. */
1425 Tcl_Obj *const methodNameObj,
1426 /* Name of method to add the call chain
1427 * entries for. */
1428 struct ChainBuilder *const cbPtr,
1429 /* Where to add the call chain entries. */
1430 Tcl_HashTable *const doneFilters,
1431 /* Where to record what call chain entries
1432 * have been processed. */
1433 int flags, /* What sort of call chain are we building. */
1434 Class *const filterDecl) /* The class that declared the filter. If
1435 * NULL, either the filter was declared by the
1436 * object or this isn't a filter. */
1437 {
1438 int i;
1439 Class *superPtr;
1440
1441 /*
1442 * We hard-code the tail-recursive form. It's by far the most common case
1443 * *and* it is much more gentle on the stack.
1444 *
1445 * Note that mixins must be processed before the main class hierarchy.
1446 * [Bug 1998221]
1447 */
1448
1449 tailRecurse:
1450 FOREACH(superPtr, classPtr->mixins) {
1451 AddSimpleClassChainToCallContext(superPtr, methodNameObj, cbPtr,
1452 doneFilters, flags|TRAVERSED_MIXIN, filterDecl);
1453 }
1454
1455 if (flags & CONSTRUCTOR) {
1456 AddMethodToCallChain(classPtr->constructorPtr, cbPtr, doneFilters,
1457 filterDecl, flags);
1458 } else if (flags & DESTRUCTOR) {
1459 AddMethodToCallChain(classPtr->destructorPtr, cbPtr, doneFilters,
1460 filterDecl, flags);
1461 } else {
1462 Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods,
1463 (char *) methodNameObj);
1464
1465 if (hPtr != NULL) {
1466 Method *mPtr = Tcl_GetHashValue(hPtr);
1467
1468 if (!(flags & KNOWN_STATE)) {
1469 if (flags & PUBLIC_METHOD) {
1470 if (mPtr->flags & PUBLIC_METHOD) {
1471 flags |= DEFINITE_PUBLIC;
1472 } else {
1473 return;
1474 }
1475 } else {
1476 flags |= DEFINITE_PROTECTED;
1477 }
1478 }
1479 AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl, flags);
1480 }
1481 }
1482
1483 switch (classPtr->superclasses.num) {
1484 case 1:
1485 classPtr = classPtr->superclasses.list[0];
1486 goto tailRecurse;
1487 default:
1488 FOREACH(superPtr, classPtr->superclasses) {
1489 AddSimpleClassChainToCallContext(superPtr, methodNameObj, cbPtr,
1490 doneFilters, flags, filterDecl);
1491 }
1492 case 0:
1493 return;
1494 }
1495 }
1496
1497 /*
1498 * ----------------------------------------------------------------------
1499 *
1500 * TclOORenderCallChain --
1501 *
1502 * Create a description of a call chain. Used in [info object call],
1503 * [info class call], and [self call].
1504 *
1505 * ----------------------------------------------------------------------
1506 */
1507
1508 Tcl_Obj *
TclOORenderCallChain(Tcl_Interp * interp,CallChain * callPtr)1509 TclOORenderCallChain(
1510 Tcl_Interp *interp,
1511 CallChain *callPtr)
1512 {
1513 Tcl_Obj *filterLiteral, *methodLiteral, *objectLiteral;
1514 Tcl_Obj *resultObj, *descObjs[4], **objv;
1515 Foundation *fPtr = TclOOGetFoundation(interp);
1516 int i;
1517
1518 /*
1519 * Allocate the literals (potentially) used in our description.
1520 */
1521
1522 filterLiteral = Tcl_NewStringObj("filter", -1);
1523 Tcl_IncrRefCount(filterLiteral);
1524 methodLiteral = Tcl_NewStringObj("method", -1);
1525 Tcl_IncrRefCount(methodLiteral);
1526 objectLiteral = Tcl_NewStringObj("object", -1);
1527 Tcl_IncrRefCount(objectLiteral);
1528
1529 /*
1530 * Do the actual construction of the descriptions. They consist of a list
1531 * of triples that describe the details of how a method is understood. For
1532 * each triple, the first word is the type of invocation ("method" is
1533 * normal, "unknown" is special because it adds the method name as an
1534 * extra argument when handled by some method types, and "filter" is
1535 * special because it's a filter method). The second word is the name of
1536 * the method in question (which differs for "unknown" and "filter" types)
1537 * and the third word is the full name of the class that declares the
1538 * method (or "object" if it is declared on the instance).
1539 */
1540
1541 objv = TclStackAlloc(interp, callPtr->numChain * sizeof(Tcl_Obj *));
1542 for (i = 0 ; i < callPtr->numChain ; i++) {
1543 struct MInvoke *miPtr = &callPtr->chain[i];
1544
1545 descObjs[0] = miPtr->isFilter
1546 ? filterLiteral
1547 : callPtr->flags & OO_UNKNOWN_METHOD
1548 ? fPtr->unknownMethodNameObj
1549 : methodLiteral;
1550 descObjs[1] = callPtr->flags & CONSTRUCTOR
1551 ? fPtr->constructorName
1552 : callPtr->flags & DESTRUCTOR
1553 ? fPtr->destructorName
1554 : miPtr->mPtr->namePtr;
1555 descObjs[2] = miPtr->mPtr->declaringClassPtr
1556 ? Tcl_GetObjectName(interp,
1557 (Tcl_Object) miPtr->mPtr->declaringClassPtr->thisPtr)
1558 : objectLiteral;
1559 descObjs[3] = Tcl_NewStringObj(miPtr->mPtr->typePtr->name, -1);
1560
1561 objv[i] = Tcl_NewListObj(4, descObjs);
1562 }
1563
1564 /*
1565 * Drop the local references to the literals; if they're actually used,
1566 * they'll live on the description itself.
1567 */
1568
1569 Tcl_DecrRefCount(filterLiteral);
1570 Tcl_DecrRefCount(methodLiteral);
1571 Tcl_DecrRefCount(objectLiteral);
1572
1573 /*
1574 * Finish building the description and return it.
1575 */
1576
1577 resultObj = Tcl_NewListObj(callPtr->numChain, objv);
1578 TclStackFree(interp, objv);
1579 return resultObj;
1580 }
1581
1582 /*
1583 * Local Variables:
1584 * mode: c
1585 * c-basic-offset: 4
1586 * fill-column: 78
1587 * End:
1588 */
1589