1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
|
/*
* tclOO.h --
*
* This file contains the structure definitions and some of the function
* declarations for the object-system (NB: not Tcl_Obj, but ::oo).
*
* Copyright (c) 2006 by Donal K. Fellows
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* RCS: @(#) $Id: tclOO.h,v 1.2 2006/10/20 14:04:01 dkf Exp $
*/
// vvvvvvvvvvvvvvvvvvvvvv MOVE TO TCL.DECLS vvvvvvvvvvvvvvvvvvvvvv
Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp,
Tcl_Object sourceObject, const char *targetName);
Tcl_Object Tcl_GetClassAsObject(Tcl_Class clazz);
Tcl_Class Tcl_GetObjectAsClass(Tcl_Object object);
Tcl_Command Tcl_GetObjectCommand(Tcl_Object object);
Tcl_Object Tcl_GetObjectFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr);
Tcl_Namespace * Tcl_GetObjectNamespace(Tcl_Object object);
Tcl_Class Tcl_MethodDeclarerClass(Tcl_Method method);
Tcl_Object Tcl_MethodDeclarerObject(Tcl_Method method);
int Tcl_MethodIsPublic(Tcl_Method method);
int Tcl_MethodIsType(Tcl_Method method,
const Tcl_MethodType *typePtr,
ClientData *clientDataPtr);
Tcl_Obj * Tcl_MethodName(Tcl_Method method);
Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Object object,
Tcl_Obj *nameObj, int isPublic,
const Tcl_MethodType *typePtr,
ClientData clientData);
Tcl_Method Tcl_NewClassMethod(Tcl_Interp *interp, Tcl_Class cls,
Tcl_Obj *nameObj, int isPublic,
const Tcl_MethodType *typePtr,
ClientData clientData);
Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp,
Tcl_Class cls, const char *name, int objc,
Tcl_Obj *const *objv, int skip);
int Tcl_ObjectDeleted(Tcl_Object object);
int Tcl_ObjectContextIsFiltering(
Tcl_ObjectContext context);
Tcl_Method Tcl_ObjectContextMethod(Tcl_ObjectContext context);
Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context);
int Tcl_ObjectContextSkippedArgs(
Tcl_ObjectContext context);
ClientData Tcl_ClassGetMetadata(Tcl_Class clazz,
const Tcl_ObjectMetadataType *typePtr);
void Tcl_ClassSetMetadata(Tcl_Class clazz,
const Tcl_ObjectMetadataType *typePtr,
ClientData metadata);
ClientData Tcl_ObjectGetMetadata(Tcl_Object object,
const Tcl_ObjectMetadataType *typePtr);
void Tcl_ObjectSetMetadata(Tcl_Object object,
const Tcl_ObjectMetadataType *typePtr,
ClientData metadata);
// ^^^^^^^^^^^^^^^^^^^^^^ MOVE TO TCL.DECLS ^^^^^^^^^^^^^^^^^^^^^^
/*
* Forward declarations.
*/
struct Class;
struct Object;
/*
* The data that needs to be stored per method. This record is used to collect
* information about all sorts of methods, including forwards, constructors
* and destructors.
*/
typedef struct Method {
const Tcl_MethodType *typePtr;
/* The type of method. If NULL, this is a
* special flag record which is just used for
* the setting of the flags field. */
ClientData clientData; /* Type-specific data. */
Tcl_Obj *namePtr; /* Name of the method. */
struct Object *declaringObjectPtr;
/* The object that declares this method, or
* NULL if it was declared by a class. */
struct Class *declaringClassPtr;
/* The class that declares this method, or
* NULL if it was declared directly on an
* object. */
int flags; /* Assorted flags. Includes whether this
* method is public/exported or not. */
} Method;
/*
* Procedure-like methods have the following extra information. It is a
* single-field structure because this allows for future expansion without
* changing vast amounts of code.
*/
typedef struct ProcedureMethod {
Proc *procPtr;
} ProcedureMethod;
/*
* Forwarded methods have the following extra information. It is a
* single-field structure because this allows for future expansion without
* changing vast amounts of code.
*/
typedef struct ForwardMethod {
Tcl_Obj *prefixObj;
} ForwardMethod;
/*
* Helper definitions that declare a "list" array. The two varieties are
* either optimized for simplicity (in the case that the whole array is
* typically assigned at once) or efficiency (in the case that the array is
* expected to be expanded over time). These lists are designed to be iterated
* over with the help of the FOREACH macro (see later in this file).
*
* The "num" field always counts the number of listType_t elements used in the
* "list" field. When a "size" field exists, it describes how many elements
* are present in the list; when absent, exactly "num" elements are present.
*/
#define LIST_STATIC(listType_t) \
struct { int num; listType_t *list; }
#define LIST_DYNAMIC(listType_t) \
struct { int num, size; listType_t *list; }
/*
* Now, the definition of what an object actually is.
*/
typedef struct Object {
Tcl_Namespace *namespacePtr;/* This object's tame namespace. */
Tcl_Command command; /* Reference to this object's public
* command. */
Tcl_Command myCommand; /* Reference to this object's internal
* command. */
struct Class *selfCls; /* This object's class. */
Tcl_HashTable methods; /* Object-local Tcl_Obj (method name) to
* Method* mapping. */
LIST_STATIC(struct Class *) mixins;
/* Classes mixed into this object. */
LIST_STATIC(Tcl_Obj *) filters;
/* List of filter names. */
struct Class *classPtr; /* All classes have this non-NULL; it points
* to the class structure. Everything else has
* this NULL. */
int flags;
int epoch; /* Per-object epoch, incremented when the way
* an object should resolve call chains is
* changed. */
Tcl_HashTable *metadataPtr; /* Mapping from pointers to metadata type to
* the ClientData values that are the values
* of each piece of attached metadata. This
* field starts out as NULL and is only
* allocated if metadata is attached. */
Tcl_HashTable publicContextCache; /* Place to keep unused contexts. */
Tcl_HashTable privateContextCache; /* Place to keep unused contexts. */
} Object;
#define OBJECT_DELETED 1 /* Flag to say that an object has been
* destroyed. */
#define ROOT_OBJECT 0x1000 /* Flag to say that this object is the root of
* the class hierarchy and should be treated
* specially during teardown. */
#define FILTER_HANDLING 0x2000 /* Flag set when the object is processing a
* filter; when set, filters are *not*
* processed on the object, preventing nasty
* recursive filtering problems. */
/*
* And the definition of a class. Note that every class also has an associated
* object, through which it is manipulated.
*/
typedef struct Class {
Object *thisPtr; /* Reference to the object associated with
* this class. */
int flags; /* Assorted flags. */
LIST_STATIC(struct Class *) superclasses;
/* List of superclasses, used for generation
* of method call chains. */
LIST_DYNAMIC(struct Class *) subclasses;
/* List of subclasses, used to ensure deletion
* of dependent entities happens properly when
* the class itself is deleted. */
LIST_DYNAMIC(Object *) instances;
/* List of instances, used to ensure deletion
* of dependent entities happens properly when
* the class itself is deleted. */
LIST_STATIC(Tcl_Obj *) filters;
/* List of filter names, used for generation
* of method call chains. */
LIST_STATIC(struct Class *) mixins;
/* List of mixin classes, used for generation
* of method call chains. */
LIST_DYNAMIC(struct Class *) mixinSubs;
/* List of classes that this class is mixed
* into, used to ensure deletion of dependent
* entities happens properly when the class
* itself is deleted. */
LIST_STATIC(struct Class *) classHierarchy;
/* List of classes that comprise the basic
* class hierarchy for this class's
* superclasses. If NULL (and this isn't the
* root object class) then this needs
* recomputing. */
int classHierarchyEpoch; /* Differs from the global epoch when it is
* time to recompute the class hierarchy. */
Tcl_HashTable classMethods; /* Hash table of all methods. Hash maps from
* the (Tcl_Obj*) method name to the (Method*)
* method record. */
Method *constructorPtr; /* Method record of the class constructor (if
* any). */
Method *destructorPtr; /* Method record of the class destructor (if
* any). */
Tcl_HashTable *metadataPtr; /* Mapping from pointers to metadata type to
* the ClientData values that are the values
* of each piece of attached metadata. This
* field starts out as NULL and is only
* allocated if metadata is attached. */
} Class;
/*
* The foundation of the object system within an interpreter contains
* references to the key classes and namespaces, together with a few other
* useful bits and pieces. Probably ought to eventually go in the Interp
* structure itself.
*/
typedef struct Foundation {
Class *objectCls; /* The root of the object system. */
Class *classCls; /* The class of all classes. */
Tcl_Namespace *ooNs; /* Master ::oo namespace. */
Tcl_Namespace *defineNs; /* Namespace containing special commands for
* manipulating objects and classes. The
* "oo::define" command acts as a special kind
* of ensemble for this namespace. */
Tcl_Namespace *helpersNs; /* Namespace containing the commands that are
* only valid when executing inside a
* procedural method. */
int epoch; /* Used to invalidate method chains when the
* class structure changes. */
int nsCount; /* Counter so we can allocate a unique
* namespace to each object. */
Tcl_Obj *unknownMethodNameObj;
/* Shared object containing the name of the
* unknown method handler method. */
} Foundation;
/*
* A call context structure is built when a method is called. They contain the
* chain of method implementations that are to be invoked by a particular
* call, and the process of calling walks the chain, with the [next] command
* proceeding to the next entry in the chain.
*/
#define CALL_CHAIN_STATIC_SIZE 4
struct MInvoke {
Method *mPtr; /* Reference to the method implementation
* record. */
int isFilter; /* Whether this is a filter invokation. */
};
typedef struct CallContext {
Object *oPtr; /* The object associated with this call. */
int globalEpoch; /* Global (class) epoch counter snapshot. */
int localEpoch; /* Local (single object) epoch counter
* snapshot. */
int flags; /* Assorted flags, see below. */
int index; /* Index into the call chain of the currently
* executing method implementation. */
int skip;
int numCallChain; /* Size of the call chain. */
struct MInvoke *callChain; /* Array of call chain entries. May point to
* staticCallChain if the number of entries is
* small. */
struct MInvoke staticCallChain[CALL_CHAIN_STATIC_SIZE];
int filterLength; /* Number of entries in the call chain that
* are due to processing filters and not the
* main call chain. */
} CallContext;
/*
* Bits for the 'flags' field of the call context.
*/
#define OO_UNKNOWN_METHOD 1 /* This is an unknown method. */
#define PUBLIC_METHOD 2 /* This is a public (exported) method. */
#define CONSTRUCTOR 4 /* This is a constructor. */
#define DESTRUCTOR 8 /* This is a destructor. */
/*
* Private definitions, some of which perhaps ought to be exposed properly or
* maybe just put in the internal stubs table.
*/
MODULE_SCOPE Method * TclOONewProcMethod(Tcl_Interp *interp, Object *oPtr,
int isPublic, Tcl_Obj *nameObj, Tcl_Obj *argsObj,
Tcl_Obj *bodyObj);
MODULE_SCOPE Method * TclOONewForwardMethod(Tcl_Interp *interp, Object *oPtr,
int isPublic, Tcl_Obj *nameObj,
Tcl_Obj *prefixObj);
MODULE_SCOPE Method * TclOONewProcClassMethod(Tcl_Interp *interp,
Class *clsPtr, int isPublic, Tcl_Obj *nameObj,
Tcl_Obj *argsObj, Tcl_Obj *bodyObj);
MODULE_SCOPE Method * TclOONewForwardClassMethod(Tcl_Interp *interp,
Class *clsPtr, int isPublic, Tcl_Obj *nameObj,
Tcl_Obj *prefixObj);
MODULE_SCOPE void TclOODeleteMethod(Method *method);
MODULE_SCOPE int TclObjInterpProcCore(register Tcl_Interp *interp,
CallFrame *framePtr, Tcl_Obj *procNameObj,
int skip);
MODULE_SCOPE void TclOOAddToInstances(Object *oPtr, Class *clsPtr);
MODULE_SCOPE void TclOOAddToSubclasses(Class *subPtr, Class *superPtr);
MODULE_SCOPE void TclOOAddToMixinSubs(Class *subPtr, Class *mixinPtr);
MODULE_SCOPE Proc * TclOOGetProcFromMethod(Method *mPtr);
MODULE_SCOPE Tcl_Obj * TclOOGetFwdFromMethod(Method *mPtr);
MODULE_SCOPE int TclOOIsReachable(Class *targetPtr, Class *startPtr);
MODULE_SCOPE void TclOORemoveFromInstances(Object *oPtr, Class *clsPtr);
MODULE_SCOPE void TclOORemoveFromSubclasses(Class *subPtr,
Class *superPtr);
MODULE_SCOPE void TclOORemoveFromMixinSubs(Class *subPtr,
Class *mixinPtr);
MODULE_SCOPE void TclOODeleteContext(CallContext *contextPtr);
MODULE_SCOPE CallContext *TclOOGetCallContext(Foundation *fPtr, Object *oPtr,
Tcl_Obj *methodNameObj, int flags,
Tcl_HashTable *cachePtr);
MODULE_SCOPE int TclOOInvokeContext(Tcl_Interp *interp,
CallContext *contextPtr, int objc,
Tcl_Obj *const *objv);
MODULE_SCOPE int TclOOGetSortedMethodList(Object *oPtr,
int publicOnly, const char ***stringsPtr);
/*
* A convenience macro for iterating through the lists used in the internal
* memory management of objects. This is a bit gnarly because we want to do
* the assignment of the picked-out value only when the body test succeeds,
* but we cannot rely on the assigned value being useful, forcing us to do
* some nasty stuff with the comma operator. The compiler's optimizer should
* be able to sort it all out!
*
* REQUIRES DECLARATION: int i;
*/
#define FOREACH(var,ary) \
for(i=0 ; (i<(ary).num?((var=(ary).list[i]),1):0) ; i++)
/*
* Convenience macros for iterating through hash tables. FOREACH_HASH_DECLS
* sets up the declarations needed for the main macro, FOREACH_HASH, which
* does the actual iteration. FOREACH_HASH_VALUE is a restricted version that
* only iterates over values.
*/
#define FOREACH_HASH_DECLS \
Tcl_HashEntry *hPtr;Tcl_HashSearch search
#define FOREACH_HASH(key,val,tablePtr) \
for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ? \
((key)=(void *)Tcl_GetHashKey((tablePtr),hPtr),\
(val)=Tcl_GetHashValue(hPtr),1):0; hPtr=Tcl_NextHashEntry(&search))
#define FOREACH_HASH_VALUE(val,tablePtr) \
for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ? \
((val)=Tcl_GetHashValue(hPtr),1):0;hPtr=Tcl_NextHashEntry(&search))
/*
* Convenience macro for duplicating a list. Needs no external declaration,
* but all arguments are used multiple times and so must have no side effects.
*/
#define DUPLICATE(target,source,type) \
do { \
register unsigned len = sizeof(type) * ((target).num=(source).num);\
if (len != 0) { \
memcpy(((target).list=(type*)ckalloc(len)), (source).list, len); \
} else { \
(target).list = NULL; \
} \
} while(0)
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
|