1 /*
2 * tclOOCall.c --
3 *
4 * This file contains the method call chain management code for the
5 * object-system core.
6 *
7 * Copyright © 2005-2012 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 #include <assert.h>
19
20 /*
21 * Structure containing a CallContext and any other values needed only during
22 * the construction of the CallContext.
23 */
24
25 struct ChainBuilder {
26 CallChain *callChainPtr; /* The call chain being built. */
27 int filterLength; /* Number of entries in the call chain that
28 * are due to processing filters and not the
29 * main call chain. */
30 Object *oPtr; /* The object that we are building the chain
31 * for. */
32 };
33
34 /*
35 * Structures used for traversing the class hierarchy to find out where
36 * definitions are supposed to be done.
37 */
38
39 typedef struct {
40 Class *definerCls;
41 Tcl_Obj *namespaceName;
42 } DefineEntry;
43
44 typedef struct {
45 DefineEntry *list;
46 int num;
47 int size;
48 } DefineChain;
49
50 /*
51 * Extra flags used for call chain management.
52 */
53
54 #define DEFINITE_PROTECTED 0x100000
55 #define DEFINITE_PUBLIC 0x200000
56 #define KNOWN_STATE (DEFINITE_PROTECTED | DEFINITE_PUBLIC)
57 #define SPECIAL (CONSTRUCTOR | DESTRUCTOR | FORCE_UNKNOWN)
58 #define BUILDING_MIXINS 0x400000
59 #define TRAVERSED_MIXIN 0x800000
60 #define OBJECT_MIXIN 0x1000000
61 #define MIXIN_CONSISTENT(flags) \
62 (((flags) & OBJECT_MIXIN) || \
63 !((flags) & BUILDING_MIXINS) == !((flags) & TRAVERSED_MIXIN))
64
65 /*
66 * Note that the flag bit PRIVATE_METHOD has a confusing name; it's just for
67 * Itcl's special type of private.
68 */
69
70 #define IS_PUBLIC(mPtr) \
71 (((mPtr)->flags & PUBLIC_METHOD) != 0)
72 #define IS_UNEXPORTED(mPtr) \
73 (((mPtr)->flags & SCOPE_FLAGS) == 0)
74 #define IS_ITCLPRIVATE(mPtr) \
75 (((mPtr)->flags & PRIVATE_METHOD) != 0)
76 #define IS_PRIVATE(mPtr) \
77 (((mPtr)->flags & TRUE_PRIVATE_METHOD) != 0)
78 #define WANT_PUBLIC(flags) \
79 (((flags) & PUBLIC_METHOD) != 0)
80 #define WANT_UNEXPORTED(flags) \
81 (((flags) & (PRIVATE_METHOD | TRUE_PRIVATE_METHOD)) == 0)
82 #define WANT_ITCLPRIVATE(flags) \
83 (((flags) & PRIVATE_METHOD) != 0)
84 #define WANT_PRIVATE(flags) \
85 (((flags) & TRUE_PRIVATE_METHOD) != 0)
86
87 /*
88 * Function declarations for things defined in this file.
89 */
90
91 static void AddClassFiltersToCallContext(Object *const oPtr,
92 Class *clsPtr, struct ChainBuilder *const cbPtr,
93 Tcl_HashTable *const doneFilters, int flags);
94 static void AddClassMethodNames(Class *clsPtr, const int flags,
95 Tcl_HashTable *const namesPtr,
96 Tcl_HashTable *const examinedClassesPtr);
97 static inline void AddDefinitionNamespaceToChain(Class *const definerCls,
98 Tcl_Obj *const namespaceName,
99 DefineChain *const definePtr, int flags);
100 static inline void AddMethodToCallChain(Method *const mPtr,
101 struct ChainBuilder *const cbPtr,
102 Tcl_HashTable *const doneFilters,
103 Class *const filterDecl, int flags);
104 static inline int AddInstancePrivateToCallContext(Object *const oPtr,
105 Tcl_Obj *const methodNameObj,
106 struct ChainBuilder *const cbPtr, int flags);
107 static inline void AddStandardMethodName(int flags, Tcl_Obj *namePtr,
108 Method *mPtr, Tcl_HashTable *namesPtr);
109 static inline void AddPrivateMethodNames(Tcl_HashTable *methodsTablePtr,
110 Tcl_HashTable *namesPtr);
111 static inline int AddSimpleChainToCallContext(Object *const oPtr,
112 Class *const contextCls,
113 Tcl_Obj *const methodNameObj,
114 struct ChainBuilder *const cbPtr,
115 Tcl_HashTable *const doneFilters, int flags,
116 Class *const filterDecl);
117 static int AddPrivatesFromClassChainToCallContext(Class *classPtr,
118 Class *const contextCls,
119 Tcl_Obj *const methodNameObj,
120 struct ChainBuilder *const cbPtr,
121 Tcl_HashTable *const doneFilters, int flags,
122 Class *const filterDecl);
123 static int AddSimpleClassChainToCallContext(Class *classPtr,
124 Tcl_Obj *const methodNameObj,
125 struct ChainBuilder *const cbPtr,
126 Tcl_HashTable *const doneFilters, int flags,
127 Class *const filterDecl);
128 static void AddSimpleClassDefineNamespaces(Class *classPtr,
129 DefineChain *const definePtr, int flags);
130 static inline void AddSimpleDefineNamespaces(Object *const oPtr,
131 DefineChain *const definePtr, int flags);
132 static int CmpStr(const void *ptr1, const void *ptr2);
133 static void DupMethodNameRep(Tcl_Obj *srcPtr, Tcl_Obj *dstPtr);
134 static Tcl_NRPostProc FinalizeMethodRefs;
135 static void FreeMethodNameRep(Tcl_Obj *objPtr);
136 static inline int IsStillValid(CallChain *callPtr, Object *oPtr,
137 int flags, int reuseMask);
138 static Tcl_NRPostProc ResetFilterFlags;
139 static Tcl_NRPostProc SetFilterFlags;
140 static int SortMethodNames(Tcl_HashTable *namesPtr, int flags,
141 const char ***stringsPtr);
142 static inline void StashCallChain(Tcl_Obj *objPtr, CallChain *callPtr);
143
144 /*
145 * Object type used to manage type caches attached to method names.
146 */
147
148 static const Tcl_ObjType methodNameType = {
149 "TclOO method name",
150 FreeMethodNameRep,
151 DupMethodNameRep,
152 NULL,
153 NULL
154 };
155
156
157 /*
158 * ----------------------------------------------------------------------
159 *
160 * TclOODeleteContext --
161 *
162 * Destroys a method call-chain context, which should not be in use.
163 *
164 * ----------------------------------------------------------------------
165 */
166
167 void
TclOODeleteContext(CallContext * contextPtr)168 TclOODeleteContext(
169 CallContext *contextPtr)
170 {
171 Object *oPtr = contextPtr->oPtr;
172
173 TclOODeleteChain(contextPtr->callPtr);
174 if (oPtr != NULL) {
175 TclStackFree(oPtr->fPtr->interp, contextPtr);
176
177 /*
178 * Corresponding AddRef() in TclOO.c/TclOOObjectCmdCore
179 */
180
181 TclOODecrRefCount(oPtr);
182 }
183 }
184
185 /*
186 * ----------------------------------------------------------------------
187 *
188 * TclOODeleteChainCache --
189 *
190 * Destroy the cache of method call-chains.
191 *
192 * ----------------------------------------------------------------------
193 */
194
195 void
TclOODeleteChainCache(Tcl_HashTable * tablePtr)196 TclOODeleteChainCache(
197 Tcl_HashTable *tablePtr)
198 {
199 FOREACH_HASH_DECLS;
200 CallChain *callPtr;
201
202 FOREACH_HASH_VALUE(callPtr, tablePtr) {
203 if (callPtr) {
204 TclOODeleteChain(callPtr);
205 }
206 }
207 Tcl_DeleteHashTable(tablePtr);
208 ckfree(tablePtr);
209 }
210
211 /*
212 * ----------------------------------------------------------------------
213 *
214 * TclOODeleteChain --
215 *
216 * Destroys a method call-chain.
217 *
218 * ----------------------------------------------------------------------
219 */
220
221 void
TclOODeleteChain(CallChain * callPtr)222 TclOODeleteChain(
223 CallChain *callPtr)
224 {
225 if (callPtr == NULL || callPtr->refCount-- > 1) {
226 return;
227 }
228 if (callPtr->chain != callPtr->staticChain) {
229 ckfree(callPtr->chain);
230 }
231 ckfree(callPtr);
232 }
233
234 /*
235 * ----------------------------------------------------------------------
236 *
237 * TclOOStashContext --
238 *
239 * Saves a reference to a method call context in a Tcl_Obj's internal
240 * representation.
241 *
242 * ----------------------------------------------------------------------
243 */
244
245 static inline void
StashCallChain(Tcl_Obj * objPtr,CallChain * callPtr)246 StashCallChain(
247 Tcl_Obj *objPtr,
248 CallChain *callPtr)
249 {
250 Tcl_ObjIntRep ir;
251
252 callPtr->refCount++;
253 TclGetString(objPtr);
254 ir.twoPtrValue.ptr1 = callPtr;
255 Tcl_StoreIntRep(objPtr, &methodNameType, &ir);
256 }
257
258 void
TclOOStashContext(Tcl_Obj * objPtr,CallContext * contextPtr)259 TclOOStashContext(
260 Tcl_Obj *objPtr,
261 CallContext *contextPtr)
262 {
263 StashCallChain(objPtr, contextPtr->callPtr);
264 }
265
266 /*
267 * ----------------------------------------------------------------------
268 *
269 * DupMethodNameRep, FreeMethodNameRep --
270 *
271 * Functions to implement the required parts of the Tcl_Obj guts needed
272 * for caching of method contexts in Tcl_Objs.
273 *
274 * ----------------------------------------------------------------------
275 */
276
277 static void
DupMethodNameRep(Tcl_Obj * srcPtr,Tcl_Obj * dstPtr)278 DupMethodNameRep(
279 Tcl_Obj *srcPtr,
280 Tcl_Obj *dstPtr)
281 {
282 StashCallChain(dstPtr,
283 (CallChain *)TclFetchIntRep(srcPtr, &methodNameType)->twoPtrValue.ptr1);
284 }
285
286 static void
FreeMethodNameRep(Tcl_Obj * objPtr)287 FreeMethodNameRep(
288 Tcl_Obj *objPtr)
289 {
290 TclOODeleteChain(
291 (CallChain *)TclFetchIntRep(objPtr, &methodNameType)->twoPtrValue.ptr1);
292 }
293
294 /*
295 * ----------------------------------------------------------------------
296 *
297 * TclOOInvokeContext --
298 *
299 * Invokes a single step along a method call-chain context. Note that the
300 * invocation of a step along the chain can cause further steps along the
301 * chain to be invoked. Note that this function is written to be as light
302 * in stack usage as possible.
303 *
304 * ----------------------------------------------------------------------
305 */
306
307 int
TclOOInvokeContext(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])308 TclOOInvokeContext(
309 ClientData clientData, /* The method call context. */
310 Tcl_Interp *interp, /* Interpreter for error reporting, and many
311 * other sorts of context handling (e.g.,
312 * commands, variables) depending on method
313 * implementation. */
314 int objc, /* The number of arguments. */
315 Tcl_Obj *const objv[]) /* The arguments as actually seen. */
316 {
317 CallContext *const contextPtr = (CallContext *)clientData;
318 Method *const mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
319 const int isFilter =
320 contextPtr->callPtr->chain[contextPtr->index].isFilter;
321
322 /*
323 * If this is the first step along the chain, we preserve the method
324 * entries in the chain so that they do not get deleted out from under our
325 * feet.
326 */
327
328 if (contextPtr->index == 0) {
329 int i;
330
331 for (i = 0 ; i < contextPtr->callPtr->numChain ; i++) {
332 AddRef(contextPtr->callPtr->chain[i].mPtr);
333 }
334
335 /*
336 * Ensure that the method name itself is part of the arguments when
337 * we're doing unknown processing.
338 */
339
340 if (contextPtr->callPtr->flags & OO_UNKNOWN_METHOD) {
341 contextPtr->skip--;
342 }
343
344 /*
345 * Add a callback to ensure that method references are dropped once
346 * this call is finished.
347 */
348
349 TclNRAddCallback(interp, FinalizeMethodRefs, contextPtr, NULL, NULL,
350 NULL);
351 }
352
353 /*
354 * Save whether we were in a filter and set up whether we are now.
355 */
356
357 if (contextPtr->oPtr->flags & FILTER_HANDLING) {
358 TclNRAddCallback(interp, SetFilterFlags, contextPtr, NULL,NULL,NULL);
359 } else {
360 TclNRAddCallback(interp, ResetFilterFlags,contextPtr,NULL,NULL,NULL);
361 }
362 if (isFilter || contextPtr->callPtr->flags & FILTER_HANDLING) {
363 contextPtr->oPtr->flags |= FILTER_HANDLING;
364 } else {
365 contextPtr->oPtr->flags &= ~FILTER_HANDLING;
366 }
367
368 /*
369 * Run the method implementation.
370 */
371
372 return mPtr->typePtr->callProc(mPtr->clientData, interp,
373 (Tcl_ObjectContext) contextPtr, objc, objv);
374 }
375
376 static int
SetFilterFlags(ClientData data[],TCL_UNUSED (Tcl_Interp *),int result)377 SetFilterFlags(
378 ClientData data[],
379 TCL_UNUSED(Tcl_Interp *),
380 int result)
381 {
382 CallContext *contextPtr = (CallContext *)data[0];
383
384 contextPtr->oPtr->flags |= FILTER_HANDLING;
385 return result;
386 }
387
388 static int
ResetFilterFlags(ClientData data[],TCL_UNUSED (Tcl_Interp *),int result)389 ResetFilterFlags(
390 ClientData data[],
391 TCL_UNUSED(Tcl_Interp *),
392 int result)
393 {
394 CallContext *contextPtr = (CallContext *)data[0];
395
396 contextPtr->oPtr->flags &= ~FILTER_HANDLING;
397 return result;
398 }
399
400 static int
FinalizeMethodRefs(ClientData data[],TCL_UNUSED (Tcl_Interp *),int result)401 FinalizeMethodRefs(
402 ClientData data[],
403 TCL_UNUSED(Tcl_Interp *),
404 int result)
405 {
406 CallContext *contextPtr = (CallContext *)data[0];
407 int i;
408
409 for (i = 0 ; i < contextPtr->callPtr->numChain ; i++) {
410 TclOODelMethodRef(contextPtr->callPtr->chain[i].mPtr);
411 }
412 return result;
413 }
414
415 /*
416 * ----------------------------------------------------------------------
417 *
418 * TclOOGetSortedMethodList, TclOOGetSortedClassMethodList --
419 *
420 * Discovers the list of method names supported by an object or class.
421 *
422 * ----------------------------------------------------------------------
423 */
424
425 int
TclOOGetSortedMethodList(Object * oPtr,Object * contextObj,Class * contextCls,int flags,const char *** stringsPtr)426 TclOOGetSortedMethodList(
427 Object *oPtr, /* The object to get the method names for. */
428 Object *contextObj, /* From what context object we are inquiring.
429 * NULL when the context shouldn't see
430 * object-level private methods. Note that
431 * flags can override this. */
432 Class *contextCls, /* From what context class we are inquiring.
433 * NULL when the context shouldn't see
434 * class-level private methods. Note that
435 * flags can override this. */
436 int flags, /* Whether we just want the public method
437 * names. */
438 const char ***stringsPtr) /* Where to write a pointer to the array of
439 * strings to. */
440 {
441 Tcl_HashTable names; /* Tcl_Obj* method name to "wanted in list"
442 * mapping. */
443 Tcl_HashTable examinedClasses;
444 /* Used to track what classes have been looked
445 * at. Is set-like in nature and keyed by
446 * pointer to class. */
447 FOREACH_HASH_DECLS;
448 int i, numStrings;
449 Class *mixinPtr;
450 Tcl_Obj *namePtr;
451 Method *mPtr;
452
453 Tcl_InitObjHashTable(&names);
454 Tcl_InitHashTable(&examinedClasses, TCL_ONE_WORD_KEYS);
455
456 /*
457 * Name the bits used in the names table values.
458 */
459 #define IN_LIST 1
460 #define NO_IMPLEMENTATION 2
461
462 /*
463 * Process method names due to the object.
464 */
465
466 if (oPtr->methodsPtr) {
467 FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) {
468 if (IS_PRIVATE(mPtr)) {
469 continue;
470 }
471 if (IS_UNEXPORTED(mPtr) && !WANT_UNEXPORTED(flags)) {
472 continue;
473 }
474 AddStandardMethodName(flags, namePtr, mPtr, &names);
475 }
476 }
477
478 /*
479 * Process method names due to private methods on the object's class.
480 */
481
482 if (WANT_UNEXPORTED(flags)) {
483 FOREACH_HASH(namePtr, mPtr, &oPtr->selfCls->classMethods) {
484 if (IS_UNEXPORTED(mPtr)) {
485 AddStandardMethodName(flags, namePtr, mPtr, &names);
486 }
487 }
488 }
489
490 /*
491 * Process method names due to private methods on the context's object or
492 * class. Which must be correct if either are not NULL.
493 */
494
495 if (contextObj && contextObj->methodsPtr) {
496 AddPrivateMethodNames(contextObj->methodsPtr, &names);
497 }
498 if (contextCls) {
499 AddPrivateMethodNames(&contextCls->classMethods, &names);
500 }
501
502 /*
503 * Process (normal) method names from the class hierarchy and the mixin
504 * hierarchy.
505 */
506
507 AddClassMethodNames(oPtr->selfCls, flags, &names, &examinedClasses);
508 FOREACH(mixinPtr, oPtr->mixins) {
509 AddClassMethodNames(mixinPtr, flags | TRAVERSED_MIXIN, &names,
510 &examinedClasses);
511 }
512
513 /*
514 * Tidy up, sort the names and resolve finally whether we really want
515 * them (processing export layering).
516 */
517
518 Tcl_DeleteHashTable(&examinedClasses);
519 numStrings = SortMethodNames(&names, flags, stringsPtr);
520 Tcl_DeleteHashTable(&names);
521 return numStrings;
522 }
523
524 int
TclOOGetSortedClassMethodList(Class * clsPtr,int flags,const char *** stringsPtr)525 TclOOGetSortedClassMethodList(
526 Class *clsPtr, /* The class to get the method names for. */
527 int flags, /* Whether we just want the public method
528 * names. */
529 const char ***stringsPtr) /* Where to write a pointer to the array of
530 * strings to. */
531 {
532 Tcl_HashTable names; /* Tcl_Obj* method name to "wanted in list"
533 * mapping. */
534 Tcl_HashTable examinedClasses;
535 /* Used to track what classes have been looked
536 * at. Is set-like in nature and keyed by
537 * pointer to class. */
538 int numStrings;
539
540 Tcl_InitObjHashTable(&names);
541 Tcl_InitHashTable(&examinedClasses, TCL_ONE_WORD_KEYS);
542
543 /*
544 * Process method names from the class hierarchy and the mixin hierarchy.
545 */
546
547 AddClassMethodNames(clsPtr, flags, &names, &examinedClasses);
548 Tcl_DeleteHashTable(&examinedClasses);
549
550 /*
551 * Process private method names if we should. [TIP 500]
552 */
553
554 if (WANT_PRIVATE(flags)) {
555 AddPrivateMethodNames(&clsPtr->classMethods, &names);
556 flags &= ~TRUE_PRIVATE_METHOD;
557 }
558
559 /*
560 * Tidy up, sort the names and resolve finally whether we really want
561 * them (processing export layering).
562 */
563
564 numStrings = SortMethodNames(&names, flags, stringsPtr);
565 Tcl_DeleteHashTable(&names);
566 return numStrings;
567 }
568
569 /*
570 * ----------------------------------------------------------------------
571 *
572 * SortMethodNames --
573 *
574 * Shared helper for TclOOGetSortedMethodList etc. that knows the method
575 * sorting rules.
576 *
577 * Returns:
578 * The length of the sorted list.
579 *
580 * ----------------------------------------------------------------------
581 */
582
583 static int
SortMethodNames(Tcl_HashTable * namesPtr,int flags,const char *** stringsPtr)584 SortMethodNames(
585 Tcl_HashTable *namesPtr, /* The table of names; unsorted, but contains
586 * whether the names are wanted and under what
587 * circumstances. */
588 int flags, /* Whether we are looking for unexported
589 * methods. Full private methods are handled
590 * on insertion to the table. */
591 const char ***stringsPtr) /* Where to store the sorted list of strings
592 * that we produce. ckalloced() */
593 {
594 const char **strings;
595 FOREACH_HASH_DECLS;
596 Tcl_Obj *namePtr;
597 void *isWanted;
598 int i = 0;
599
600 /*
601 * See how many (visible) method names there are. If none, we do not (and
602 * should not) try to sort the list of them.
603 */
604
605 if (namesPtr->numEntries == 0) {
606 *stringsPtr = NULL;
607 return 0;
608 }
609
610 /*
611 * We need to build the list of methods to sort. We will be using qsort()
612 * for this, because it is very unlikely that the list will be heavily
613 * sorted when it is long enough to matter.
614 */
615
616 strings = (const char **)ckalloc(sizeof(char *) * namesPtr->numEntries);
617 FOREACH_HASH(namePtr, isWanted, namesPtr) {
618 if (!WANT_PUBLIC(flags) || (PTR2INT(isWanted) & IN_LIST)) {
619 if (PTR2INT(isWanted) & NO_IMPLEMENTATION) {
620 continue;
621 }
622 strings[i++] = TclGetString(namePtr);
623 }
624 }
625
626 /*
627 * Note that 'i' may well be less than names.numEntries when we are
628 * dealing with public method names. We don't sort unless there's at least
629 * two method names.
630 */
631
632 if (i > 0) {
633 if (i > 1) {
634 qsort((void *) strings, i, sizeof(char *), CmpStr);
635 }
636 *stringsPtr = strings;
637 } else {
638 ckfree(strings);
639 *stringsPtr = NULL;
640 }
641 return i;
642 }
643
644 /*
645 * Comparator for SortMethodNames
646 */
647
648 static int
CmpStr(const void * ptr1,const void * ptr2)649 CmpStr(
650 const void *ptr1,
651 const void *ptr2)
652 {
653 const char **strPtr1 = (const char **) ptr1;
654 const char **strPtr2 = (const char **) ptr2;
655
656 return TclpUtfNcmp2(*strPtr1, *strPtr2, strlen(*strPtr1) + 1);
657 }
658
659 /*
660 * ----------------------------------------------------------------------
661 *
662 * AddClassMethodNames --
663 *
664 * Adds the method names defined by a class (or its superclasses) to the
665 * collection being built. The collection is built in a hash table to
666 * ensure that duplicates are excluded. Helper for GetSortedMethodList().
667 *
668 * ----------------------------------------------------------------------
669 */
670
671 static void
AddClassMethodNames(Class * clsPtr,const int flags,Tcl_HashTable * const namesPtr,Tcl_HashTable * const examinedClassesPtr)672 AddClassMethodNames(
673 Class *clsPtr, /* Class to get method names from. */
674 const int flags, /* Whether we are interested in just the
675 * public method names. */
676 Tcl_HashTable *const namesPtr,
677 /* Reference to the hash table to put the
678 * information in. The hash table maps the
679 * Tcl_Obj * method name to an integral value
680 * describing whether the method is wanted.
681 * This ensures that public/private override
682 * semantics are handled correctly. */
683 Tcl_HashTable *const examinedClassesPtr)
684 /* Hash table that tracks what classes have
685 * already been looked at. The keys are the
686 * pointers to the classes, and the values are
687 * immaterial. */
688 {
689 int i;
690
691 /*
692 * If we've already started looking at this class, stop working on it now
693 * to prevent repeated work.
694 */
695
696 if (Tcl_FindHashEntry(examinedClassesPtr, (char *) clsPtr)) {
697 return;
698 }
699
700 /*
701 * Scope all declarations so that the compiler can stand a good chance of
702 * making the recursive step highly efficient. We also hand-implement the
703 * tail-recursive case using a while loop; C compilers typically cannot do
704 * tail-recursion optimization usefully.
705 */
706
707 while (1) {
708 FOREACH_HASH_DECLS;
709 Tcl_Obj *namePtr;
710 Method *mPtr;
711 int isNew;
712
713 (void) Tcl_CreateHashEntry(examinedClassesPtr, (char *) clsPtr,
714 &isNew);
715 if (!isNew) {
716 break;
717 }
718
719 if (clsPtr->mixins.num != 0) {
720 Class *mixinPtr;
721
722 FOREACH(mixinPtr, clsPtr->mixins) {
723 if (mixinPtr != clsPtr) {
724 AddClassMethodNames(mixinPtr, flags|TRAVERSED_MIXIN,
725 namesPtr, examinedClassesPtr);
726 }
727 }
728 }
729
730 FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) {
731 AddStandardMethodName(flags, namePtr, mPtr, namesPtr);
732 }
733
734 if (clsPtr->superclasses.num != 1) {
735 break;
736 }
737 clsPtr = clsPtr->superclasses.list[0];
738 }
739 if (clsPtr->superclasses.num != 0) {
740 Class *superPtr;
741
742 FOREACH(superPtr, clsPtr->superclasses) {
743 AddClassMethodNames(superPtr, flags, namesPtr,
744 examinedClassesPtr);
745 }
746 }
747 }
748
749 /*
750 * ----------------------------------------------------------------------
751 *
752 * AddPrivateMethodNames, AddStandardMethodName --
753 *
754 * Factored-out helpers for the sorted name list production functions.
755 *
756 * ----------------------------------------------------------------------
757 */
758
759 static inline void
AddPrivateMethodNames(Tcl_HashTable * methodsTablePtr,Tcl_HashTable * namesPtr)760 AddPrivateMethodNames(
761 Tcl_HashTable *methodsTablePtr,
762 Tcl_HashTable *namesPtr)
763 {
764 FOREACH_HASH_DECLS;
765 Method *mPtr;
766 Tcl_Obj *namePtr;
767
768 FOREACH_HASH(namePtr, mPtr, methodsTablePtr) {
769 if (IS_PRIVATE(mPtr)) {
770 int isNew;
771
772 hPtr = Tcl_CreateHashEntry(namesPtr, (char *) namePtr, &isNew);
773 Tcl_SetHashValue(hPtr, INT2PTR(IN_LIST));
774 }
775 }
776 }
777
778 static inline void
AddStandardMethodName(int flags,Tcl_Obj * namePtr,Method * mPtr,Tcl_HashTable * namesPtr)779 AddStandardMethodName(
780 int flags,
781 Tcl_Obj *namePtr,
782 Method *mPtr,
783 Tcl_HashTable *namesPtr)
784 {
785 if (!IS_PRIVATE(mPtr)) {
786 int isNew;
787 Tcl_HashEntry *hPtr =
788 Tcl_CreateHashEntry(namesPtr, (char *) namePtr, &isNew);
789
790 if (isNew) {
791 int isWanted = (!WANT_PUBLIC(flags) || IS_PUBLIC(mPtr))
792 ? IN_LIST : 0;
793
794 isWanted |= (mPtr->typePtr == NULL ? NO_IMPLEMENTATION : 0);
795 Tcl_SetHashValue(hPtr, INT2PTR(isWanted));
796 } else if ((PTR2INT(Tcl_GetHashValue(hPtr)) & NO_IMPLEMENTATION)
797 && mPtr->typePtr != NULL) {
798 int isWanted = PTR2INT(Tcl_GetHashValue(hPtr));
799
800 isWanted &= ~NO_IMPLEMENTATION;
801 Tcl_SetHashValue(hPtr, INT2PTR(isWanted));
802 }
803 }
804 }
805
806 #undef IN_LIST
807 #undef NO_IMPLEMENTATION
808
809 /*
810 * ----------------------------------------------------------------------
811 *
812 * AddInstancePrivateToCallContext --
813 *
814 * Add private methods from the instance. Called when the calling Tcl
815 * context is a TclOO method declared by an object that is the same as
816 * the current object. Returns true iff a private method was actually
817 * found and added to the call chain (as this suppresses caching).
818 *
819 * ----------------------------------------------------------------------
820 */
821
822 static inline int
AddInstancePrivateToCallContext(Object * const oPtr,Tcl_Obj * const methodName,struct ChainBuilder * const cbPtr,int flags)823 AddInstancePrivateToCallContext(
824 Object *const oPtr, /* Object to add call chain entries for. */
825 Tcl_Obj *const methodName, /* Name of method to add the call chain
826 * entries for. */
827 struct ChainBuilder *const cbPtr,
828 /* Where to add the call chain entries. */
829 int flags) /* What sort of call chain are we building. */
830 {
831 Tcl_HashEntry *hPtr;
832 Method *mPtr;
833 int donePrivate = 0;
834
835 if (oPtr->methodsPtr) {
836 hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) methodName);
837 if (hPtr != NULL) {
838 mPtr = (Method *)Tcl_GetHashValue(hPtr);
839 if (IS_PRIVATE(mPtr)) {
840 AddMethodToCallChain(mPtr, cbPtr, NULL, NULL, flags);
841 donePrivate = 1;
842 }
843 }
844 }
845 return donePrivate;
846 }
847
848 /*
849 * ----------------------------------------------------------------------
850 *
851 * AddSimpleChainToCallContext --
852 *
853 * The core of the call-chain construction engine, this handles calling a
854 * particular method on a particular object. Note that filters and
855 * unknown handling are already handled by the logic that uses this
856 * function. Returns true if a private method was one of those found.
857 *
858 * ----------------------------------------------------------------------
859 */
860
861 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)862 AddSimpleChainToCallContext(
863 Object *const oPtr, /* Object to add call chain entries for. */
864 Class *const contextCls, /* Context class; the currently considered
865 * class is equal to this, private methods may
866 * also be added. [TIP 500] */
867 Tcl_Obj *const methodNameObj,
868 /* Name of method to add the call chain
869 * entries for. */
870 struct ChainBuilder *const cbPtr,
871 /* Where to add the call chain entries. */
872 Tcl_HashTable *const doneFilters,
873 /* Where to record what call chain entries
874 * have been processed. */
875 int flags, /* What sort of call chain are we building. */
876 Class *const filterDecl) /* The class that declared the filter. If
877 * NULL, either the filter was declared by the
878 * object or this isn't a filter. */
879 {
880 int i, foundPrivate = 0, blockedUnexported = 0;
881 Tcl_HashEntry *hPtr;
882 Method *mPtr;
883
884 if (!(flags & (KNOWN_STATE | SPECIAL)) && oPtr->methodsPtr) {
885 hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) methodNameObj);
886
887 if (hPtr != NULL) {
888 mPtr = (Method *)Tcl_GetHashValue(hPtr);
889 if (!IS_PRIVATE(mPtr)) {
890 if (WANT_PUBLIC(flags)) {
891 if (!IS_PUBLIC(mPtr)) {
892 blockedUnexported = 1;
893 } else {
894 flags |= DEFINITE_PUBLIC;
895 }
896 } else {
897 flags |= DEFINITE_PROTECTED;
898 }
899 }
900 }
901 }
902 if (!(flags & SPECIAL)) {
903 Class *mixinPtr;
904
905 FOREACH(mixinPtr, oPtr->mixins) {
906 if (contextCls) {
907 foundPrivate |= AddPrivatesFromClassChainToCallContext(
908 mixinPtr, contextCls, methodNameObj, cbPtr,
909 doneFilters, flags|TRAVERSED_MIXIN, filterDecl);
910 }
911 foundPrivate |= AddSimpleClassChainToCallContext(mixinPtr,
912 methodNameObj, cbPtr, doneFilters,
913 flags | TRAVERSED_MIXIN, filterDecl);
914 }
915 if (oPtr->methodsPtr && !blockedUnexported) {
916 hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char*) methodNameObj);
917 if (hPtr != NULL) {
918 mPtr = (Method *)Tcl_GetHashValue(hPtr);
919 if (!IS_PRIVATE(mPtr)) {
920 AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl,
921 flags);
922 }
923 }
924 }
925 }
926 if (contextCls) {
927 foundPrivate |= AddPrivatesFromClassChainToCallContext(oPtr->selfCls,
928 contextCls, methodNameObj, cbPtr, doneFilters, flags,
929 filterDecl);
930 }
931 if (!blockedUnexported) {
932 foundPrivate |= AddSimpleClassChainToCallContext(oPtr->selfCls,
933 methodNameObj, cbPtr, doneFilters, flags, filterDecl);
934 }
935 return foundPrivate;
936 }
937
938 /*
939 * ----------------------------------------------------------------------
940 *
941 * AddMethodToCallChain --
942 *
943 * Utility method that manages the adding of a particular method
944 * implementation to a call-chain.
945 *
946 * ----------------------------------------------------------------------
947 */
948
949 static inline void
AddMethodToCallChain(Method * const mPtr,struct ChainBuilder * const cbPtr,Tcl_HashTable * const doneFilters,Class * const filterDecl,int flags)950 AddMethodToCallChain(
951 Method *const mPtr, /* Actual method implementation to add to call
952 * chain (or NULL, a no-op). */
953 struct ChainBuilder *const cbPtr,
954 /* The call chain to add the method
955 * implementation to. */
956 Tcl_HashTable *const doneFilters,
957 /* Where to record what filters have been
958 * processed. If NULL, not processing filters.
959 * Note that this function does not update
960 * this hashtable. */
961 Class *const filterDecl, /* The class that declared the filter. If
962 * NULL, either the filter was declared by the
963 * object or this isn't a filter. */
964 int flags) /* Used to check if we're mixin-consistent
965 * only. Mixin-consistent means that either
966 * we're looking to add things from a mixin
967 * and we have passed a mixin, or we're not
968 * looking to add things from a mixin and have
969 * not passed a mixin. */
970 {
971 CallChain *callPtr = cbPtr->callChainPtr;
972 int i;
973
974 /*
975 * Return if this is just an entry used to record whether this is a public
976 * method. If so, there's nothing real to call and so nothing to add to
977 * the call chain.
978 *
979 * This is also where we enforce mixin-consistency.
980 */
981
982 if (mPtr == NULL || mPtr->typePtr == NULL || !MIXIN_CONSISTENT(flags)) {
983 return;
984 }
985
986 /*
987 * Enforce real private method handling here. We will skip adding this
988 * method IF
989 * 1) we are not allowing private methods, AND
990 * 2) this is a private method, AND
991 * 3) this is a class method, AND
992 * 4) this method was not declared by the class of the current object.
993 *
994 * This does mean that only classes really handle private methods. This
995 * should be sufficient for [incr Tcl] support though.
996 */
997
998 if (!WANT_UNEXPORTED(callPtr->flags)
999 && IS_UNEXPORTED(mPtr)
1000 && (mPtr->declaringClassPtr != NULL)
1001 && (mPtr->declaringClassPtr != cbPtr->oPtr->selfCls)) {
1002 return;
1003 }
1004
1005 /*
1006 * First test whether the method is already in the call chain. Skip over
1007 * any leading filters.
1008 */
1009
1010 for (i = cbPtr->filterLength ; i < callPtr->numChain ; i++) {
1011 if (callPtr->chain[i].mPtr == mPtr &&
1012 callPtr->chain[i].isFilter == (doneFilters != NULL)) {
1013 /*
1014 * Call chain semantics states that methods come as *late* in the
1015 * call chain as possible. This is done by copying down the
1016 * following methods. Note that this does not change the number of
1017 * method invocations in the call chain; it just rearranges them.
1018 */
1019
1020 Class *declCls = callPtr->chain[i].filterDeclarer;
1021
1022 for (; i + 1 < callPtr->numChain ; i++) {
1023 callPtr->chain[i] = callPtr->chain[i + 1];
1024 }
1025 callPtr->chain[i].mPtr = mPtr;
1026 callPtr->chain[i].isFilter = (doneFilters != NULL);
1027 callPtr->chain[i].filterDeclarer = declCls;
1028 return;
1029 }
1030 }
1031
1032 /*
1033 * Need to really add the method. This is made a bit more complex by the
1034 * fact that we are using some "static" space initially, and only start
1035 * realloc-ing if the chain gets long.
1036 */
1037
1038 if (callPtr->numChain == CALL_CHAIN_STATIC_SIZE) {
1039 callPtr->chain =
1040 (struct MInvoke *)ckalloc(sizeof(struct MInvoke) * (callPtr->numChain + 1));
1041 memcpy(callPtr->chain, callPtr->staticChain,
1042 sizeof(struct MInvoke) * callPtr->numChain);
1043 } else if (callPtr->numChain > CALL_CHAIN_STATIC_SIZE) {
1044 callPtr->chain = (struct MInvoke *)ckrealloc(callPtr->chain,
1045 sizeof(struct MInvoke) * (callPtr->numChain + 1));
1046 }
1047 callPtr->chain[i].mPtr = mPtr;
1048 callPtr->chain[i].isFilter = (doneFilters != NULL);
1049 callPtr->chain[i].filterDeclarer = filterDecl;
1050 callPtr->numChain++;
1051 }
1052
1053 /*
1054 * ----------------------------------------------------------------------
1055 *
1056 * InitCallChain --
1057 * Encoding of the policy of how to set up a call chain. Doesn't populate
1058 * the chain with the method implementation data.
1059 *
1060 * ----------------------------------------------------------------------
1061 */
1062
1063 static inline void
InitCallChain(CallChain * callPtr,Object * oPtr,int flags)1064 InitCallChain(
1065 CallChain *callPtr,
1066 Object *oPtr,
1067 int flags)
1068 {
1069 callPtr->flags = flags &
1070 (PUBLIC_METHOD | PRIVATE_METHOD | SPECIAL | FILTER_HANDLING);
1071 if (oPtr->flags & USE_CLASS_CACHE) {
1072 oPtr = oPtr->selfCls->thisPtr;
1073 callPtr->flags |= USE_CLASS_CACHE;
1074 }
1075 callPtr->epoch = oPtr->fPtr->epoch;
1076 callPtr->objectCreationEpoch = oPtr->creationEpoch;
1077 callPtr->objectEpoch = oPtr->epoch;
1078 callPtr->refCount = 1;
1079 callPtr->numChain = 0;
1080 callPtr->chain = callPtr->staticChain;
1081 }
1082
1083 /*
1084 * ----------------------------------------------------------------------
1085 *
1086 * IsStillValid --
1087 *
1088 * Calculates whether the given call chain can be used for executing a
1089 * method for the given object. The condition on a chain from a cached
1090 * location being reusable is:
1091 * - Refers to the same object (same creation epoch), and
1092 * - Still across the same class structure (same global epoch), and
1093 * - Still across the same object strucutre (same local epoch), and
1094 * - No public/private/filter magic leakage (same flags, modulo the fact
1095 * that a public chain will satisfy a non-public call).
1096 *
1097 * ----------------------------------------------------------------------
1098 */
1099
1100 static inline int
IsStillValid(CallChain * callPtr,Object * oPtr,int flags,int mask)1101 IsStillValid(
1102 CallChain *callPtr,
1103 Object *oPtr,
1104 int flags,
1105 int mask)
1106 {
1107 if ((oPtr->flags & USE_CLASS_CACHE)) {
1108 oPtr = oPtr->selfCls->thisPtr;
1109 flags |= USE_CLASS_CACHE;
1110 }
1111 return ((callPtr->objectCreationEpoch == oPtr->creationEpoch)
1112 && (callPtr->epoch == oPtr->fPtr->epoch)
1113 && (callPtr->objectEpoch == oPtr->epoch)
1114 && ((callPtr->flags & mask) == (flags & mask)));
1115 }
1116
1117 /*
1118 * ----------------------------------------------------------------------
1119 *
1120 * TclOOGetCallContext --
1121 *
1122 * Responsible for constructing the call context, an ordered list of all
1123 * method implementations to be called as part of a method invocation.
1124 * This method is central to the whole operation of the OO system.
1125 *
1126 * ----------------------------------------------------------------------
1127 */
1128
1129 CallContext *
TclOOGetCallContext(Object * oPtr,Tcl_Obj * methodNameObj,int flags,Object * contextObj,Class * contextCls,Tcl_Obj * cacheInThisObj)1130 TclOOGetCallContext(
1131 Object *oPtr, /* The object to get the context for. */
1132 Tcl_Obj *methodNameObj, /* The name of the method to get the context
1133 * for. NULL when getting a constructor or
1134 * destructor chain. */
1135 int flags, /* What sort of context are we looking for.
1136 * Only the bits PUBLIC_METHOD, CONSTRUCTOR,
1137 * PRIVATE_METHOD, DESTRUCTOR and
1138 * FILTER_HANDLING are useful. */
1139 Object *contextObj, /* Context object; when equal to oPtr, it
1140 * means that private methods may also be
1141 * added. [TIP 500] */
1142 Class *contextCls, /* Context class; the currently considered
1143 * class is equal to this, private methods may
1144 * also be added. [TIP 500] */
1145 Tcl_Obj *cacheInThisObj) /* What object to cache in, or NULL if it is
1146 * to be in the same object as the
1147 * methodNameObj. */
1148 {
1149 CallContext *contextPtr;
1150 CallChain *callPtr;
1151 struct ChainBuilder cb;
1152 int i, count, doFilters, donePrivate = 0;
1153 Tcl_HashEntry *hPtr;
1154 Tcl_HashTable doneFilters;
1155
1156 if (cacheInThisObj == NULL) {
1157 cacheInThisObj = methodNameObj;
1158 }
1159 if (flags&(SPECIAL|FILTER_HANDLING) || (oPtr->flags&FILTER_HANDLING)) {
1160 hPtr = NULL;
1161 doFilters = 0;
1162
1163 /*
1164 * Check if we have a cached valid constructor or destructor.
1165 */
1166
1167 if (flags & CONSTRUCTOR) {
1168 callPtr = oPtr->selfCls->constructorChainPtr;
1169 if ((callPtr != NULL)
1170 && (callPtr->objectEpoch == oPtr->selfCls->thisPtr->epoch)
1171 && (callPtr->epoch == oPtr->fPtr->epoch)) {
1172 callPtr->refCount++;
1173 goto returnContext;
1174 }
1175 } else if (flags & DESTRUCTOR) {
1176 callPtr = oPtr->selfCls->destructorChainPtr;
1177 if ((oPtr->mixins.num == 0) && (callPtr != NULL)
1178 && (callPtr->objectEpoch == oPtr->selfCls->thisPtr->epoch)
1179 && (callPtr->epoch == oPtr->fPtr->epoch)) {
1180 callPtr->refCount++;
1181 goto returnContext;
1182 }
1183 }
1184 } else {
1185 /*
1186 * Check if we can get the chain out of the Tcl_Obj method name or out
1187 * of the cache. This is made a bit more complex by the fact that
1188 * there are multiple different layers of cache (in the Tcl_Obj, in
1189 * the object, and in the class).
1190 */
1191
1192 const Tcl_ObjIntRep *irPtr;
1193 const int reuseMask = (WANT_PUBLIC(flags) ? ~0 : ~PUBLIC_METHOD);
1194
1195 if ((irPtr = TclFetchIntRep(cacheInThisObj, &methodNameType))) {
1196 callPtr = (CallChain *)irPtr->twoPtrValue.ptr1;
1197 if (IsStillValid(callPtr, oPtr, flags, reuseMask)) {
1198 callPtr->refCount++;
1199 goto returnContext;
1200 }
1201 Tcl_StoreIntRep(cacheInThisObj, &methodNameType, NULL);
1202 }
1203
1204 if (oPtr->flags & USE_CLASS_CACHE) {
1205 if (oPtr->selfCls->classChainCache != NULL) {
1206 hPtr = Tcl_FindHashEntry(oPtr->selfCls->classChainCache,
1207 (char *) methodNameObj);
1208 } else {
1209 hPtr = NULL;
1210 }
1211 } else {
1212 if (oPtr->chainCache != NULL) {
1213 hPtr = Tcl_FindHashEntry(oPtr->chainCache,
1214 (char *) methodNameObj);
1215 } else {
1216 hPtr = NULL;
1217 }
1218 }
1219
1220 if (hPtr != NULL && Tcl_GetHashValue(hPtr) != NULL) {
1221 callPtr = (CallChain *)Tcl_GetHashValue(hPtr);
1222 if (IsStillValid(callPtr, oPtr, flags, reuseMask)) {
1223 callPtr->refCount++;
1224 goto returnContext;
1225 }
1226 Tcl_SetHashValue(hPtr, NULL);
1227 TclOODeleteChain(callPtr);
1228 }
1229
1230 doFilters = 1;
1231 }
1232
1233 callPtr = (CallChain *)ckalloc(sizeof(CallChain));
1234 InitCallChain(callPtr, oPtr, flags);
1235
1236 cb.callChainPtr = callPtr;
1237 cb.filterLength = 0;
1238 cb.oPtr = oPtr;
1239
1240 /*
1241 * If we're working with a forced use of unknown, do that now.
1242 */
1243
1244 if (flags & FORCE_UNKNOWN) {
1245 AddSimpleChainToCallContext(oPtr, NULL,
1246 oPtr->fPtr->unknownMethodNameObj, &cb, NULL, BUILDING_MIXINS,
1247 NULL);
1248 AddSimpleChainToCallContext(oPtr, NULL,
1249 oPtr->fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL);
1250 callPtr->flags |= OO_UNKNOWN_METHOD;
1251 callPtr->epoch = -1;
1252 if (callPtr->numChain == 0) {
1253 TclOODeleteChain(callPtr);
1254 return NULL;
1255 }
1256 goto returnContext;
1257 }
1258
1259 /*
1260 * Add all defined filters (if any, and if we're going to be processing
1261 * them; they're not processed for constructors, destructors or when we're
1262 * in the middle of processing a filter).
1263 */
1264
1265 if (doFilters) {
1266 Tcl_Obj *filterObj;
1267 Class *mixinPtr;
1268
1269 doFilters = 1;
1270 Tcl_InitObjHashTable(&doneFilters);
1271 FOREACH(mixinPtr, oPtr->mixins) {
1272 AddClassFiltersToCallContext(oPtr, mixinPtr, &cb, &doneFilters,
1273 TRAVERSED_MIXIN|BUILDING_MIXINS|OBJECT_MIXIN);
1274 AddClassFiltersToCallContext(oPtr, mixinPtr, &cb, &doneFilters,
1275 OBJECT_MIXIN);
1276 }
1277 FOREACH(filterObj, oPtr->filters) {
1278 donePrivate |= AddSimpleChainToCallContext(oPtr, contextCls,
1279 filterObj, &cb, &doneFilters, BUILDING_MIXINS, NULL);
1280 donePrivate |= AddSimpleChainToCallContext(oPtr, contextCls,
1281 filterObj, &cb, &doneFilters, 0, NULL);
1282 }
1283 AddClassFiltersToCallContext(oPtr, oPtr->selfCls, &cb, &doneFilters,
1284 BUILDING_MIXINS);
1285 AddClassFiltersToCallContext(oPtr, oPtr->selfCls, &cb, &doneFilters,
1286 0);
1287 Tcl_DeleteHashTable(&doneFilters);
1288 }
1289 count = cb.filterLength = callPtr->numChain;
1290
1291 /*
1292 * Add the actual method implementations. We have to do this twice to
1293 * handle class mixins right.
1294 */
1295
1296 if (oPtr == contextObj) {
1297 donePrivate |= AddInstancePrivateToCallContext(oPtr, methodNameObj,
1298 &cb, flags);
1299 donePrivate |= (contextObj->flags & HAS_PRIVATE_METHODS);
1300 }
1301 donePrivate |= AddSimpleChainToCallContext(oPtr, contextCls,
1302 methodNameObj, &cb, NULL, flags|BUILDING_MIXINS, NULL);
1303 donePrivate |= AddSimpleChainToCallContext(oPtr, contextCls,
1304 methodNameObj, &cb, NULL, flags, NULL);
1305
1306 /*
1307 * Check to see if the method has no implementation. If so, we probably
1308 * need to add in a call to the unknown method. Otherwise, set up the
1309 * cacheing of the method implementation (if relevant).
1310 */
1311
1312 if (count == callPtr->numChain) {
1313 /*
1314 * Method does not actually exist. If we're dealing with constructors
1315 * or destructors, this isn't a problem.
1316 */
1317
1318 if (flags & SPECIAL) {
1319 TclOODeleteChain(callPtr);
1320 return NULL;
1321 }
1322 AddSimpleChainToCallContext(oPtr, NULL,
1323 oPtr->fPtr->unknownMethodNameObj, &cb, NULL, BUILDING_MIXINS,
1324 NULL);
1325 AddSimpleChainToCallContext(oPtr, NULL,
1326 oPtr->fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL);
1327 callPtr->flags |= OO_UNKNOWN_METHOD;
1328 callPtr->epoch = -1;
1329 if (count == callPtr->numChain) {
1330 TclOODeleteChain(callPtr);
1331 return NULL;
1332 }
1333 } else if (doFilters && !donePrivate) {
1334 if (hPtr == NULL) {
1335 if (oPtr->flags & USE_CLASS_CACHE) {
1336 if (oPtr->selfCls->classChainCache == NULL) {
1337 oPtr->selfCls->classChainCache =
1338 (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
1339
1340 Tcl_InitObjHashTable(oPtr->selfCls->classChainCache);
1341 }
1342 hPtr = Tcl_CreateHashEntry(oPtr->selfCls->classChainCache,
1343 (char *) methodNameObj, &i);
1344 } else {
1345 if (oPtr->chainCache == NULL) {
1346 oPtr->chainCache = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
1347
1348 Tcl_InitObjHashTable(oPtr->chainCache);
1349 }
1350 hPtr = Tcl_CreateHashEntry(oPtr->chainCache,
1351 (char *) methodNameObj, &i);
1352 }
1353 }
1354 callPtr->refCount++;
1355 Tcl_SetHashValue(hPtr, callPtr);
1356 StashCallChain(cacheInThisObj, callPtr);
1357 } else if (flags & CONSTRUCTOR) {
1358 if (oPtr->selfCls->constructorChainPtr) {
1359 TclOODeleteChain(oPtr->selfCls->constructorChainPtr);
1360 }
1361 oPtr->selfCls->constructorChainPtr = callPtr;
1362 callPtr->refCount++;
1363 } else if ((flags & DESTRUCTOR) && oPtr->mixins.num == 0) {
1364 if (oPtr->selfCls->destructorChainPtr) {
1365 TclOODeleteChain(oPtr->selfCls->destructorChainPtr);
1366 }
1367 oPtr->selfCls->destructorChainPtr = callPtr;
1368 callPtr->refCount++;
1369 }
1370
1371 returnContext:
1372 contextPtr = (CallContext *)TclStackAlloc(oPtr->fPtr->interp, sizeof(CallContext));
1373 contextPtr->oPtr = oPtr;
1374
1375 /*
1376 * Corresponding TclOODecrRefCount() in TclOODeleteContext
1377 */
1378
1379 AddRef(oPtr);
1380 contextPtr->callPtr = callPtr;
1381 contextPtr->skip = 2;
1382 contextPtr->index = 0;
1383 return contextPtr;
1384 }
1385
1386 /*
1387 * ----------------------------------------------------------------------
1388 *
1389 * TclOOGetStereotypeCallChain --
1390 *
1391 * Construct a call-chain for a method that would be used by a
1392 * stereotypical instance of the given class (i.e., where the object has
1393 * no definitions special to itself).
1394 *
1395 * ----------------------------------------------------------------------
1396 */
1397
1398 CallChain *
TclOOGetStereotypeCallChain(Class * clsPtr,Tcl_Obj * methodNameObj,int flags)1399 TclOOGetStereotypeCallChain(
1400 Class *clsPtr, /* The object to get the context for. */
1401 Tcl_Obj *methodNameObj, /* The name of the method to get the context
1402 * for. NULL when getting a constructor or
1403 * destructor chain. */
1404 int flags) /* What sort of context are we looking for.
1405 * Only the bits PUBLIC_METHOD, CONSTRUCTOR,
1406 * PRIVATE_METHOD, DESTRUCTOR and
1407 * FILTER_HANDLING are useful. */
1408 {
1409 CallChain *callPtr;
1410 struct ChainBuilder cb;
1411 int i, count;
1412 Foundation *fPtr = clsPtr->thisPtr->fPtr;
1413 Tcl_HashEntry *hPtr;
1414 Tcl_HashTable doneFilters;
1415 Object obj;
1416
1417 /*
1418 * Synthesize a temporary stereotypical object so that we can use existing
1419 * machinery to produce the stereotypical call chain.
1420 */
1421
1422 memset(&obj, 0, sizeof(Object));
1423 obj.fPtr = fPtr;
1424 obj.selfCls = clsPtr;
1425 obj.refCount = 1;
1426 obj.flags = USE_CLASS_CACHE;
1427
1428 /*
1429 * Check if we can get the chain out of the Tcl_Obj method name or out of
1430 * the cache. This is made a bit more complex by the fact that there are
1431 * multiple different layers of cache (in the Tcl_Obj, in the object, and
1432 * in the class).
1433 */
1434
1435 if (clsPtr->classChainCache != NULL) {
1436 hPtr = Tcl_FindHashEntry(clsPtr->classChainCache,
1437 (char *) methodNameObj);
1438 if (hPtr != NULL && Tcl_GetHashValue(hPtr) != NULL) {
1439 const int reuseMask = (WANT_PUBLIC(flags) ? ~0 : ~PUBLIC_METHOD);
1440
1441 callPtr = (CallChain *)Tcl_GetHashValue(hPtr);
1442 if (IsStillValid(callPtr, &obj, flags, reuseMask)) {
1443 callPtr->refCount++;
1444 return callPtr;
1445 }
1446 Tcl_SetHashValue(hPtr, NULL);
1447 TclOODeleteChain(callPtr);
1448 }
1449 } else {
1450 hPtr = NULL;
1451 }
1452
1453 callPtr = (CallChain *)ckalloc(sizeof(CallChain));
1454 memset(callPtr, 0, sizeof(CallChain));
1455 callPtr->flags = flags & (PUBLIC_METHOD|PRIVATE_METHOD|FILTER_HANDLING);
1456 callPtr->epoch = fPtr->epoch;
1457 callPtr->objectCreationEpoch = fPtr->tsdPtr->nsCount;
1458 callPtr->objectEpoch = clsPtr->thisPtr->epoch;
1459 callPtr->refCount = 1;
1460 callPtr->chain = callPtr->staticChain;
1461
1462 cb.callChainPtr = callPtr;
1463 cb.filterLength = 0;
1464 cb.oPtr = &obj;
1465
1466 /*
1467 * Add all defined filters (if any, and if we're going to be processing
1468 * them; they're not processed for constructors, destructors or when we're
1469 * in the middle of processing a filter).
1470 */
1471
1472 Tcl_InitObjHashTable(&doneFilters);
1473 AddClassFiltersToCallContext(&obj, clsPtr, &cb, &doneFilters,
1474 BUILDING_MIXINS);
1475 AddClassFiltersToCallContext(&obj, clsPtr, &cb, &doneFilters, 0);
1476 Tcl_DeleteHashTable(&doneFilters);
1477 count = cb.filterLength = callPtr->numChain;
1478
1479 /*
1480 * Add the actual method implementations.
1481 */
1482
1483 AddSimpleChainToCallContext(&obj, NULL, methodNameObj, &cb, NULL,
1484 flags|BUILDING_MIXINS, NULL);
1485 AddSimpleChainToCallContext(&obj, NULL, methodNameObj, &cb, NULL, flags,
1486 NULL);
1487
1488 /*
1489 * Check to see if the method has no implementation. If so, we probably
1490 * need to add in a call to the unknown method. Otherwise, set up the
1491 * cacheing of the method implementation (if relevant).
1492 */
1493
1494 if (count == callPtr->numChain) {
1495 AddSimpleChainToCallContext(&obj, NULL, fPtr->unknownMethodNameObj,
1496 &cb, NULL, BUILDING_MIXINS, NULL);
1497 AddSimpleChainToCallContext(&obj, NULL, fPtr->unknownMethodNameObj,
1498 &cb, NULL, 0, NULL);
1499 callPtr->flags |= OO_UNKNOWN_METHOD;
1500 callPtr->epoch = -1;
1501 if (count == callPtr->numChain) {
1502 TclOODeleteChain(callPtr);
1503 return NULL;
1504 }
1505 } else {
1506 if (hPtr == NULL) {
1507 if (clsPtr->classChainCache == NULL) {
1508 clsPtr->classChainCache = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
1509 Tcl_InitObjHashTable(clsPtr->classChainCache);
1510 }
1511 hPtr = Tcl_CreateHashEntry(clsPtr->classChainCache,
1512 (char *) methodNameObj, &i);
1513 }
1514 callPtr->refCount++;
1515 Tcl_SetHashValue(hPtr, callPtr);
1516 StashCallChain(methodNameObj, callPtr);
1517 }
1518 return callPtr;
1519 }
1520
1521 /*
1522 * ----------------------------------------------------------------------
1523 *
1524 * AddClassFiltersToCallContext --
1525 *
1526 * Logic to make extracting all the filters from the class context much
1527 * easier.
1528 *
1529 * ----------------------------------------------------------------------
1530 */
1531
1532 static void
AddClassFiltersToCallContext(Object * const oPtr,Class * clsPtr,struct ChainBuilder * const cbPtr,Tcl_HashTable * const doneFilters,int flags)1533 AddClassFiltersToCallContext(
1534 Object *const oPtr, /* Object that the filters operate on. */
1535 Class *clsPtr, /* Class to get the filters from. */
1536 struct ChainBuilder *const cbPtr,
1537 /* Context to fill with call chain entries. */
1538 Tcl_HashTable *const doneFilters,
1539 /* Where to record what filters have been
1540 * processed. Keys are objects, values are
1541 * ignored. */
1542 int flags) /* Whether we've gone along a mixin link
1543 * yet. */
1544 {
1545 int i, clearedFlags =
1546 flags & ~(TRAVERSED_MIXIN|OBJECT_MIXIN|BUILDING_MIXINS);
1547 Class *superPtr, *mixinPtr;
1548 Tcl_Obj *filterObj;
1549
1550 tailRecurse:
1551 if (clsPtr == NULL) {
1552 return;
1553 }
1554
1555 /*
1556 * Add all the filters defined by classes mixed into the main class
1557 * hierarchy.
1558 */
1559
1560 FOREACH(mixinPtr, clsPtr->mixins) {
1561 AddClassFiltersToCallContext(oPtr, mixinPtr, cbPtr, doneFilters,
1562 flags|TRAVERSED_MIXIN);
1563 }
1564
1565 /*
1566 * Add all the class filters from the current class. Note that the filters
1567 * are added starting at the object root, as this allows the object to
1568 * override how filters work to extend their behaviour.
1569 */
1570
1571 if (MIXIN_CONSISTENT(flags)) {
1572 FOREACH(filterObj, clsPtr->filters) {
1573 int isNew;
1574
1575 (void) Tcl_CreateHashEntry(doneFilters, (char *) filterObj,
1576 &isNew);
1577 if (isNew) {
1578 AddSimpleChainToCallContext(oPtr, NULL, filterObj, cbPtr,
1579 doneFilters, clearedFlags|BUILDING_MIXINS, clsPtr);
1580 AddSimpleChainToCallContext(oPtr, NULL, filterObj, cbPtr,
1581 doneFilters, clearedFlags, clsPtr);
1582 }
1583 }
1584 }
1585
1586 /*
1587 * Now process the recursive case. Notice the tail-call optimization.
1588 */
1589
1590 switch (clsPtr->superclasses.num) {
1591 case 1:
1592 clsPtr = clsPtr->superclasses.list[0];
1593 goto tailRecurse;
1594 default:
1595 FOREACH(superPtr, clsPtr->superclasses) {
1596 AddClassFiltersToCallContext(oPtr, superPtr, cbPtr, doneFilters,
1597 flags);
1598 }
1599 case 0:
1600 return;
1601 }
1602 }
1603
1604 /*
1605 * ----------------------------------------------------------------------
1606 *
1607 * AddPrivatesFromClassChainToCallContext --
1608 *
1609 * Helper for AddSimpleChainToCallContext that is used to find private
1610 * methds and add them to the call chain. Returns true when a private
1611 * method is found and added. [TIP 500]
1612 *
1613 * ----------------------------------------------------------------------
1614 */
1615
1616 static int
AddPrivatesFromClassChainToCallContext(Class * classPtr,Class * const contextCls,Tcl_Obj * const methodName,struct ChainBuilder * const cbPtr,Tcl_HashTable * const doneFilters,int flags,Class * const filterDecl)1617 AddPrivatesFromClassChainToCallContext(
1618 Class *classPtr, /* Class to add the call chain entries for. */
1619 Class *const contextCls, /* Context class; the currently considered
1620 * class is equal to this, private methods may
1621 * also be added. */
1622 Tcl_Obj *const methodName, /* Name of method to add the call chain
1623 * entries for. */
1624 struct ChainBuilder *const cbPtr,
1625 /* Where to add the call chain entries. */
1626 Tcl_HashTable *const doneFilters,
1627 /* Where to record what call chain entries
1628 * have been processed. */
1629 int flags, /* What sort of call chain are we building. */
1630 Class *const filterDecl) /* The class that declared the filter. If
1631 * NULL, either the filter was declared by the
1632 * object or this isn't a filter. */
1633 {
1634 int i;
1635 Class *superPtr;
1636
1637 /*
1638 * We hard-code the tail-recursive form. It's by far the most common case
1639 * *and* it is much more gentle on the stack.
1640 *
1641 * Note that mixins must be processed before the main class hierarchy.
1642 * [Bug 1998221]
1643 */
1644
1645 tailRecurse:
1646 FOREACH(superPtr, classPtr->mixins) {
1647 if (AddPrivatesFromClassChainToCallContext(superPtr, contextCls,
1648 methodName, cbPtr, doneFilters, flags|TRAVERSED_MIXIN,
1649 filterDecl)) {
1650 return 1;
1651 }
1652 }
1653
1654 if (classPtr == contextCls) {
1655 Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods,
1656 methodName);
1657
1658 if (hPtr != NULL) {
1659 Method *mPtr = (Method *)Tcl_GetHashValue(hPtr);
1660
1661 if (IS_PRIVATE(mPtr)) {
1662 AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl,
1663 flags);
1664 return 1;
1665 }
1666 }
1667 }
1668
1669 switch (classPtr->superclasses.num) {
1670 case 1:
1671 classPtr = classPtr->superclasses.list[0];
1672 goto tailRecurse;
1673 default:
1674 FOREACH(superPtr, classPtr->superclasses) {
1675 if (AddPrivatesFromClassChainToCallContext(superPtr, contextCls,
1676 methodName, cbPtr, doneFilters, flags, filterDecl)) {
1677 return 1;
1678 }
1679 }
1680 /* FALLTHRU */
1681 case 0:
1682 return 0;
1683 }
1684 }
1685
1686 /*
1687 * ----------------------------------------------------------------------
1688 *
1689 * AddSimpleClassChainToCallContext --
1690 *
1691 * Construct a call-chain from a class hierarchy.
1692 *
1693 * ----------------------------------------------------------------------
1694 */
1695
1696 static int
AddSimpleClassChainToCallContext(Class * classPtr,Tcl_Obj * const methodNameObj,struct ChainBuilder * const cbPtr,Tcl_HashTable * const doneFilters,int flags,Class * const filterDecl)1697 AddSimpleClassChainToCallContext(
1698 Class *classPtr, /* Class to add the call chain entries for. */
1699 Tcl_Obj *const methodNameObj,
1700 /* Name of method to add the call chain
1701 * entries for. */
1702 struct ChainBuilder *const cbPtr,
1703 /* Where to add the call chain entries. */
1704 Tcl_HashTable *const doneFilters,
1705 /* Where to record what call chain entries
1706 * have been processed. */
1707 int flags, /* What sort of call chain are we building. */
1708 Class *const filterDecl) /* The class that declared the filter. If
1709 * NULL, either the filter was declared by the
1710 * object or this isn't a filter. */
1711 {
1712 int i, privateDanger = 0;
1713 Class *superPtr;
1714
1715 /*
1716 * We hard-code the tail-recursive form. It's by far the most common case
1717 * *and* it is much more gentle on the stack.
1718 *
1719 * Note that mixins must be processed before the main class hierarchy.
1720 * [Bug 1998221]
1721 */
1722
1723 tailRecurse:
1724 FOREACH(superPtr, classPtr->mixins) {
1725 privateDanger |= AddSimpleClassChainToCallContext(superPtr,
1726 methodNameObj, cbPtr, doneFilters, flags | TRAVERSED_MIXIN,
1727 filterDecl);
1728 }
1729
1730 if (flags & CONSTRUCTOR) {
1731 AddMethodToCallChain(classPtr->constructorPtr, cbPtr, doneFilters,
1732 filterDecl, flags);
1733 } else if (flags & DESTRUCTOR) {
1734 AddMethodToCallChain(classPtr->destructorPtr, cbPtr, doneFilters,
1735 filterDecl, flags);
1736 } else {
1737 Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods,
1738 (char *) methodNameObj);
1739
1740 if (classPtr->flags & HAS_PRIVATE_METHODS) {
1741 privateDanger |= 1;
1742 }
1743 if (hPtr != NULL) {
1744 Method *mPtr = (Method *)Tcl_GetHashValue(hPtr);
1745
1746 if (!IS_PRIVATE(mPtr)) {
1747 if (!(flags & KNOWN_STATE)) {
1748 if (flags & PUBLIC_METHOD) {
1749 if (!IS_PUBLIC(mPtr)) {
1750 return privateDanger;
1751 }
1752 flags |= DEFINITE_PUBLIC;
1753 } else {
1754 flags |= DEFINITE_PROTECTED;
1755 }
1756 }
1757 AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl,
1758 flags);
1759 }
1760 }
1761 }
1762
1763 switch (classPtr->superclasses.num) {
1764 case 1:
1765 classPtr = classPtr->superclasses.list[0];
1766 goto tailRecurse;
1767 default:
1768 FOREACH(superPtr, classPtr->superclasses) {
1769 privateDanger |= AddSimpleClassChainToCallContext(superPtr,
1770 methodNameObj, cbPtr, doneFilters, flags, filterDecl);
1771 }
1772 /* FALLTHRU */
1773 case 0:
1774 return privateDanger;
1775 }
1776 }
1777
1778 /*
1779 * ----------------------------------------------------------------------
1780 *
1781 * TclOORenderCallChain --
1782 *
1783 * Create a description of a call chain. Used in [info object call],
1784 * [info class call], and [self call].
1785 *
1786 * ----------------------------------------------------------------------
1787 */
1788
1789 Tcl_Obj *
TclOORenderCallChain(Tcl_Interp * interp,CallChain * callPtr)1790 TclOORenderCallChain(
1791 Tcl_Interp *interp,
1792 CallChain *callPtr)
1793 {
1794 Tcl_Obj *filterLiteral, *methodLiteral, *objectLiteral, *privateLiteral;
1795 Tcl_Obj *resultObj, *descObjs[4], **objv;
1796 Foundation *fPtr = TclOOGetFoundation(interp);
1797 int i;
1798
1799 /*
1800 * Allocate the literals (potentially) used in our description.
1801 */
1802
1803 TclNewLiteralStringObj(filterLiteral, "filter");
1804 Tcl_IncrRefCount(filterLiteral);
1805 TclNewLiteralStringObj(methodLiteral, "method");
1806 Tcl_IncrRefCount(methodLiteral);
1807 TclNewLiteralStringObj(objectLiteral, "object");
1808 Tcl_IncrRefCount(objectLiteral);
1809 TclNewLiteralStringObj(privateLiteral, "private");
1810 Tcl_IncrRefCount(privateLiteral);
1811
1812 /*
1813 * Do the actual construction of the descriptions. They consist of a list
1814 * of triples that describe the details of how a method is understood. For
1815 * each triple, the first word is the type of invocation ("method" is
1816 * normal, "unknown" is special because it adds the method name as an
1817 * extra argument when handled by some method types, and "filter" is
1818 * special because it's a filter method). The second word is the name of
1819 * the method in question (which differs for "unknown" and "filter" types)
1820 * and the third word is the full name of the class that declares the
1821 * method (or "object" if it is declared on the instance).
1822 */
1823
1824 objv = (Tcl_Obj **)TclStackAlloc(interp, callPtr->numChain * sizeof(Tcl_Obj *));
1825 for (i = 0 ; i < callPtr->numChain ; i++) {
1826 struct MInvoke *miPtr = &callPtr->chain[i];
1827
1828 descObjs[0] =
1829 miPtr->isFilter ? filterLiteral :
1830 callPtr->flags & OO_UNKNOWN_METHOD ? fPtr->unknownMethodNameObj :
1831 IS_PRIVATE(miPtr->mPtr) ? privateLiteral :
1832 methodLiteral;
1833 descObjs[1] =
1834 callPtr->flags & CONSTRUCTOR ? fPtr->constructorName :
1835 callPtr->flags & DESTRUCTOR ? fPtr->destructorName :
1836 miPtr->mPtr->namePtr;
1837 descObjs[2] = miPtr->mPtr->declaringClassPtr
1838 ? Tcl_GetObjectName(interp,
1839 (Tcl_Object) miPtr->mPtr->declaringClassPtr->thisPtr)
1840 : objectLiteral;
1841 descObjs[3] = Tcl_NewStringObj(miPtr->mPtr->typePtr->name, -1);
1842
1843 objv[i] = Tcl_NewListObj(4, descObjs);
1844 }
1845
1846 /*
1847 * Drop the local references to the literals; if they're actually used,
1848 * they'll live on the description itself.
1849 */
1850
1851 Tcl_DecrRefCount(filterLiteral);
1852 Tcl_DecrRefCount(methodLiteral);
1853 Tcl_DecrRefCount(objectLiteral);
1854 Tcl_DecrRefCount(privateLiteral);
1855
1856 /*
1857 * Finish building the description and return it.
1858 */
1859
1860 resultObj = Tcl_NewListObj(callPtr->numChain, objv);
1861 TclStackFree(interp, objv);
1862 return resultObj;
1863 }
1864
1865 /*
1866 * ----------------------------------------------------------------------
1867 *
1868 * TclOOGetDefineContextNamespace --
1869 *
1870 * Responsible for determining which namespace to use for definitions.
1871 * This is done by building a define chain, which models (strongly!) the
1872 * way that a call chain works but with a different internal model.
1873 *
1874 * Then it walks the chain to find the first namespace name that actually
1875 * resolves to an existing namespace.
1876 *
1877 * Returns:
1878 * Name of namespace, or NULL if none can be found. Note that this
1879 * function does *not* set an error message in the interpreter on failure.
1880 *
1881 * ----------------------------------------------------------------------
1882 */
1883
1884 #define DEFINE_CHAIN_STATIC_SIZE 4 /* Enough space to store most cases. */
1885
1886 Tcl_Namespace *
TclOOGetDefineContextNamespace(Tcl_Interp * interp,Object * oPtr,int forClass)1887 TclOOGetDefineContextNamespace(
1888 Tcl_Interp *interp, /* In what interpreter should namespace names
1889 * actually be resolved. */
1890 Object *oPtr, /* The object to get the context for. */
1891 int forClass) /* What sort of context are we looking for.
1892 * If true, we are going to use this for
1893 * [oo::define], otherwise, we are going to
1894 * use this for [oo::objdefine]. */
1895 {
1896 DefineChain define;
1897 DefineEntry staticSpace[DEFINE_CHAIN_STATIC_SIZE];
1898 DefineEntry *entryPtr;
1899 Tcl_Namespace *nsPtr = NULL;
1900 int i;
1901
1902 define.list = staticSpace;
1903 define.num = 0;
1904 define.size = DEFINE_CHAIN_STATIC_SIZE;
1905
1906 /*
1907 * Add the actual define locations. We have to do this twice to handle
1908 * class mixins right.
1909 */
1910
1911 AddSimpleDefineNamespaces(oPtr, &define, forClass | BUILDING_MIXINS);
1912 AddSimpleDefineNamespaces(oPtr, &define, forClass);
1913
1914 /*
1915 * Go through the list until we find a namespace whose name we can
1916 * resolve.
1917 */
1918
1919 FOREACH_STRUCT(entryPtr, define) {
1920 if (TclGetNamespaceFromObj(interp, entryPtr->namespaceName,
1921 &nsPtr) == TCL_OK) {
1922 break;
1923 }
1924 Tcl_ResetResult(interp);
1925 }
1926 if (define.list != staticSpace) {
1927 ckfree(define.list);
1928 }
1929 return nsPtr;
1930 }
1931
1932 /*
1933 * ----------------------------------------------------------------------
1934 *
1935 * AddSimpleDefineNamespaces --
1936 *
1937 * Adds to the definition chain all the definitions provided by an
1938 * object's class and its mixins, taking into account everything they
1939 * inherit from.
1940 *
1941 * ----------------------------------------------------------------------
1942 */
1943
1944 static inline void
AddSimpleDefineNamespaces(Object * const oPtr,DefineChain * const definePtr,int flags)1945 AddSimpleDefineNamespaces(
1946 Object *const oPtr, /* Object to add define chain entries for. */
1947 DefineChain *const definePtr,
1948 /* Where to add the define chain entries. */
1949 int flags) /* What sort of define chain are we
1950 * building. */
1951 {
1952 Class *mixinPtr;
1953 int i;
1954
1955 FOREACH(mixinPtr, oPtr->mixins) {
1956 AddSimpleClassDefineNamespaces(mixinPtr, definePtr,
1957 flags | TRAVERSED_MIXIN);
1958 }
1959
1960 AddSimpleClassDefineNamespaces(oPtr->selfCls, definePtr, flags);
1961 }
1962
1963 /*
1964 * ----------------------------------------------------------------------
1965 *
1966 * AddSimpleClassDefineNamespaces --
1967 *
1968 * Adds to the definition chain all the definitions provided by a class
1969 * and its superclasses and its class mixins.
1970 *
1971 * ----------------------------------------------------------------------
1972 */
1973
1974 static void
AddSimpleClassDefineNamespaces(Class * classPtr,DefineChain * const definePtr,int flags)1975 AddSimpleClassDefineNamespaces(
1976 Class *classPtr, /* Class to add the define chain entries for. */
1977 DefineChain *const definePtr,
1978 /* Where to add the define chain entries. */
1979 int flags) /* What sort of define chain are we
1980 * building. */
1981 {
1982 int i;
1983 Class *superPtr;
1984
1985 /*
1986 * We hard-code the tail-recursive form. It's by far the most common case
1987 * *and* it is much more gentle on the stack.
1988 */
1989
1990 tailRecurse:
1991 FOREACH(superPtr, classPtr->mixins) {
1992 AddSimpleClassDefineNamespaces(superPtr, definePtr,
1993 flags | TRAVERSED_MIXIN);
1994 }
1995
1996 if (flags & ~(TRAVERSED_MIXIN | BUILDING_MIXINS)) {
1997 AddDefinitionNamespaceToChain(classPtr, classPtr->clsDefinitionNs,
1998 definePtr, flags);
1999 } else {
2000 AddDefinitionNamespaceToChain(classPtr, classPtr->objDefinitionNs,
2001 definePtr, flags);
2002 }
2003
2004 switch (classPtr->superclasses.num) {
2005 case 1:
2006 classPtr = classPtr->superclasses.list[0];
2007 goto tailRecurse;
2008 default:
2009 FOREACH(superPtr, classPtr->superclasses) {
2010 AddSimpleClassDefineNamespaces(superPtr, definePtr, flags);
2011 }
2012 case 0:
2013 return;
2014 }
2015 }
2016
2017 /*
2018 * ----------------------------------------------------------------------
2019 *
2020 * AddDefinitionNamespaceToChain --
2021 *
2022 * Adds a single item to the definition chain (if it is meaningful),
2023 * reallocating the space for the chain if necessary.
2024 *
2025 * ----------------------------------------------------------------------
2026 */
2027
2028 static inline void
AddDefinitionNamespaceToChain(Class * const definerCls,Tcl_Obj * const namespaceName,DefineChain * const definePtr,int flags)2029 AddDefinitionNamespaceToChain(
2030 Class *const definerCls, /* What class defines this entry. */
2031 Tcl_Obj *const namespaceName, /* The name for this entry (or NULL, a
2032 * no-op). */
2033 DefineChain *const definePtr,
2034 /* The define chain to add the method
2035 * implementation to. */
2036 int flags) /* Used to check if we're mixin-consistent
2037 * only. Mixin-consistent means that either
2038 * we're looking to add things from a mixin
2039 * and we have passed a mixin, or we're not
2040 * looking to add things from a mixin and have
2041 * not passed a mixin. */
2042 {
2043 int i;
2044
2045 /*
2046 * Return if this entry is blank. This is also where we enforce
2047 * mixin-consistency.
2048 */
2049
2050 if (namespaceName == NULL || !MIXIN_CONSISTENT(flags)) {
2051 return;
2052 }
2053
2054 /*
2055 * First test whether the method is already in the call chain.
2056 */
2057
2058 for (i=0 ; i<definePtr->num ; i++) {
2059 if (definePtr->list[i].definerCls == definerCls) {
2060 /*
2061 * Call chain semantics states that methods come as *late* in the
2062 * call chain as possible. This is done by copying down the
2063 * following methods. Note that this does not change the number of
2064 * method invocations in the call chain; it just rearranges them.
2065 *
2066 * We skip changing anything if the place we found was already at
2067 * the end of the list.
2068 */
2069
2070 if (i < definePtr->num - 1) {
2071 memmove(&definePtr->list[i], &definePtr->list[i + 1],
2072 sizeof(DefineEntry) * (definePtr->num - i - 1));
2073 definePtr->list[i].definerCls = definerCls;
2074 definePtr->list[i].namespaceName = namespaceName;
2075 }
2076 return;
2077 }
2078 }
2079
2080 /*
2081 * Need to really add the define. This is made a bit more complex by the
2082 * fact that we are using some "static" space initially, and only start
2083 * realloc-ing if the chain gets long.
2084 */
2085
2086 if (definePtr->num == definePtr->size) {
2087 definePtr->size *= 2;
2088 if (definePtr->num == DEFINE_CHAIN_STATIC_SIZE) {
2089 DefineEntry *staticList = definePtr->list;
2090
2091 definePtr->list =
2092 (DefineEntry *)ckalloc(sizeof(DefineEntry) * definePtr->size);
2093 memcpy(definePtr->list, staticList,
2094 sizeof(DefineEntry) * definePtr->num);
2095 } else {
2096 definePtr->list = (DefineEntry *)ckrealloc(definePtr->list,
2097 sizeof(DefineEntry) * definePtr->size);
2098 }
2099 }
2100 definePtr->list[i].definerCls = definerCls;
2101 definePtr->list[i].namespaceName = namespaceName;
2102 definePtr->num++;
2103 }
2104
2105 /*
2106 * Local Variables:
2107 * mode: c
2108 * c-basic-offset: 4
2109 * fill-column: 78
2110 * End:
2111 */
2112