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
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
|
/*
* tclOOInt.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-2012 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.
*/
#ifndef TCL_OO_INTERNAL_H
#define TCL_OO_INTERNAL_H 1
#include "tclInt.h"
#include "tclOO.h"
/*
* Hack to make things work with Objective C. Note that ObjC isn't really
* supported, but we don't want to to be actively hostile to it. [Bug 2163447]
*/
#ifdef __OBJC__
#define Class TclOOClass
#define Object TclOOObject
#endif /* __OBJC__ */
/*
* Forward declarations.
*/
struct CallChain;
struct Class;
struct Foundation;
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. */
int refCount;
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;
/*
* Pre- and post-call callbacks, to allow procedure-like methods to be fine
* tuned in their behaviour.
*/
typedef int (TclOO_PreCallProc)(ClientData clientData, Tcl_Interp *interp,
Tcl_ObjectContext context, Tcl_CallFrame *framePtr, int *isFinished);
typedef int (TclOO_PostCallProc)(ClientData clientData, Tcl_Interp *interp,
Tcl_ObjectContext context, Tcl_Namespace *namespacePtr, int result);
typedef void (TclOO_PmCDDeleteProc)(ClientData clientData);
typedef ClientData (TclOO_PmCDCloneProc)(ClientData clientData);
/*
* Procedure-like methods have the following extra information.
*/
typedef struct ProcedureMethod {
int version; /* Version of this structure. Currently must
* be 0. */
Proc *procPtr; /* Core of the implementation of the method;
* includes the argument definition and the
* body bytecodes. */
int flags; /* Flags to control features. */
int refCount;
ClientData clientData;
TclOO_PmCDDeleteProc *deleteClientdataProc;
TclOO_PmCDCloneProc *cloneClientdataProc;
ProcErrorProc *errProc; /* Replacement error handler. */
TclOO_PreCallProc *preCallProc;
/* Callback to allow for additional setup
* before the method executes. */
TclOO_PostCallProc *postCallProc;
/* Callback to allow for additional cleanup
* after the method executes. */
GetFrameInfoValueProc *gfivProc;
/* Callback to allow for fine tuning of how
* the method reports itself. */
} ProcedureMethod;
#define TCLOO_PROCEDURE_METHOD_VERSION 0
/*
* Flags for use in a ProcedureMethod.
*
* When the USE_DECLARER_NS flag is set, the method will use the namespace of
* the object or class that declared it (or the clone of it, if it was from
* such that the implementation of the method came to the particular use)
* instead of the namespace of the object on which the method was invoked.
* This flag must be distinct from all others that are associated with
* methods.
*/
#define USE_DECLARER_NS 0x80
/*
* Forwarded methods have the following extra information.
*/
typedef struct ForwardMethod {
Tcl_Obj *prefixObj; /* The list of values to use to replace the
* object and method name with. Will be a
* non-empty list. */
int fullyQualified; /* If 1, the command name is fully qualified
* and we should let the default Tcl mechanism
* handle the command lookup because it is
* more efficient. If 0, we need to do a
* specialized lookup based on the current
* object's namespace. */
} 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 {
struct Foundation *fPtr; /* The basis for the object system. Putting
* this here allows the avoidance of quite a
* lot of hash lookups on the critical path
* for object invokation and creation. */
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 *methodsPtr; /* 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 refCount; /* Number of strong references to this object.
* Note that there may be many more weak
* references; this mechanism is there to
* avoid Tcl_Preserve. */
int flags;
int creationEpoch; /* Unique value to make comparisons of objects
* easier. */
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_Obj *cachedNameObj; /* Cache of the name of the object. */
Tcl_HashTable *chainCache; /* Place to keep unused contexts. This table
* is indexed by method name as Tcl_Obj. */
Tcl_ObjectMapMethodNameProc *mapMethodNameProc;
/* Function to allow remapping of method
* names. For itcl-ng. */
LIST_STATIC(Tcl_Obj *) variables;
} Object;
#define OBJECT_DELETED 1 /* Flag to say that an object has been
* destroyed. */
#define DESTRUCTOR_CALLED 2 /* Flag to say that the destructor has been
* called. */
#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. */
#define USE_CLASS_CACHE 0x4000 /* Flag set to say that the object is a pure
* instance of the class, and has had nothing
* added that changes the dispatch chain (i.e.
* no methods, mixins, or filters. */
#define ROOT_CLASS 0x8000 /* Flag to say that this object is the root
* class of classes, and should be treated
* specially during teardown (and in a few
* other spots). */
#define FORCE_UNKNOWN 0x10000 /* States that we are *really* looking up the
* unknown method handler at that point. */
/*
* 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 refCount; /* Number of strong references to this class.
* Weak references are not counted; the
* purpose of this is to avoid Tcl_Preserve as
* that is quite slow. */
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. */
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. */
struct CallChain *constructorChainPtr;
struct CallChain *destructorChainPtr;
Tcl_HashTable *classChainCache;
/* Places where call chains are stored. For
* constructors, the class chain is always
* used. For destructors and ordinary methods,
* the class chain is only used when the
* object doesn't override with its own mixins
* (and filters and method implementations for
* when getting method chains). */
LIST_STATIC(Tcl_Obj *) variables;
} 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 ThreadLocalData {
int nsCount; /* Master epoch counter is used for keeping
* the values used in Tcl_Obj internal
* representations sane. Must be thread-local
* because Tcl_Objs can cross interpreter
* boundaries within a thread (objects don't
* generally cross threads). */
} ThreadLocalData;
typedef struct Foundation {
Tcl_Interp *interp;
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 *objdefNs; /* Namespace containing special commands for
* manipulating objects and classes. The
* "oo::objdefine" 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. */
ThreadLocalData *tsdPtr; /* 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. */
Tcl_Obj *constructorName; /* Shared object containing the "name" of a
* constructor. */
Tcl_Obj *destructorName; /* Shared object containing the "name" of a
* destructor. */
Tcl_Obj *clonedName; /* Shared object containing the name of a
* "<cloned>" pseudo-constructor. */
Tcl_Obj *defineName; /* Fully qualified name of oo::define. */
} 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. */
Class *filterDeclarer; /* What class decided to add the filter; if
* NULL, it was added by the object. */
};
typedef struct CallChain {
int objectCreationEpoch; /* The object's creation epoch. Note that the
* object reference is not stored in the call
* chain; it is in the call context. */
int objectEpoch; /* Local (object structure) epoch counter
* snapshot. */
int epoch; /* Global (class structure) epoch counter
* snapshot. */
int flags; /* Assorted flags, see below. */
int refCount; /* Reference count. */
int numChain; /* Size of the call chain. */
struct MInvoke *chain; /* Array of call chain entries. May point to
* staticChain if the number of entries is
* small. */
struct MInvoke staticChain[CALL_CHAIN_STATIC_SIZE];
} CallChain;
typedef struct CallContext {
Object *oPtr; /* The object associated with this call. */
int index; /* Index into the call chain of the currently
* executing method implementation. */
int skip; /* Current number of arguments to skip; can
* vary depending on whether it is a direct
* method call or a continuation via the
* [next] command. */
CallChain *callPtr; /* The actual call chain. */
} CallContext;
/*
* Bits for the 'flags' field of the call chain.
*/
#define PUBLIC_METHOD 0x01 /* This is a public (exported) method. */
#define PRIVATE_METHOD 0x02 /* This is a private (class's direct instances
* only) method. */
#define OO_UNKNOWN_METHOD 0x04 /* This is an unknown method. */
#define CONSTRUCTOR 0x08 /* This is a constructor. */
#define DESTRUCTOR 0x10 /* This is a destructor. */
/*
* Structure containing definition information about basic class methods.
*/
typedef struct {
const char *name; /* Name of the method in question. */
int isPublic; /* Whether the method is public by default. */
Tcl_MethodType definition; /* How to call the method. */
} DeclaredClassMethod;
/*
*----------------------------------------------------------------
* Commands relating to OO support.
*----------------------------------------------------------------
*/
MODULE_SCOPE int TclOOInit(Tcl_Interp *interp);
MODULE_SCOPE int TclOODefineObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv);
MODULE_SCOPE int TclOOObjDefObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv);
MODULE_SCOPE int TclOODefineConstructorObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv);
MODULE_SCOPE int TclOODefineDeleteMethodObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv);
MODULE_SCOPE int TclOODefineDestructorObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv);
MODULE_SCOPE int TclOODefineExportObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv);
MODULE_SCOPE int TclOODefineForwardObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv);
MODULE_SCOPE int TclOODefineMethodObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv);
MODULE_SCOPE int TclOODefineRenameMethodObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv);
MODULE_SCOPE int TclOODefineUnexportObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv);
MODULE_SCOPE int TclOODefineClassObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv);
MODULE_SCOPE int TclOODefineSelfObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv);
MODULE_SCOPE int TclOOUnknownDefinition(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv);
MODULE_SCOPE int TclOOCopyObjectCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv);
MODULE_SCOPE int TclOONextObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv);
MODULE_SCOPE int TclOONextToObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv);
MODULE_SCOPE int TclOOSelfObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv);
/*
* Method implementations (in tclOOBasic.c).
*/
MODULE_SCOPE int TclOO_Class_Constructor(ClientData clientData,
Tcl_Interp *interp, Tcl_ObjectContext context,
int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int TclOO_Class_Create(ClientData clientData,
Tcl_Interp *interp, Tcl_ObjectContext context,
int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int TclOO_Class_CreateNs(ClientData clientData,
Tcl_Interp *interp, Tcl_ObjectContext context,
int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int TclOO_Class_New(ClientData clientData,
Tcl_Interp *interp, Tcl_ObjectContext context,
int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int TclOO_Object_Destroy(ClientData clientData,
Tcl_Interp *interp, Tcl_ObjectContext context,
int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int TclOO_Object_Eval(ClientData clientData,
Tcl_Interp *interp, Tcl_ObjectContext context,
int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int TclOO_Object_LinkVar(ClientData clientData,
Tcl_Interp *interp, Tcl_ObjectContext context,
int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int TclOO_Object_Unknown(ClientData clientData,
Tcl_Interp *interp, Tcl_ObjectContext context,
int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int TclOO_Object_VarName(ClientData clientData,
Tcl_Interp *interp, Tcl_ObjectContext context,
int objc, Tcl_Obj *const *objv);
/*
* Private definitions, some of which perhaps ought to be exposed properly or
* maybe just put in the internal stubs table.
*/
MODULE_SCOPE void TclOOAddToInstances(Object *oPtr, Class *clsPtr);
MODULE_SCOPE void TclOOAddToMixinSubs(Class *subPtr, Class *mixinPtr);
MODULE_SCOPE void TclOOAddToSubclasses(Class *subPtr, Class *superPtr);
MODULE_SCOPE int TclNRNewObjectInstance(Tcl_Interp *interp,
Tcl_Class cls, const char *nameStr,
const char *nsNameStr, int objc,
Tcl_Obj *const *objv, int skip,
Tcl_Object *objectPtr);
MODULE_SCOPE int TclOODefineSlots(Foundation *fPtr);
MODULE_SCOPE void TclOODeleteChain(CallChain *callPtr);
MODULE_SCOPE void TclOODeleteChainCache(Tcl_HashTable *tablePtr);
MODULE_SCOPE void TclOODeleteContext(CallContext *contextPtr);
MODULE_SCOPE void TclOODelMethodRef(Method *method);
MODULE_SCOPE CallContext *TclOOGetCallContext(Object *oPtr,
Tcl_Obj *methodNameObj, int flags,
Tcl_Obj *cacheInThisObj);
MODULE_SCOPE CallChain *TclOOGetStereotypeCallChain(Class *clsPtr,
Tcl_Obj *methodNameObj, int flags);
MODULE_SCOPE Foundation *TclOOGetFoundation(Tcl_Interp *interp);
MODULE_SCOPE Tcl_Obj * TclOOGetFwdFromMethod(Method *mPtr);
MODULE_SCOPE Proc * TclOOGetProcFromMethod(Method *mPtr);
MODULE_SCOPE Tcl_Obj * TclOOGetMethodBody(Method *mPtr);
MODULE_SCOPE int TclOOGetSortedClassMethodList(Class *clsPtr,
int flags, const char ***stringsPtr);
MODULE_SCOPE int TclOOGetSortedMethodList(Object *oPtr, int flags,
const char ***stringsPtr);
MODULE_SCOPE int TclOOInit(Tcl_Interp *interp);
MODULE_SCOPE void TclOOInitInfo(Tcl_Interp *interp);
MODULE_SCOPE int TclOOInvokeContext(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
MODULE_SCOPE int TclNRObjectContextInvokeNext(Tcl_Interp *interp,
Tcl_ObjectContext context, int objc,
Tcl_Obj *const *objv, int skip);
MODULE_SCOPE void TclOONewBasicMethod(Tcl_Interp *interp, Class *clsPtr,
const DeclaredClassMethod *dcm);
MODULE_SCOPE Tcl_Obj * TclOOObjectName(Tcl_Interp *interp, Object *oPtr);
MODULE_SCOPE void TclOORemoveFromInstances(Object *oPtr, Class *clsPtr);
MODULE_SCOPE void TclOORemoveFromMixinSubs(Class *subPtr,
Class *mixinPtr);
MODULE_SCOPE void TclOORemoveFromSubclasses(Class *subPtr,
Class *superPtr);
MODULE_SCOPE Tcl_Obj * TclOORenderCallChain(Tcl_Interp *interp,
CallChain *callPtr);
MODULE_SCOPE void TclOOStashContext(Tcl_Obj *objPtr,
CallContext *contextPtr);
MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr);
/*
* Include all the private API, generated from tclOO.decls.
*/
#include "tclOOIntDecls.h"
/*
* 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.
*/
#undef DUPLICATE /* prevent possible conflict with definition in WINAPI nb30.h */
#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)
/*
* Alternatives to Tcl_Preserve/Tcl_EventuallyFree/Tcl_Release.
*/
#define AddRef(ptr) ((ptr)->refCount++)
#define DelRef(ptr) do { \
if (--(ptr)->refCount < 1) { \
ckfree((char *) (ptr)); \
} \
} while(0)
#endif /* TCL_OO_INTERNAL_H */
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
|