Mercurial > hg > xemacs-beta

comparison src/lrecord.h @ 5133:444a448b2f53

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge branch ben-lisp-object into default branch
author Ben Wing <ben@xemacs.org>
date Sun, 07 Mar 2010 06:47:37 -0600
parents 7be849cb8828
children f965e31a35f0
comparison
equal deleted inserted replaced
5113:b2dcf6a6d8ab 5133:444a448b2f53
1 /* The "lrecord" structure (header of a compound lisp object). 1 /* The "lrecord" structure (header of a compound lisp object).
2 Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc. 2 Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
3 Copyright (C) 1996, 2001, 2002, 2004, 2005, 2010 Ben Wing. 3 Copyright (C) 1996, 2001, 2002, 2004, 2005, 2009, 2010 Ben Wing.
4 4
5 This file is part of XEmacs. 5 This file is part of XEmacs.
6 6
7 XEmacs is free software; you can redistribute it and/or modify it 7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the 8 under the terms of the GNU General Public License as published by the
24 /* This file has been Mule-ized, Ben Wing, 10-13-04. */ 24 /* This file has been Mule-ized, Ben Wing, 10-13-04. */
25 25
26 #ifndef INCLUDED_lrecord_h_ 26 #ifndef INCLUDED_lrecord_h_
27 #define INCLUDED_lrecord_h_ 27 #define INCLUDED_lrecord_h_
28 28
29 /* The "lrecord" type of Lisp object is used for all object types other 29 /* All objects other than char and int are implemented as structures and
30 than a few simple ones (like char and int). This allows many types to be 30 passed by reference. Such objects are called "record objects" ("record"
31 implemented but only a few bits required in a Lisp object for type 31 is another term for "structure"). The "wrapped" value of such an object
32 information. (The tradeoff is that each object has its type marked in 32 (i.e. when stored in a variable of type Lisp_Object) is simply the raw
33 it, thereby increasing its size.) All lrecords begin with a `struct 33 pointer coerced to an integral type the same size as the pointer
34 lrecord_header', which identifies the lisp object type, by providing an 34 (usually `long').
35 index into a table of `struct lrecord_implementation', which describes 35
36 the behavior of the lisp object. It also contains some other data bits. 36 Under old-GC (i.e. when NEW_GC is not defined), there are two kinds of
37 37 record objects: normal objects (those allocated on their own with
38 #ifndef NEW_GC 38 xmalloc()) and frob-block objects (those allocated as pieces of large,
39 Lrecords are of two types: straight lrecords, and lcrecords. 39 usually 2K, chunks of memory known as "frob blocks"). Under NEW_GC,
40 Straight lrecords are used for those types of objects that have 40 there is only one type of record object. Stuff below that applies to
41 their own allocation routines (typically allocated out of 2K chunks 41 frob-block objects is assumed to apply to the same type of object as
42 of memory called `frob blocks'). These objects have a `struct 42 normal objects under NEW_GC.
43 lrecord_header' at the top, containing only the bits needed to find 43
44 the lrecord_implementation for the object. There are special 44 Record objects have a header at the beginning of their structure, which
45 routines in alloc.c to create an object of each such type. 45 is used internally to identify the type of the object (so that an
46 46 object's type can be recovered from its pointer); in addition, it holds
47 Lcrecords are used for less common sorts of objects that don't do 47 a few flags and a "UID", which for most objects is shown when it is
48 their own allocation. Each such object is malloc()ed individually, 48 printed, and is primarily useful for debugging purposes. The header of
49 and the objects are chained together through a `next' pointer. 49 a normal object is declared as NORMAL_LISP_OBJECT_HEADER and that of a
50 Lcrecords have a `struct old_lcrecord_header' at the top, which 50 frob-block object FROB_BLOCK_LISP_OBJECT_HEADER.
51 contains a `struct lrecord_header' and a `next' pointer, and are 51
52 allocated using old_alloc_lcrecord_type() or its variants. 52 FROB_BLOCK_LISP_OBJECT_HEADER boils down to a `struct lrecord_header'.
53 #endif 53 This is a 32-bit value made up of bit fields, where 8 bits are used to
54 54 hold the type, 2 or 3 bits are used for flags associated with the
55 Creating a new Lisp object type is fairly easy; just follow the 55 garbage collector, and the remaining 21 or 22 bits hold the UID.
56 lead of some existing type (e.g. hash tables). Note that you 56
57 do not need to supply all the methods (see below); reasonable 57 Under NEW_GC, NORMAL_LISP_OBJECT_HEADER also resolves to `struct
58 defaults are provided for many of them. Alternatively, if you're 58 lrecord_header'. Under old-GC, however, NORMAL_LISP_OBJECT_HEADER
59 just looking for a way of encapsulating data (which possibly 59 resolves to a `struct old_lcrecord_header' (note the `c'), which is a
60 could contain Lisp_Objects in it), you may well be able to use 60 larger structure -- on 32-bit machines it occupies 3 machine words
61 the opaque type. 61 instead of 1. Such an object is known internally as an "lcrecord". The
62 first word of `struct old_lcrecord_header' is an embedded `struct
63 lrecord_header' with the same information as for frob-block objects;
64 that way, all objects can be cast to a `struct lrecord_header' to
65 determine their type or other info. The other words consist of a
66 pointer, used to thread all lcrecords together in one big linked list,
67 and a 32-bit structure that contains another UID field (#### which
68 should be deleted, as it is redundant; it dates back to the days when
69 the lrecord_header consisted of a pointer to an object's implementation
70 structure rather than an index).
71
72 Under old-GC, normal objects (i.e. lcrecords) are allocated in
73 individual chunks using the underlying allocator (i.e. xmalloc(), which
74 is a thin wrapper around malloc()). Frob-block objects are more
75 efficient than normal objects, as they have a smaller header and don't
76 have the additional memory overhead associated with malloc() -- instead,
77 as mentioned above, they are carved out of 2K chunks of memory called
78 "frob blocks"). However, it is slightly more tricky to create such
79 objects, as they require special routines in alloc.c to create an object
80 of each such type and to sweep them during garbage collection. In
81 addition, there is currently no mechanism for handling variable-sized
82 frob-block objects (e.g. vectors), whereas variable-sized normal objects
83 are not a problem. Frob-block objects are typically used for basic
84 objects that exist in large numbers, such as `cons' or `string'.
85
86 Note that strings are an apparent exception to the statement above that
87 variable-sized objects can't be handled. Under old-GC strings work as
88 follows. A string consists of two parts -- a fixed-size "string header"
89 that is allocated as a standard frob-block object, and a "string-chars"
90 structure that is allocated out of special 8K-sized frob blocks that
91 have a dedicated garbage-collection handler that compacts the blocks
92 during the sweep stage, relocating the string-chars data (but not the
93 string headers) to eliminate gaps. Strings larger than 8K are not
94 placed in frob blocks, but instead are stored as individually malloc()ed
95 blocks of memory. Strings larger than 8K are called "big strings" and
96 those smaller than 8K are called "small strings".
97
98 Under new-GC, there is no difference between big and small strings,
99 just as there is no difference between normal and frob-block objects.
100 There is only one allocation method, which is capable of handling
101 variable-sized objects. This apparently allocates all objects in
102 frob blocks according to the size of the object.
103
104 To create a new normal Lisp object, see the toolbar-button example
105 below. To create a new frob-block Lisp object, follow the lead of
106 one of the existing frob-block objects, such as extents or events.
107 Note that you do not need to supply all the methods (see below);
108 reasonable defaults are provided for many of them. Alternatively, if
109 you're just looking for a way of encapsulating data (which possibly
110 could contain Lisp_Objects in it), you may well be able to use the
111 opaque type.
62 */ 112 */
113
114 /*
115 How to declare a Lisp object:
116
117 NORMAL_LISP_OBJECT_HEADER:
118 Header for normal objects
119
120 FROB_BLOCK_LISP_OBJECT_HEADER:
121 Header for frob-block objects
122
123 How to allocate a Lisp object:
124
125 - For normal objects of a fixed size, simply call
126 ALLOC_NORMAL_LISP_OBJECT (type), where TYPE is the name of the type
127 (e.g. toolbar_button). Such objects can be freed manually using
128 free_normal_lisp_object.
129
130 - For normal objects whose size can vary (and hence which have a
131 size_in_bytes_method rather than a static_size), call
132 ALLOC_SIZED_LISP_OBJECT (size, type), where TYPE is the
133 name of the type. NOTE: You cannot call free_normal_lisp_object() on such
134 on object! (At least when not NEW_GC)
135
136 - For frob-block objects, use
137 ALLOC_FROB_BLOCK_LISP_OBJECT (type, lisp_type, var, lrec_ptr).
138 But these objects need special handling; if you don't understand this,
139 just ignore it.
140
141 - Some lrecords, which are used totally internally, use the
142 noseeum-* functions for debugging reasons.
143
144 Other operations:
145
146 - copy_lisp_object (dst, src)
147
148 - zero_nonsized_lisp_object (obj), zero_sized_lisp_object (obj, size):
149 BUT NOTE, it is not necessary to zero out newly allocated Lisp objects.
150 This happens automatically.
151
152 - lisp_object_size (obj): Return the size of a Lisp object. NOTE: This
153 requires that the object is properly initialized.
154
155 - lisp_object_storage_size (obj, stats): Return the storage size of a
156 Lisp objcet, including malloc or frob-block overhead; also, if STATS
157 is non-NULL, accumulate info about the size and overhead into STATS.
158 */
63 159
64 #ifdef NEW_GC 160 #ifdef NEW_GC
65 /* 161 /*
66 There are some limitations under New-GC that lead to the creation of a 162 There are some limitations under New-GC that lead to the creation of a
67 large number of new internal object types. I'm not completely sure what 163 large number of new internal object types. I'm not completely sure what
72 It must have something to do with the fact that these substructures 168 It must have something to do with the fact that these substructures
73 contain pointers to Lisp objects, but it's not completely clear why -- 169 contain pointers to Lisp objects, but it's not completely clear why --
74 object descriptions exist to indicate the size of these structures and 170 object descriptions exist to indicate the size of these structures and
75 the Lisp object pointers within them. 171 the Lisp object pointers within them.
76 172
77 At least one definite issue is that under New-GC dumpable objects cannot 173 At least one definite issue is that under New-GC dumpable objects cannot
78 contain any finalizers (see pdump_register_object()). This means that any 174 contain any finalizers (see pdump_register_object()). This means that
79 substructures in dumpable objects that are allocated separately and 175 any substructures in dumpable objects that are allocated separately and
80 normally freed in a finalizer need instead to be made into actual Lisp 176 normally freed in a finalizer need instead to be made into actual Lisp
81 objects. If those structures are Dynarrs, they need to be made into 177 objects. If those structures are Dynarrs, they need to be made into
82 Dynarr Lisp objects (e.g. face-cachel-dynarr or glyph-cachel-dynarr), 178 Dynarr Lisp objects (e.g. face-cachel-dynarr or glyph-cachel-dynarr),
83 which are created using Dynarr_lisp_new() or Dynarr_new_new2(). 179 which are created using Dynarr_lisp_new() or Dynarr_new_new2().
84 Furthermore, the objects contained in the Dynarr also need to be Lisp 180 Furthermore, the objects contained in the Dynarr also need to be Lisp
85 objects (e.g. face-cachel or glyph-cachel). 181 objects (e.g. face-cachel or glyph-cachel).
86 182
87 --ben 183 --ben
88 */ 184 */
89
90 #endif 185 #endif
91 186
92
93
94 #ifdef NEW_GC 187 #ifdef NEW_GC
95 #define ALLOC_LCRECORD_TYPE alloc_lrecord_type 188 #define ALLOC_NORMAL_LISP_OBJECT(type) alloc_lrecord (&lrecord_##type)
96 #define COPY_SIZED_LCRECORD copy_sized_lrecord 189 #define ALLOC_SIZED_LISP_OBJECT(size, type) \
97 #define COPY_LCRECORD copy_lrecord 190 alloc_sized_lrecord (size, &lrecord_##type)
98 #define LISPOBJ_STORAGE_SIZE(ptr, size, stats) \ 191 #define NORMAL_LISP_OBJECT_HEADER struct lrecord_header
99 mc_alloced_storage_size (size, stats) 192 #define FROB_BLOCK_LISP_OBJECT_HEADER struct lrecord_header
100 #define ZERO_LCRECORD zero_lrecord 193 #define LISP_OBJECT_FROB_BLOCK_P(obj) 0
101 #define LCRECORD_HEADER lrecord_header
102 #define BASIC_ALLOC_LCRECORD alloc_lrecord
103 #define FREE_LCRECORD free_lrecord
104 #else /* not NEW_GC */ 194 #else /* not NEW_GC */
105 #define ALLOC_LCRECORD_TYPE old_alloc_lcrecord_type 195 #define ALLOC_NORMAL_LISP_OBJECT(type) alloc_automanaged_lcrecord (&lrecord_##type)
106 #define COPY_SIZED_LCRECORD old_copy_sized_lcrecord 196 #define ALLOC_SIZED_LISP_OBJECT(size, type) \
107 #define COPY_LCRECORD old_copy_lcrecord 197 old_alloc_sized_lcrecord (size, &lrecord_##type)
108 #define LISPOBJ_STORAGE_SIZE malloced_storage_size 198 #define NORMAL_LISP_OBJECT_HEADER struct old_lcrecord_header
109 #define ZERO_LCRECORD old_zero_lcrecord 199 #define FROB_BLOCK_LISP_OBJECT_HEADER struct lrecord_header
110 #define LCRECORD_HEADER old_lcrecord_header 200 #define LISP_OBJECT_FROB_BLOCK_P(obj) (XRECORD_LHEADER_IMPLEMENTATION(obj)->frob_block_p)
111 #define BASIC_ALLOC_LCRECORD old_basic_alloc_lcrecord
112 #define FREE_LCRECORD old_free_lcrecord
113 #endif /* not NEW_GC */ 201 #endif /* not NEW_GC */
114 202
115 BEGIN_C_DECLS 203 BEGIN_C_DECLS
116 204
117 struct lrecord_header 205 struct lrecord_header
186 { 274 {
187 struct lrecord_header lheader; 275 struct lrecord_header lheader;
188 276
189 /* The `next' field is normally used to chain all lcrecords together 277 /* The `next' field is normally used to chain all lcrecords together
190 so that the GC can find (and free) all of them. 278 so that the GC can find (and free) all of them.
191 `old_basic_alloc_lcrecord' threads lcrecords together. 279 `old_alloc_sized_lcrecord' threads lcrecords together.
192 280
193 The `next' field may be used for other purposes as long as some 281 The `next' field may be used for other purposes as long as some
194 other mechanism is provided for letting the GC do its work. 282 other mechanism is provided for letting the GC do its work.
195 283
196 For example, the event and marker object types allocate members 284 For example, the event and marker object types allocate members
374 description below instead), unless the data description is missing. 462 description below instead), unless the data description is missing.
375 Yes, this currently means there is logic duplication. Eventually the 463 Yes, this currently means there is logic duplication. Eventually the
376 mark methods will be removed. */ 464 mark methods will be removed. */
377 Lisp_Object (*marker) (Lisp_Object); 465 Lisp_Object (*marker) (Lisp_Object);
378 466
379 /* `printer' converts the object to a printed representation. 467 /* `printer' converts the object to a printed representation. `printer'
380 This can be NULL; in this case default_object_printer() will be 468 should never be NULL (if so, you will get an assertion failure when
381 used instead. */ 469 trying to print such an object). Either supply a specific printing
470 method, or use the default methods internal_object_printer() (for
471 internal objects that should not be visible at Lisp level) or
472 external_object_printer() (for objects visible at Lisp level). */
382 void (*printer) (Lisp_Object, Lisp_Object printcharfun, int escapeflag); 473 void (*printer) (Lisp_Object, Lisp_Object printcharfun, int escapeflag);
383 474
384 /* `finalizer' is called at GC time when the object is about to be freed, 475 /* `finalizer' is called at GC time when the object is about to be freed.
385 and at dump time (FOR_DISKSAVE will be non-zero in this case). It 476 It should perform any necessary cleanup, such as freeing malloc()ed
386 should perform any necessary cleanup (e.g. freeing malloc()ed memory 477 memory or releasing pointers or handles to objects created in external
387 or releasing objects created in external libraries, such as 478 libraries, such as window-system windows or file handles. This can be
388 window-system windows or file handles). This can be NULL, meaning no 479 NULL, meaning no special finalization is necessary. */
389 special finalization is necessary. 480 void (*finalizer) (Lisp_Object obj);
390
391 WARNING: remember that `finalizer' is called at dump time even though
392 the object is not being freed -- check the FOR_DISKSAVE argument. */
393 void (*finalizer) (void *header, int for_disksave);
394 481
395 /* This can be NULL, meaning compare objects with EQ(). */ 482 /* This can be NULL, meaning compare objects with EQ(). */
396 int (*equal) (Lisp_Object obj1, Lisp_Object obj2, int depth, 483 int (*equal) (Lisp_Object obj1, Lisp_Object obj2, int depth,
397 int foldcase); 484 int foldcase);
398 485
414 Lisp_Object (*getprop) (Lisp_Object obj, Lisp_Object prop); 501 Lisp_Object (*getprop) (Lisp_Object obj, Lisp_Object prop);
415 int (*putprop) (Lisp_Object obj, Lisp_Object prop, Lisp_Object val); 502 int (*putprop) (Lisp_Object obj, Lisp_Object prop, Lisp_Object val);
416 int (*remprop) (Lisp_Object obj, Lisp_Object prop); 503 int (*remprop) (Lisp_Object obj, Lisp_Object prop);
417 Lisp_Object (*plist) (Lisp_Object obj); 504 Lisp_Object (*plist) (Lisp_Object obj);
418 505
419 #ifdef NEW_GC 506 /* `disksaver' is called at dump time. It is used for objects that
420 /* Only one of `static_size' and `size_in_bytes_method' is non-0. */ 507 contain pointers or handles to objects created in external libraries,
421 #else /* not NEW_GC */ 508 such as window-system windows or file handles. Such external objects
422 /* Only one of `static_size' and `size_in_bytes_method' is non-0. 509 cannot be dumped, so it is necessary to release them at dump time and
423 If both are 0, this type is not instantiable by 510 arrange somehow or other for them to be resurrected if necessary later
424 old_basic_alloc_lcrecord(). */ 511 on.
425 #endif /* not NEW_GC */ 512
513 It seems that even non-dumpable objects may be around at dump time,
514 and a disksaver may be provided. (In fact, the only object currently
515 with a disksaver, lstream, is non-dumpable.)
516
517 Objects rarely need to provide this method; most of the time it will
518 be NULL. */
519 void (*disksaver) (Lisp_Object);
520
521 /* Only one of `static_size' and `size_in_bytes_method' is non-0. If
522 `static_size' is 0, this type is not instantiable by
523 ALLOC_NORMAL_LISP_OBJECT(). If both are 0 (this should never happen),
524 this object cannot be instantiated; you will get an abort() if you
525 try.*/
426 Bytecount static_size; 526 Bytecount static_size;
427 Bytecount (*size_in_bytes_method) (const void *header); 527 Bytecount (*size_in_bytes_method) (Lisp_Object);
428 528
429 /* The (constant) index into lrecord_implementations_table */ 529 /* The (constant) index into lrecord_implementations_table */
430 enum lrecord_type lrecord_type_index; 530 enum lrecord_type lrecord_type_index;
431 531
432 #ifndef NEW_GC 532 #ifndef NEW_GC
433 /* A "basic" lrecord is any lrecord that's not an lcrecord, i.e. 533 /* A "frob-block" lrecord is any lrecord that's not an lcrecord, i.e.
434 one that does not have an old_lcrecord_header at the front and which 534 one that does not have an old_lcrecord_header at the front and which
435 is (usually) allocated in frob blocks. */ 535 is (usually) allocated in frob blocks. */
436 unsigned int basic_p :1; 536 unsigned int frob_block_p :1;
437 #endif /* not NEW_GC */ 537 #endif /* not NEW_GC */
438 }; 538 };
439 539
440 /* All the built-in lisp object types are enumerated in `enum lrecord_type'. 540 /* All the built-in lisp object types are enumerated in `enum lrecord_type'.
441 Additional ones may be defined by a module (none yet). We leave some 541 Additional ones may be defined by a module (none yet). We leave some
443 #define MODULE_DEFINABLE_TYPE_COUNT 32 543 #define MODULE_DEFINABLE_TYPE_COUNT 32
444 544
445 extern MODULE_API const struct lrecord_implementation * 545 extern MODULE_API const struct lrecord_implementation *
446 lrecord_implementations_table[lrecord_type_last_built_in_type + MODULE_DEFINABLE_TYPE_COUNT]; 546 lrecord_implementations_table[lrecord_type_last_built_in_type + MODULE_DEFINABLE_TYPE_COUNT];
447 547
548 /* Given a Lisp object, return its implementation
549 (struct lrecord_implementation) */
448 #define XRECORD_LHEADER_IMPLEMENTATION(obj) \ 550 #define XRECORD_LHEADER_IMPLEMENTATION(obj) \
449 LHEADER_IMPLEMENTATION (XRECORD_LHEADER (obj)) 551 LHEADER_IMPLEMENTATION (XRECORD_LHEADER (obj))
450 #define LHEADER_IMPLEMENTATION(lh) lrecord_implementations_table[(lh)->type] 552 #define LHEADER_IMPLEMENTATION(lh) lrecord_implementations_table[(lh)->type]
451 553
452 #include "gc.h" 554 #include "gc.h"
479 const struct lrecord_implementation *MCACF_implementation \ 581 const struct lrecord_implementation *MCACF_implementation \
480 = LHEADER_IMPLEMENTATION (MCACF_lheader); \ 582 = LHEADER_IMPLEMENTATION (MCACF_lheader); \
481 if (MCACF_implementation && MCACF_implementation->finalizer) \ 583 if (MCACF_implementation && MCACF_implementation->finalizer) \
482 { \ 584 { \
483 GC_STAT_FINALIZED; \ 585 GC_STAT_FINALIZED; \
484 MCACF_implementation->finalizer (ptr, 0); \ 586 MCACF_implementation->finalizer (MCACF_obj); \
485 } \ 587 } \
486 } \ 588 } \
487 } while (0) 589 } while (0)
488 590
489 /* Tell mc-alloc how to call a finalizer for disksave. */ 591 /* Tell mc-alloc how to call a finalizer for disksave. */
494 if (XRECORD_LHEADER (MCACF_obj) && LRECORDP (MCACF_obj) \ 596 if (XRECORD_LHEADER (MCACF_obj) && LRECORDP (MCACF_obj) \
495 && !LRECORD_FREE_P (MCACF_lheader) ) \ 597 && !LRECORD_FREE_P (MCACF_lheader) ) \
496 { \ 598 { \
497 const struct lrecord_implementation *MCACF_implementation \ 599 const struct lrecord_implementation *MCACF_implementation \
498 = LHEADER_IMPLEMENTATION (MCACF_lheader); \ 600 = LHEADER_IMPLEMENTATION (MCACF_lheader); \
499 if (MCACF_implementation && MCACF_implementation->finalizer) \ 601 if (MCACF_implementation && MCACF_implementation->disksaver) \
500 MCACF_implementation->finalizer (ptr, 1); \ 602 MCACF_implementation->disksaver (MCACF_obj); \
501 } \ 603 } \
502 } while (0) 604 } while (0)
503 605
504 #define LRECORD_FREE_P(ptr) \ 606 #define LRECORD_FREE_P(ptr) \
505 (((struct lrecord_header *) ptr)->free) 607 (((struct lrecord_header *) ptr)->free)
750 Lisp_Object value; 852 Lisp_Object value;
751 } htentry; 853 } htentry;
752 854
753 struct Lisp_Hash_Table 855 struct Lisp_Hash_Table
754 { 856 {
755 struct LCRECORD_HEADER header; 857 NORMAL_LISP_OBJECT_HEADER header;
756 Elemcount size; 858 Elemcount size;
757 Elemcount count; 859 Elemcount count;
758 Elemcount rehash_count; 860 Elemcount rehash_count;
759 double rehash_size; 861 double rehash_size;
760 double rehash_threshold; 862 double rehash_threshold;
815 ... 917 ...
816 }; 918 };
817 919
818 struct Lisp_Specifier 920 struct Lisp_Specifier
819 { 921 {
820 struct LCRECORD_HEADER header; 922 NORMAL_LISP_OBJECT_HEADER header;
821 struct specifier_methods *methods; 923 struct specifier_methods *methods;
822 924
823 ... 925 ...
824 // type-specific extra data attached to a specifier 926 // type-specific extra data attached to a specifier
825 max_align_t data[1]; 927 max_align_t data[1];
1149 1251
1150 #define XD_IS_INDIRECT(code) ((code) < 0) 1252 #define XD_IS_INDIRECT(code) ((code) < 0)
1151 #define XD_INDIRECT_VAL(code) ((-1 - (code)) & 255) 1253 #define XD_INDIRECT_VAL(code) ((-1 - (code)) & 255)
1152 #define XD_INDIRECT_DELTA(code) ((-1 - (code)) >> 8) 1254 #define XD_INDIRECT_DELTA(code) ((-1 - (code)) >> 8)
1153 1255
1154 /* DEFINE_LRECORD_IMPLEMENTATION is for objects with constant size. 1256 /* DEFINE_*_LISP_OBJECT is for objects with constant size. (Either
1155 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION is for objects whose size varies. 1257 DEFINE_DUMPABLE_LISP_OBJECT for objects that can be saved in a dumped
1258 executable, or DEFINE_NODUMP_LISP_OBJECT for objects that cannot be
1259 saved -- e.g. that contain pointers to non-persistent external objects
1260 such as window-system windows.)
1261
1262 DEFINE_*_SIZABLE_LISP_OBJECT is for objects whose size varies.
1263
1264 DEFINE_*_FROB_BLOCK_LISP_OBJECT is for objects that are allocated in
1265 large blocks ("frob blocks"), which are parceled up individually. Such
1266 objects need special handling in alloc.c. This does not apply to
1267 NEW_GC, because it does this automatically.
1268
1269 DEFINE_*_INTERNAL_LISP_OBJECT is for "internal" objects that should
1270 never be visible on the Lisp level. This is a shorthand for the most
1271 common type of internal objects, which have no equal or hash method
1272 (since they generally won't appear in hash tables), no finalizer and
1273 internal_object_printer() as their print method (which prints that the
1274 object is internal and shouldn't be visible externally). For internal
1275 objects needing a finalizer, equal or hash method, or wanting to
1276 customize the print method, use the normal DEFINE_*_LISP_OBJECT
1277 mechanism for defining these objects.
1278
1279 DEFINE_*_GENERAL_LISP_OBJECT is for objects that need to provide one of
1280 the less common methods that are omitted on most objects. These methods
1281 include the methods supporting the unified property interface using
1282 `get', `put', `remprop' and `object-plist', and (for dumpable objects
1283 only) the `disksaver' method.
1284
1285 DEFINE_MODULE_* is for objects defined in an external module.
1286
1287 MAKE_LISP_OBJECT and MAKE_MODULE_LISP_OBJECT are what underlies all of
1288 these; they define a structure containing pointers to object methods
1289 and other info such as the size of the structure containing the object.
1156 */ 1290 */
1157 1291
1292 /* #### FIXME What's going on here? */
1158 #if defined (ERROR_CHECK_TYPES) 1293 #if defined (ERROR_CHECK_TYPES)
1159 # define DECLARE_ERROR_CHECK_TYPES(c_name, structtype) 1294 # define DECLARE_ERROR_CHECK_TYPES(c_name, structtype)
1160 #else 1295 #else
1161 # define DECLARE_ERROR_CHECK_TYPES(c_name, structtype) 1296 # define DECLARE_ERROR_CHECK_TYPES(c_name, structtype)
1162 #endif 1297 #endif
1163 1298
1164 1299 /********* The dumpable versions *********** */
1165 #define DEFINE_BASIC_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,structtype) \ 1300
1166 DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype) 1301 #define DEFINE_DUMPABLE_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \
1167 1302 DEFINE_DUMPABLE_GENERAL_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,structtype)
1168 #define DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \ 1303
1169 MAKE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof(structtype),0,1,structtype) 1304 #define DEFINE_DUMPABLE_GENERAL_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,structtype) \
1170 1305 MAKE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,sizeof (structtype),0,0,structtype)
1171 #define DEFINE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,structtype) \ 1306
1172 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype) 1307 #define DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \
1173 1308 DEFINE_DUMPABLE_SIZABLE_GENERAL_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,sizer,structtype)
1174 #define DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \ 1309
1175 MAKE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof (structtype),0,0,structtype) 1310 #define DEFINE_DUMPABLE_SIZABLE_GENERAL_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,sizer,structtype) \
1176 1311 MAKE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,0,sizer,0,structtype)
1177 #define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,sizer,structtype) \ 1312
1178 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,sizer,structtype) 1313 #define DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \
1179 1314 DEFINE_DUMPABLE_FROB_BLOCK_GENERAL_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,structtype)
1180 #define DEFINE_BASIC_LRECORD_SEQUENCE_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,sizer,structtype) \ 1315
1181 MAKE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,sizer,1,structtype) 1316 #define DEFINE_DUMPABLE_FROB_BLOCK_GENERAL_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,structtype) \
1182 1317 MAKE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,sizeof(structtype),0,1,structtype)
1183 #define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizer,structtype) \ 1318
1184 MAKE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,0,sizer,0,structtype) 1319 #define DEFINE_DUMPABLE_FROB_BLOCK_SIZABLE_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \
1320 MAKE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,0,sizer,1,structtype)
1321
1322 #define DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT(name,c_name,marker,desc,structtype) \
1323 DEFINE_DUMPABLE_GENERAL_LISP_OBJECT(name,c_name,marker,internal_object_printer,0,0,0,desc,0,0,0,0,0,structtype)
1324
1325 #define DEFINE_DUMPABLE_SIZABLE_INTERNAL_LISP_OBJECT(name,c_name,marker,desc,sizer,structtype) \
1326 DEFINE_DUMPABLE_SIZABLE_GENERAL_LISP_OBJECT(name,c_name,marker,internal_object_printer,0,0,0,desc,0,0,0,0,0,sizer,structtype)
1327
1328 /********* The non-dumpable versions *********** */
1329
1330 #define DEFINE_NODUMP_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \
1331 DEFINE_NODUMP_GENERAL_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,structtype)
1332
1333 #define DEFINE_NODUMP_GENERAL_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,structtype) \
1334 MAKE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,sizeof (structtype),0,0,structtype)
1335
1336 #define DEFINE_NODUMP_SIZABLE_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \
1337 DEFINE_NODUMP_SIZABLE_GENERAL_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,sizer,structtype)
1338
1339 #define DEFINE_NODUMP_SIZABLE_GENERAL_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,sizer,structtype) \
1340 MAKE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,0,sizer,0,structtype)
1341
1342 #define DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \
1343 DEFINE_NODUMP_FROB_BLOCK_GENERAL_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,structtype)
1344
1345 #define DEFINE_NODUMP_FROB_BLOCK_GENERAL_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,structtype) \
1346 MAKE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,sizeof(structtype),0,1,structtype)
1347
1348 #define DEFINE_NODUMP_FROB_BLOCK_SIZABLE_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \
1349 MAKE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,0,sizer,1,structtype)
1350
1351 #define DEFINE_NODUMP_INTERNAL_LISP_OBJECT(name,c_name,marker,desc,structtype) \
1352 DEFINE_NODUMP_GENERAL_LISP_OBJECT(name,c_name,marker,internal_object_printer,0,0,0,desc,0,0,0,0,0,structtype)
1353
1354 #define DEFINE_NODUMP_SIZABLE_INTERNAL_LISP_OBJECT(name,c_name,marker,desc,sizer,structtype) \
1355 DEFINE_NODUMP_SIZABLE_GENERAL_LISP_OBJECT(name,c_name,marker,internal_object_printer,0,0,0,desc,0,0,0,0,0,sizer,structtype)
1356
1357 /********* MAKE_LISP_OBJECT, the underlying macro *********** */
1185 1358
1186 #ifdef NEW_GC 1359 #ifdef NEW_GC
1187 #define MAKE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \ 1360 #define MAKE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,size,sizer,frob_block_p,structtype) \
1188 DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \ 1361 DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \
1189 const struct lrecord_implementation lrecord_##c_name = \ 1362 const struct lrecord_implementation lrecord_##c_name = \
1190 { name, dumpable, marker, printer, nuker, equal, hash, desc, \ 1363 { name, dumpable, marker, printer, nuker, equal, hash, desc, \
1191 getprop, putprop, remprop, plist, size, sizer, \ 1364 getprop, putprop, remprop, plist, disksaver, size, sizer, \
1192 lrecord_type_##c_name } 1365 lrecord_type_##c_name }
1193 #else /* not NEW_GC */ 1366 #else /* not NEW_GC */
1194 #define MAKE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \ 1367 #define MAKE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,size,sizer,frob_block_p,structtype) \
1195 DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \ 1368 DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \
1196 const struct lrecord_implementation lrecord_##c_name = \ 1369 const struct lrecord_implementation lrecord_##c_name = \
1197 { name, dumpable, marker, printer, nuker, equal, hash, desc, \ 1370 { name, dumpable, marker, printer, nuker, equal, hash, desc, \
1198 getprop, putprop, remprop, plist, size, sizer, \ 1371 getprop, putprop, remprop, plist, disksaver, size, sizer, \
1199 lrecord_type_##c_name, basic_p } 1372 lrecord_type_##c_name, frob_block_p }
1200 #endif /* not NEW_GC */ 1373 #endif /* not NEW_GC */
1201 1374
1202 #define DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,structtype) \ 1375
1203 DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype) 1376 /********* The module dumpable versions *********** */
1204 1377
1205 #define DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \ 1378 #define DEFINE_DUMPABLE_MODULE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,structtype) \
1206 MAKE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof (structtype),0,0,structtype) 1379 DEFINE_DUMPABLE_MODULE_GENERAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,structtype)
1207 1380
1208 #define DEFINE_EXTERNAL_LRECORD_SEQUENCE_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,sizer,structtype) \ 1381 #define DEFINE_DUMPABLE_MODULE_GENERAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,structtype) \
1209 DEFINE_EXTERNAL_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,sizer,structtype) 1382 MAKE_MODULE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,sizeof (structtype),0,0,structtype)
1210 1383
1211 #define DEFINE_EXTERNAL_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizer,structtype) \ 1384 #define DEFINE_DUMPABLE_MODULE_SIZABLE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,sizer,structtype) \
1212 MAKE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,0,sizer,0,structtype) 1385 DEFINE_DUMPABLE_MODULE_SIZABLE_GENERAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,sizer,structtype)
1386
1387 #define DEFINE_DUMPABLE_MODULE_SIZABLE_GENERAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,sizer,structtype) \
1388 MAKE_MODULE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,0,sizer,0,structtype)
1389
1390 /********* The module non-dumpable versions *********** */
1391
1392 #define DEFINE_NODUMP_MODULE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,structtype) \
1393 DEFINE_NODUMP_MODULE_GENERAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,structtype)
1394
1395 #define DEFINE_NODUMP_MODULE_GENERAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,structtype) \
1396 MAKE_MODULE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,sizeof (structtype),0,0,structtype)
1397
1398 #define DEFINE_NODUMP_MODULE_SIZABLE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,sizer,structtype) \
1399 DEFINE_NODUMP_MODULE_SIZABLE_GENERAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,sizer,structtype)
1400
1401 #define DEFINE_NODUMP_MODULE_SIZABLE_GENERAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,sizer,structtype) \
1402 MAKE_MODULE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,0,sizer,0,structtype)
1403
1404 /********* MAKE_MODULE_LISP_OBJECT, the underlying macro *********** */
1213 1405
1214 #ifdef NEW_GC 1406 #ifdef NEW_GC
1215 #define MAKE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \ 1407 #define MAKE_MODULE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,size,sizer,frob_block_p,structtype) \
1216 DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \ 1408 DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \
1217 int lrecord_type_##c_name; \ 1409 int lrecord_type_##c_name; \
1218 struct lrecord_implementation lrecord_##c_name = \ 1410 struct lrecord_implementation lrecord_##c_name = \
1219 { name, dumpable, marker, printer, nuker, equal, hash, desc, \ 1411 { name, dumpable, marker, printer, nuker, equal, hash, desc, \
1220 getprop, putprop, remprop, plist, size, sizer, \ 1412 getprop, putprop, remprop, plist, disksaver, size, sizer, \
1221 lrecord_type_last_built_in_type } 1413 lrecord_type_last_built_in_type }
1222 #else /* not NEW_GC */ 1414 #else /* not NEW_GC */
1223 #define MAKE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \ 1415 #define MAKE_MODULE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,size,sizer,frob_block_p,structtype) \
1224 DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \ 1416 DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \
1225 int lrecord_type_##c_name; \ 1417 int lrecord_type_##c_name; \
1226 struct lrecord_implementation lrecord_##c_name = \ 1418 struct lrecord_implementation lrecord_##c_name = \
1227 { name, dumpable, marker, printer, nuker, equal, hash, desc, \ 1419 { name, dumpable, marker, printer, nuker, equal, hash, desc, \
1228 getprop, putprop, remprop, plist, size, sizer, \ 1420 getprop, putprop, remprop, plist, disksaver, size, sizer, \
1229 lrecord_type_last_built_in_type, basic_p } 1421 lrecord_type_last_built_in_type, frob_block_p }
1230 #endif /* not NEW_GC */ 1422 #endif /* not NEW_GC */
1231 1423
1232 #ifdef USE_KKCC 1424 #ifdef USE_KKCC
1233 extern MODULE_API const struct memory_description *lrecord_memory_descriptions[]; 1425 extern MODULE_API const struct memory_description *lrecord_memory_descriptions[];
1234 1426
1235 #define INIT_LRECORD_IMPLEMENTATION(type) do { \ 1427 #define INIT_LISP_OBJECT(type) do { \
1236 lrecord_implementations_table[lrecord_type_##type] = &lrecord_##type; \ 1428 lrecord_implementations_table[lrecord_type_##type] = &lrecord_##type; \
1237 lrecord_memory_descriptions[lrecord_type_##type] = \ 1429 lrecord_memory_descriptions[lrecord_type_##type] = \
1238 lrecord_implementations_table[lrecord_type_##type]->description; \ 1430 lrecord_implementations_table[lrecord_type_##type]->description; \
1239 } while (0) 1431 } while (0)
1240 #else /* not USE_KKCC */ 1432 #else /* not USE_KKCC */
1241 extern MODULE_API Lisp_Object (*lrecord_markers[]) (Lisp_Object); 1433 extern MODULE_API Lisp_Object (*lrecord_markers[]) (Lisp_Object);
1242 1434
1243 #define INIT_LRECORD_IMPLEMENTATION(type) do { \ 1435 #define INIT_LISP_OBJECT(type) do { \
1244 lrecord_implementations_table[lrecord_type_##type] = &lrecord_##type; \ 1436 lrecord_implementations_table[lrecord_type_##type] = &lrecord_##type; \
1245 lrecord_markers[lrecord_type_##type] = \ 1437 lrecord_markers[lrecord_type_##type] = \
1246 lrecord_implementations_table[lrecord_type_##type]->marker; \ 1438 lrecord_implementations_table[lrecord_type_##type]->marker; \
1247 } while (0) 1439 } while (0)
1248 #endif /* not USE_KKCC */ 1440 #endif /* not USE_KKCC */
1249 1441
1250 #define INIT_EXTERNAL_LRECORD_IMPLEMENTATION(type) do { \ 1442 #define INIT_MODULE_LISP_OBJECT(type) do { \
1251 lrecord_type_##type = lrecord_type_count++; \ 1443 lrecord_type_##type = lrecord_type_count++; \
1252 lrecord_##type.lrecord_type_index = lrecord_type_##type; \ 1444 lrecord_##type.lrecord_type_index = lrecord_type_##type; \
1253 INIT_LRECORD_IMPLEMENTATION(type); \ 1445 INIT_LISP_OBJECT(type); \
1254 } while (0) 1446 } while (0)
1255 1447
1256 #ifdef HAVE_SHLIB 1448 #ifdef HAVE_SHLIB
1257 /* Allow undefining types in order to support module unloading. */ 1449 /* Allow undefining types in order to support module unloading. */
1258 1450
1259 #ifdef USE_KKCC 1451 #ifdef USE_KKCC
1260 #define UNDEF_LRECORD_IMPLEMENTATION(type) do { \ 1452 #define UNDEF_LISP_OBJECT(type) do { \
1261 lrecord_implementations_table[lrecord_type_##type] = NULL; \ 1453 lrecord_implementations_table[lrecord_type_##type] = NULL; \
1262 lrecord_memory_descriptions[lrecord_type_##type] = NULL; \ 1454 lrecord_memory_descriptions[lrecord_type_##type] = NULL; \
1263 } while (0) 1455 } while (0)
1264 #else /* not USE_KKCC */ 1456 #else /* not USE_KKCC */
1265 #define UNDEF_LRECORD_IMPLEMENTATION(type) do { \ 1457 #define UNDEF_LISP_OBJECT(type) do { \
1266 lrecord_implementations_table[lrecord_type_##type] = NULL; \ 1458 lrecord_implementations_table[lrecord_type_##type] = NULL; \
1267 lrecord_markers[lrecord_type_##type] = NULL; \ 1459 lrecord_markers[lrecord_type_##type] = NULL; \
1268 } while (0) 1460 } while (0)
1269 #endif /* not USE_KKCC */ 1461 #endif /* not USE_KKCC */
1270 1462
1271 #define UNDEF_EXTERNAL_LRECORD_IMPLEMENTATION(type) do { \ 1463 #define UNDEF_MODULE_LISP_OBJECT(type) do { \
1272 if (lrecord_##type.lrecord_type_index == lrecord_type_count - 1) { \ 1464 if (lrecord_##type.lrecord_type_index == lrecord_type_count - 1) { \
1273 /* This is the most recently defined type. Clean up nicely. */ \ 1465 /* This is the most recently defined type. Clean up nicely. */ \
1274 lrecord_type_##type = lrecord_type_count--; \ 1466 lrecord_type_##type = lrecord_type_count--; \
1275 } /* Else we can't help leaving a hole with this implementation. */ \ 1467 } /* Else we can't help leaving a hole with this implementation. */ \
1276 UNDEF_LRECORD_IMPLEMENTATION(type); \ 1468 UNDEF_LISP_OBJECT(type); \
1277 } while (0) 1469 } while (0)
1278 1470
1279 #endif /* HAVE_SHLIB */ 1471 #endif /* HAVE_SHLIB */
1280 1472
1281 #define LRECORDP(a) (XTYPE (a) == Lisp_Type_Record) 1473 #define LRECORDP(a) (XTYPE (a) == Lisp_Type_Record)
1287 /* Steps to create a new object: 1479 /* Steps to create a new object:
1288 1480
1289 1. Declare the struct for your object in a header file somewhere. 1481 1. Declare the struct for your object in a header file somewhere.
1290 Remember that it must begin with 1482 Remember that it must begin with
1291 1483
1292 struct LCRECORD_HEADER header; 1484 NORMAL_LISP_OBJECT_HEADER header;
1293 1485
1294 2. Put the "standard junk" (DECLARE_RECORD()/XFOO/etc.) below the 1486 2. Put the "standard junk" (DECLARE_LISP_OBJECT()/XFOO/etc.) below the
1295 struct definition -- see below. 1487 struct definition -- see below.
1296 1488
1297 3. Add this header file to inline.c. 1489 3. Add this header file to inline.c.
1298 1490
1299 4. Create the methods for your object. Note that technically you don't 1491 4. Create the methods for your object. Note that technically you don't
1302 4. Create the data layout description for your object. See 1494 4. Create the data layout description for your object. See
1303 toolbar_button_description below; the comment above in `struct lrecord', 1495 toolbar_button_description below; the comment above in `struct lrecord',
1304 describing the purpose of the descriptions; and comments elsewhere in 1496 describing the purpose of the descriptions; and comments elsewhere in
1305 this file describing the exact syntax of the description structures. 1497 this file describing the exact syntax of the description structures.
1306 1498
1307 6. Define your object with DEFINE_LRECORD_IMPLEMENTATION() or some 1499 6. Define your object with DEFINE_*_LISP_OBJECT() or some
1308 variant. 1500 variant. At the minimum, you need to decide whether your object can
1501 be dumped. Objects that are created as part of the loadup process and
1502 need to be persistent across dumping should be created dumpable.
1503 Nondumpable objects are generally those associated with display,
1504 particularly those containing a pointer to an external library object
1505 (e.g. a window-system window).
1309 1506
1310 7. Include the header file in the .c file where you defined the object. 1507 7. Include the header file in the .c file where you defined the object.
1311 1508
1312 8. Put a call to INIT_LRECORD_IMPLEMENTATION() for the object in the 1509 8. Put a call to INIT_LISP_OBJECT() for the object in the
1313 .c file's syms_of_foo() function. 1510 .c file's syms_of_foo() function.
1314 1511
1315 9. Add a type enum for the object to enum lrecord_type, earlier in this 1512 9. Add a type enum for the object to enum lrecord_type, earlier in this
1316 file. 1513 file.
1317 1514
1318 --ben 1515 --ben
1319 1516
1320 An example: 1517 An example:
1321 1518
1322 ------------------------------ in toolbar.h ----------------------------- 1519 ------------------------------ in toolbar.h -----------------------------
1323 1520
1324 struct toolbar_button 1521 struct toolbar_button
1325 { 1522 {
1326 struct LCRECORD_HEADER header; 1523 NORMAL_LISP_OBJECT_HEADER header;
1327 1524
1328 Lisp_Object next; 1525 Lisp_Object next;
1329 Lisp_Object frame; 1526 Lisp_Object frame;
1330 1527
1331 Lisp_Object up_glyph; 1528 Lisp_Object up_glyph;
1332 Lisp_Object down_glyph; 1529 Lisp_Object down_glyph;
1333 Lisp_Object disabled_glyph; 1530 Lisp_Object disabled_glyph;
1334 1531
1335 Lisp_Object cap_up_glyph; 1532 Lisp_Object cap_up_glyph;
1336 Lisp_Object cap_down_glyph; 1533 Lisp_Object cap_down_glyph;
1337 Lisp_Object cap_disabled_glyph; 1534 Lisp_Object cap_disabled_glyph;
1338 1535
1339 Lisp_Object callback; 1536 Lisp_Object callback;
1340 Lisp_Object enabled_p; 1537 Lisp_Object enabled_p;
1341 Lisp_Object help_string; 1538 Lisp_Object help_string;
1342 1539
1343 char enabled; 1540 char enabled;
1344 char down; 1541 char down;
1345 char pushright; 1542 char pushright;
1346 char blank; 1543 char blank;
1347 1544
1348 int x, y; 1545 int x, y;
1349 int width, height; 1546 int width, height;
1350 int dirty; 1547 int dirty;
1351 int vertical; 1548 int vertical;
1352 int border_width; 1549 int border_width;
1353 }; 1550 };
1354 1551
1355 [[ the standard junk: ]] 1552 [[ the standard junk: ]]
1356 1553
1357 DECLARE_LRECORD (toolbar_button, struct toolbar_button); 1554 DECLARE_LISP_OBJECT (toolbar_button, struct toolbar_button);
1358 #define XTOOLBAR_BUTTON(x) XRECORD (x, toolbar_button, struct toolbar_button) 1555 #define XTOOLBAR_BUTTON(x) XRECORD (x, toolbar_button, struct toolbar_button)
1359 #define wrap_toolbar_button(p) wrap_record (p, toolbar_button) 1556 #define wrap_toolbar_button(p) wrap_record (p, toolbar_button)
1360 #define TOOLBAR_BUTTONP(x) RECORDP (x, toolbar_button) 1557 #define TOOLBAR_BUTTONP(x) RECORDP (x, toolbar_button)
1361 #define CHECK_TOOLBAR_BUTTON(x) CHECK_RECORD (x, toolbar_button) 1558 #define CHECK_TOOLBAR_BUTTON(x) CHECK_RECORD (x, toolbar_button)
1362 #define CONCHECK_TOOLBAR_BUTTON(x) CONCHECK_RECORD (x, toolbar_button) 1559 #define CONCHECK_TOOLBAR_BUTTON(x) CONCHECK_RECORD (x, toolbar_button)
1363 1560
1364 ------------------------------ in toolbar.c ----------------------------- 1561 ------------------------------ in toolbar.c -----------------------------
1365 1562
1366 #include "toolbar.h" 1563 #include "toolbar.h"
1367 1564
1368 ... 1565 ...
1369 1566
1370 static const struct memory_description toolbar_button_description [] = { 1567 static const struct memory_description toolbar_button_description [] = {
1371 { XD_LISP_OBJECT, offsetof (struct toolbar_button, next) }, 1568 { XD_LISP_OBJECT, offsetof (struct toolbar_button, next) },
1372 { XD_LISP_OBJECT, offsetof (struct toolbar_button, frame) }, 1569 { XD_LISP_OBJECT, offsetof (struct toolbar_button, frame) },
1373 { XD_LISP_OBJECT, offsetof (struct toolbar_button, up_glyph) }, 1570 { XD_LISP_OBJECT, offsetof (struct toolbar_button, up_glyph) },
1374 { XD_LISP_OBJECT, offsetof (struct toolbar_button, down_glyph) }, 1571 { XD_LISP_OBJECT, offsetof (struct toolbar_button, down_glyph) },
1375 { XD_LISP_OBJECT, offsetof (struct toolbar_button, disabled_glyph) }, 1572 { XD_LISP_OBJECT, offsetof (struct toolbar_button, disabled_glyph) },
1376 { XD_LISP_OBJECT, offsetof (struct toolbar_button, cap_up_glyph) }, 1573 { XD_LISP_OBJECT, offsetof (struct toolbar_button, cap_up_glyph) },
1377 { XD_LISP_OBJECT, offsetof (struct toolbar_button, cap_down_glyph) }, 1574 { XD_LISP_OBJECT, offsetof (struct toolbar_button, cap_down_glyph) },
1378 { XD_LISP_OBJECT, offsetof (struct toolbar_button, cap_disabled_glyph) }, 1575 { XD_LISP_OBJECT, offsetof (struct toolbar_button, cap_disabled_glyph) },
1379 { XD_LISP_OBJECT, offsetof (struct toolbar_button, callback) }, 1576 { XD_LISP_OBJECT, offsetof (struct toolbar_button, callback) },
1380 { XD_LISP_OBJECT, offsetof (struct toolbar_button, enabled_p) }, 1577 { XD_LISP_OBJECT, offsetof (struct toolbar_button, enabled_p) },
1381 { XD_LISP_OBJECT, offsetof (struct toolbar_button, help_string) }, 1578 { XD_LISP_OBJECT, offsetof (struct toolbar_button, help_string) },
1382 { XD_END } 1579 { XD_END }
1383 }; 1580 };
1384 1581
1385 static Lisp_Object 1582 static Lisp_Object
1386 mark_toolbar_button (Lisp_Object obj) 1583 allocate_toolbar_button (struct frame *f, int pushright)
1387 \{ 1584 {
1388 struct toolbar_button *data = XTOOLBAR_BUTTON (obj); 1585 struct toolbar_button *tb;
1389 mark_object (data->next); 1586
1390 mark_object (data->frame); 1587 tb = XTOOLBAR_BUTTON (ALLOC_NORMAL_LISP_OBJECT (toolbar_button));
1391 mark_object (data->up_glyph); 1588 tb->next = Qnil;
1392 mark_object (data->down_glyph); 1589 tb->frame = wrap_frame (f);
1393 mark_object (data->disabled_glyph); 1590 tb->up_glyph = Qnil;
1394 mark_object (data->cap_up_glyph); 1591 tb->down_glyph = Qnil;
1395 mark_object (data->cap_down_glyph); 1592 tb->disabled_glyph = Qnil;
1396 mark_object (data->cap_disabled_glyph); 1593 tb->cap_up_glyph = Qnil;
1397 mark_object (data->callback); 1594 tb->cap_down_glyph = Qnil;
1398 mark_object (data->enabled_p); 1595 tb->cap_disabled_glyph = Qnil;
1399 return data->help_string; 1596 tb->callback = Qnil;
1400 } 1597 tb->enabled_p = Qnil;
1401 1598 tb->help_string = Qnil;
1402 [[ If your object should never escape to Lisp, declare its print method 1599
1403 as internal_object_printer instead of 0. ]] 1600 tb->pushright = pushright;
1404 1601 tb->x = tb->y = tb->width = tb->height = -1;
1405 DEFINE_LRECORD_IMPLEMENTATION ("toolbar-button", toolbar_button, 1602 tb->dirty = 1;
1406 0, mark_toolbar_button, 0, 0, 0, 0, 1603
1407 toolbar_button_description, 1604 return wrap_toolbar_button (tb);
1408 struct toolbar_button); 1605 }
1409 1606
1410 ... 1607 static Lisp_Object
1411 1608 mark_toolbar_button (Lisp_Object obj)
1412 void 1609 {
1413 syms_of_toolbar (void) 1610 struct toolbar_button *data = XTOOLBAR_BUTTON (obj);
1414 { 1611 mark_object (data->next);
1415 INIT_LRECORD_IMPLEMENTATION (toolbar_button); 1612 mark_object (data->frame);
1416 1613 mark_object (data->up_glyph);
1417 ...; 1614 mark_object (data->down_glyph);
1418 } 1615 mark_object (data->disabled_glyph);
1419 1616 mark_object (data->cap_up_glyph);
1617 mark_object (data->cap_down_glyph);
1618 mark_object (data->cap_disabled_glyph);
1619 mark_object (data->callback);
1620 mark_object (data->enabled_p);
1621 return data->help_string;
1622 }
1623
1624 DEFINE_NODUMP_LISP_OBJECT ("toolbar-button", toolbar_button,
1625 mark_toolbar_button,
1626 external_object_printer, 0, 0, 0,
1627 toolbar_button_description,
1628 struct toolbar_button);
1629
1630 ...
1631
1632 void
1633 syms_of_toolbar (void)
1634 {
1635 INIT_LISP_OBJECT (toolbar_button);
1636
1637 ...;
1638 }
1639
1420 ------------------------------ in inline.c ----------------------------- 1640 ------------------------------ in inline.c -----------------------------
1421 1641
1422 #ifdef HAVE_TOOLBARS 1642 #ifdef HAVE_TOOLBARS
1423 #include "toolbar.h" 1643 #include "toolbar.h"
1424 #endif 1644 #endif
1425 1645
1426 ------------------------------ in lrecord.h ----------------------------- 1646 ------------------------------ in lrecord.h -----------------------------
1427 1647
1428 enum lrecord_type 1648 enum lrecord_type
1429 { 1649 {
1650 ...
1651 lrecord_type_toolbar_button,
1652 ...
1653 };
1654
1655 ------------------------------ in .gdbinit.in.in -----------------------------
1656
1430 ... 1657 ...
1431 lrecord_type_toolbar_button, 1658 else
1659 if $lrecord_type == lrecord_type_toolbar_button
1660 pstructtype toolbar_button
1432 ... 1661 ...
1433 }; 1662 ...
1434 1663 ...
1435 1664 end
1436 --ben 1665
1666 --ben
1437 1667
1438 */ 1668 */
1439 1669
1440 /* 1670 /*
1441 1671
1442 Note: Object types defined in external dynamically-loaded modules (not 1672 Note: Object types defined in external dynamically-loaded modules (not
1443 part of the XEmacs main source code) should use DECLARE_EXTERNAL_LRECORD 1673 part of the XEmacs main source code) should use DECLARE_*_MODULE_LISP_OBJECT
1444 and DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION rather than DECLARE_LRECORD 1674 and DEFINE_*_MODULE_LISP_OBJECT rather than DECLARE_*_LISP_OBJECT
1445 and DEFINE_LRECORD_IMPLEMENTATION. The EXTERNAL versions declare and 1675 and DEFINE_*_LISP_OBJECT. The MODULE versions declare and
1446 allocate an enumerator for the type being defined. 1676 allocate an enumerator for the type being defined.
1447 1677
1448 */ 1678 */
1449 1679
1450 1680
1451 #ifdef ERROR_CHECK_TYPES 1681 #ifdef ERROR_CHECK_TYPES
1452 1682
1453 # define DECLARE_LRECORD(c_name, structtype) \ 1683 # define DECLARE_LISP_OBJECT(c_name, structtype) \
1454 extern const struct lrecord_implementation lrecord_##c_name; \ 1684 extern const struct lrecord_implementation lrecord_##c_name; \
1455 DECLARE_INLINE_HEADER ( \ 1685 DECLARE_INLINE_HEADER ( \
1456 structtype * \ 1686 structtype * \
1457 error_check_##c_name (Lisp_Object obj, const Ascbyte *file, int line) \ 1687 error_check_##c_name (Lisp_Object obj, const Ascbyte *file, int line) \
1458 ) \ 1688 ) \
1460 assert_at_line (RECORD_TYPEP (obj, lrecord_type_##c_name), file, line); \ 1690 assert_at_line (RECORD_TYPEP (obj, lrecord_type_##c_name), file, line); \
1461 return (structtype *) XPNTR (obj); \ 1691 return (structtype *) XPNTR (obj); \
1462 } \ 1692 } \
1463 extern Lisp_Object Q##c_name##p 1693 extern Lisp_Object Q##c_name##p
1464 1694
1465 # define DECLARE_MODULE_API_LRECORD(c_name, structtype) \ 1695 # define DECLARE_MODULE_API_LISP_OBJECT(c_name, structtype) \
1466 extern MODULE_API const struct lrecord_implementation lrecord_##c_name; \ 1696 extern MODULE_API const struct lrecord_implementation lrecord_##c_name; \
1467 DECLARE_INLINE_HEADER ( \ 1697 DECLARE_INLINE_HEADER ( \
1468 structtype * \ 1698 structtype * \
1469 error_check_##c_name (Lisp_Object obj, const Ascbyte *file, int line) \ 1699 error_check_##c_name (Lisp_Object obj, const Ascbyte *file, int line) \
1470 ) \ 1700 ) \
1472 assert_at_line (RECORD_TYPEP (obj, lrecord_type_##c_name), file, line); \ 1702 assert_at_line (RECORD_TYPEP (obj, lrecord_type_##c_name), file, line); \
1473 return (structtype *) XPNTR (obj); \ 1703 return (structtype *) XPNTR (obj); \
1474 } \ 1704 } \
1475 extern MODULE_API Lisp_Object Q##c_name##p 1705 extern MODULE_API Lisp_Object Q##c_name##p
1476 1706
1477 # define DECLARE_EXTERNAL_LRECORD(c_name, structtype) \ 1707 # define DECLARE_MODULE_LISP_OBJECT(c_name, structtype) \
1478 extern int lrecord_type_##c_name; \ 1708 extern int lrecord_type_##c_name; \
1479 extern struct lrecord_implementation lrecord_##c_name; \ 1709 extern struct lrecord_implementation lrecord_##c_name; \
1480 DECLARE_INLINE_HEADER ( \ 1710 DECLARE_INLINE_HEADER ( \
1481 structtype * \ 1711 structtype * \
1482 error_check_##c_name (Lisp_Object obj, const Ascbyte *file, int line) \ 1712 error_check_##c_name (Lisp_Object obj, const Ascbyte *file, int line) \
1485 assert_at_line (RECORD_TYPEP (obj, lrecord_type_##c_name), file, line); \ 1715 assert_at_line (RECORD_TYPEP (obj, lrecord_type_##c_name), file, line); \
1486 return (structtype *) XPNTR (obj); \ 1716 return (structtype *) XPNTR (obj); \
1487 } \ 1717 } \
1488 extern Lisp_Object Q##c_name##p 1718 extern Lisp_Object Q##c_name##p
1489 1719
1490 # define DECLARE_NONRECORD(c_name, type_enum, structtype) \
1491 DECLARE_INLINE_HEADER ( \
1492 structtype * \
1493 error_check_##c_name (Lisp_Object obj, const Ascbyte *file, int line) \
1494 ) \
1495 { \
1496 assert_at_line (XTYPE (obj) == type_enum, file, line); \
1497 return (structtype *) XPNTR (obj); \
1498 } \
1499 extern Lisp_Object Q##c_name##p
1500
1501 # define XRECORD(x, c_name, structtype) \ 1720 # define XRECORD(x, c_name, structtype) \
1502 error_check_##c_name (x, __FILE__, __LINE__)
1503 # define XNONRECORD(x, c_name, type_enum, structtype) \
1504 error_check_##c_name (x, __FILE__, __LINE__) 1721 error_check_##c_name (x, __FILE__, __LINE__)
1505 1722
1506 DECLARE_INLINE_HEADER ( 1723 DECLARE_INLINE_HEADER (
1507 Lisp_Object 1724 Lisp_Object
1508 wrap_record_1 (const void *ptr, enum lrecord_type ty, const Ascbyte *file, 1725 wrap_record_1 (const void *ptr, enum lrecord_type ty, const Ascbyte *file,
1518 #define wrap_record(ptr, ty) \ 1735 #define wrap_record(ptr, ty) \
1519 wrap_record_1 (ptr, lrecord_type_##ty, __FILE__, __LINE__) 1736 wrap_record_1 (ptr, lrecord_type_##ty, __FILE__, __LINE__)
1520 1737
1521 #else /* not ERROR_CHECK_TYPES */ 1738 #else /* not ERROR_CHECK_TYPES */
1522 1739
1523 # define DECLARE_LRECORD(c_name, structtype) \ 1740 # define DECLARE_LISP_OBJECT(c_name, structtype) \
1524 extern Lisp_Object Q##c_name##p; \ 1741 extern Lisp_Object Q##c_name##p; \
1525 extern const struct lrecord_implementation lrecord_##c_name 1742 extern const struct lrecord_implementation lrecord_##c_name
1526 # define DECLARE_MODULE_API_LRECORD(c_name, structtype) \ 1743 # define DECLARE_MODULE_API_LISP_OBJECT(c_name, structtype) \
1527 extern MODULE_API Lisp_Object Q##c_name##p; \ 1744 extern MODULE_API Lisp_Object Q##c_name##p; \
1528 extern MODULE_API const struct lrecord_implementation lrecord_##c_name 1745 extern MODULE_API const struct lrecord_implementation lrecord_##c_name
1529 # define DECLARE_EXTERNAL_LRECORD(c_name, structtype) \ 1746 # define DECLARE_MODULE_LISP_OBJECT(c_name, structtype) \
1530 extern Lisp_Object Q##c_name##p; \ 1747 extern Lisp_Object Q##c_name##p; \
1531 extern int lrecord_type_##c_name; \ 1748 extern int lrecord_type_##c_name; \
1532 extern struct lrecord_implementation lrecord_##c_name 1749 extern struct lrecord_implementation lrecord_##c_name
1533 # define DECLARE_NONRECORD(c_name, type_enum, structtype) \
1534 extern Lisp_Object Q##c_name##p
1535 # define XRECORD(x, c_name, structtype) ((structtype *) XPNTR (x)) 1750 # define XRECORD(x, c_name, structtype) ((structtype *) XPNTR (x))
1536 # define XNONRECORD(x, c_name, type_enum, structtype) \
1537 ((structtype *) XPNTR (x))
1538 /* wrap_pointer_1 is so named as a suggestion not to use it unless you 1751 /* wrap_pointer_1 is so named as a suggestion not to use it unless you
1539 know what you're doing. */ 1752 know what you're doing. */
1540 #define wrap_record(ptr, ty) wrap_pointer_1 (ptr) 1753 #define wrap_record(ptr, ty) wrap_pointer_1 (ptr)
1541 1754
1542 #endif /* not ERROR_CHECK_TYPES */ 1755 #endif /* not ERROR_CHECK_TYPES */
1586 #ifndef NEW_GC 1799 #ifndef NEW_GC
1587 /*-------------------------- lcrecord-list -----------------------------*/ 1800 /*-------------------------- lcrecord-list -----------------------------*/
1588 1801
1589 struct lcrecord_list 1802 struct lcrecord_list
1590 { 1803 {
1591 struct LCRECORD_HEADER header; 1804 NORMAL_LISP_OBJECT_HEADER header;
1592 Lisp_Object free; 1805 Lisp_Object free;
1593 Elemcount size; 1806 Elemcount size;
1594 const struct lrecord_implementation *implementation; 1807 const struct lrecord_implementation *implementation;
1595 }; 1808 };
1596 1809
1597 DECLARE_LRECORD (lcrecord_list, struct lcrecord_list); 1810 DECLARE_LISP_OBJECT (lcrecord_list, struct lcrecord_list);
1598 #define XLCRECORD_LIST(x) XRECORD (x, lcrecord_list, struct lcrecord_list) 1811 #define XLCRECORD_LIST(x) XRECORD (x, lcrecord_list, struct lcrecord_list)
1599 #define wrap_lcrecord_list(p) wrap_record (p, lcrecord_list) 1812 #define wrap_lcrecord_list(p) wrap_record (p, lcrecord_list)
1600 #define LCRECORD_LISTP(x) RECORDP (x, lcrecord_list) 1813 #define LCRECORD_LISTP(x) RECORDP (x, lcrecord_list)
1601 /* #define CHECK_LCRECORD_LIST(x) CHECK_RECORD (x, lcrecord_list) 1814 /* #define CHECK_LCRECORD_LIST(x) CHECK_RECORD (x, lcrecord_list)
1602 Lcrecord lists should never escape to the Lisp level, so 1815 Lcrecord lists should never escape to the Lisp level, so
1607 1820
1608 See above for a discussion of the difference between plain lrecords and 1821 See above for a discussion of the difference between plain lrecords and
1609 lrecords. lcrecords themselves are divided into three types: (1) 1822 lrecords. lcrecords themselves are divided into three types: (1)
1610 auto-managed, (2) hand-managed, and (3) unmanaged. "Managed" refers to 1823 auto-managed, (2) hand-managed, and (3) unmanaged. "Managed" refers to
1611 using a special object called an lcrecord-list to keep track of freed 1824 using a special object called an lcrecord-list to keep track of freed
1612 lcrecords, which can freed with FREE_LCRECORD() or the like and later be 1825 lcrecords, which can freed with free_normal_lisp_object() or the like
1613 recycled when a new lcrecord is required, rather than requiring new 1826 and later be recycled when a new lcrecord is required, rather than
1614 malloc(). Thus, allocation of lcrecords can be very 1827 requiring new malloc(). Thus, allocation of lcrecords can be very
1615 cheap. (Technically, the lcrecord-list manager could divide up large 1828 cheap. (Technically, the lcrecord-list manager could divide up large
1616 chunks of memory and allocate out of that, mimicking what happens with 1829 chunks of memory and allocate out of that, mimicking what happens with
1617 lrecords. At that point, however, we'd want to rethink the whole 1830 lrecords. At that point, however, we'd want to rethink the whole
1618 division between lrecords and lcrecords.) 1831 division between lrecords and lcrecords.)
1619 1832
1620 NOTE: There is a fundamental limitation of lcrecord-lists, which is that 1833 NOTE: There is a fundamental limitation of lcrecord-lists, which is that
1621 they only handle blocks of a particular, fixed size. Thus, objects that 1834 they only handle blocks of a particular, fixed size. Thus, objects that
1622 can be of varying sizes need to do various tricks. These considerations 1835 can be of varying sizes need to do various tricks. These considerations
1623 in particular dictate the various types of management: 1836 in particular dictate the various types of management:
1624 1837
1625 -- "Auto-managed" means that you just go ahead and allocate the lcrecord 1838 -- "Auto-managed" means that you just go ahead and allocate the lcrecord
1626 whenever you want, using old_alloc_lcrecord_type(), and the appropriate 1839 whenever you want, using ALLOC_NORMAL_LISP_OBJECT(), and the appropriate
1627 lcrecord-list manager is automatically created. To free, you just call 1840 lcrecord-list manager is automatically created. To free, you just call
1628 "FREE_LCRECORD()" and the appropriate lcrecord-list manager is 1841 "free_normal_lisp_object()" and the appropriate lcrecord-list manager is
1629 automatically located and called. The limitation here of course is that 1842 automatically located and called. The limitation here of course is that
1630 all your objects are of the same size. (#### Eventually we should have a 1843 all your objects are of the same size. (#### Eventually we should have a
1631 more sophisticated system that tracks the sizes seen and creates one 1844 more sophisticated system that tracks the sizes seen and creates one
1632 lcrecord list per size, indexed in a hash table. Usually there are only 1845 lcrecord list per size, indexed in a hash table. Usually there are only
1633 a limited number of sizes, so this works well.) 1846 a limited number of sizes, so this works well.)
1644 lcrecord-lists, no way to free them. This may be suitable when the 1857 lcrecord-lists, no way to free them. This may be suitable when the
1645 lcrecords are variable-sized and (a) you're too lazy to write the code 1858 lcrecords are variable-sized and (a) you're too lazy to write the code
1646 to hand-manage them, or (b) the objects you create are always or almost 1859 to hand-manage them, or (b) the objects you create are always or almost
1647 always Lisp-visible, and thus there's no point in freeing them (and it 1860 always Lisp-visible, and thus there's no point in freeing them (and it
1648 wouldn't be safe to do so). You just create them with 1861 wouldn't be safe to do so). You just create them with
1649 BASIC_ALLOC_LCRECORD(), and that's it. 1862 ALLOC_SIZED_LISP_OBJECT(), and that's it.
1650 1863
1651 --ben 1864 --ben
1652 1865
1653 Here is an in-depth look at the steps required to create a allocate an 1866 Here is an in-depth look at the steps required to create a allocate an
1654 lcrecord using the hand-managed style. Since this is the most 1867 lcrecord using the hand-managed style. Since this is the most
1657 lcrecord really entails, and what are the precautions: 1870 lcrecord really entails, and what are the precautions:
1658 1871
1659 1) Create an lcrecord-list object using make_lcrecord_list(). This is 1872 1) Create an lcrecord-list object using make_lcrecord_list(). This is
1660 often done at initialization. Remember to staticpro_nodump() this 1873 often done at initialization. Remember to staticpro_nodump() this
1661 object! The arguments to make_lcrecord_list() are the same as would be 1874 object! The arguments to make_lcrecord_list() are the same as would be
1662 passed to BASIC_ALLOC_LCRECORD(). 1875 passed to ALLOC_SIZED_LISP_OBJECT().
1663 1876
1664 2) Instead of calling BASIC_ALLOC_LCRECORD(), call alloc_managed_lcrecord() 1877 2) Instead of calling ALLOC_SIZED_LISP_OBJECT(), call
1665 and pass the lcrecord-list earlier created. 1878 alloc_managed_lcrecord() and pass the lcrecord-list earlier created.
1666 1879
1667 3) When done with the lcrecord, call free_managed_lcrecord(). The 1880 3) When done with the lcrecord, call free_managed_lcrecord(). The
1668 standard freeing caveats apply: ** make sure there are no pointers to 1881 standard freeing caveats apply: ** make sure there are no pointers to
1669 the object anywhere! ** 1882 the object anywhere! **
1670 1883
1671 4) Calling free_managed_lcrecord() is just like kissing the 1884 4) Calling free_managed_lcrecord() is just like kissing the
1672 lcrecord goodbye as if it were garbage-collected. This means: 1885 lcrecord goodbye as if it were garbage-collected. This means:
1673 -- the contents of the freed lcrecord are undefined, and the 1886 -- the contents of the freed lcrecord are undefined, and the
1674 contents of something produced by alloc_managed_lcrecord() 1887 contents of something produced by alloc_managed_lcrecord()
1675 are undefined, just like for BASIC_ALLOC_LCRECORD(). 1888 are undefined, just like for ALLOC_SIZED_LISP_OBJECT().
1676 -- the mark method for the lcrecord's type will *NEVER* be called 1889 -- the mark method for the lcrecord's type will *NEVER* be called
1677 on freed lcrecords. 1890 on freed lcrecords.
1678 -- the finalize method for the lcrecord's type will be called 1891 -- the finalize method for the lcrecord's type will be called
1679 at the time that free_managed_lcrecord() is called. 1892 at the time that free_managed_lcrecord() is called.
1680 */ 1893 */
1681 1894
1682 /* UNMANAGED MODEL: */ 1895 /* UNMANAGED MODEL: */
1683 void *old_basic_alloc_lcrecord (Bytecount size, 1896 Lisp_Object old_alloc_lcrecord (const struct lrecord_implementation *);
1684 const struct lrecord_implementation *); 1897 Lisp_Object old_alloc_sized_lcrecord (Bytecount size,
1898 const struct lrecord_implementation *);
1685 1899
1686 /* HAND-MANAGED MODEL: */ 1900 /* HAND-MANAGED MODEL: */
1687 Lisp_Object make_lcrecord_list (Elemcount size, 1901 Lisp_Object make_lcrecord_list (Elemcount size,
1688 const struct lrecord_implementation 1902 const struct lrecord_implementation
1689 *implementation); 1903 *implementation);
1690 Lisp_Object alloc_managed_lcrecord (Lisp_Object lcrecord_list); 1904 Lisp_Object alloc_managed_lcrecord (Lisp_Object lcrecord_list);
1691 void free_managed_lcrecord (Lisp_Object lcrecord_list, Lisp_Object lcrecord); 1905 void free_managed_lcrecord (Lisp_Object lcrecord_list, Lisp_Object lcrecord);
1692 1906
1693 /* AUTO-MANAGED MODEL: */ 1907 /* AUTO-MANAGED MODEL: */
1694 MODULE_API void * 1908 MODULE_API Lisp_Object
1695 alloc_automanaged_lcrecord (Bytecount size, 1909 alloc_automanaged_sized_lcrecord (Bytecount size,
1696 const struct lrecord_implementation *); 1910 const struct lrecord_implementation *imp);
1697 1911 MODULE_API Lisp_Object
1698 #define old_alloc_lcrecord_type(type, lrecord_implementation) \ 1912 alloc_automanaged_lcrecord (const struct lrecord_implementation *imp);
1699 ((type *) alloc_automanaged_lcrecord (sizeof (type), lrecord_implementation)) 1913
1914 #define old_alloc_lcrecord_type(type, imp) \
1915 ((type *) XPNTR (alloc_automanaged_lcrecord (sizeof (type), imp)))
1700 1916
1701 void old_free_lcrecord (Lisp_Object rec); 1917 void old_free_lcrecord (Lisp_Object rec);
1702 1918
1703
1704 /* Copy the data from one lcrecord structure into another, but don't
1705 overwrite the header information. */
1706
1707 #define old_copy_sized_lcrecord(dst, src, size) \
1708 memcpy ((Rawbyte *) (dst) + sizeof (struct old_lcrecord_header), \
1709 (Rawbyte *) (src) + sizeof (struct old_lcrecord_header), \
1710 (size) - sizeof (struct old_lcrecord_header))
1711
1712 #define old_copy_lcrecord(dst, src) \
1713 old_copy_sized_lcrecord (dst, src, sizeof (*(dst)))
1714
1715 #define old_zero_sized_lcrecord(lcr, size) \
1716 memset ((Rawbyte *) (lcr) + sizeof (struct old_lcrecord_header), 0, \
1717 (size) - sizeof (struct old_lcrecord_header))
1718
1719 #define old_zero_lcrecord(lcr) old_zero_sized_lcrecord (lcr, sizeof (*(lcr)))
1720
1721 #else /* NEW_GC */ 1919 #else /* NEW_GC */
1722 1920
1723 /* How to allocate a lrecord: 1921 MODULE_API Lisp_Object alloc_sized_lrecord (Bytecount size,
1724 1922 const struct lrecord_implementation *imp);
1725 - If the size of the lrecord is fix, say it equals its size of its 1923 Lisp_Object noseeum_alloc_sized_lrecord (Bytecount size,
1726 struct, then use alloc_lrecord_type. 1924 const struct lrecord_implementation *imp);
1727 1925 MODULE_API Lisp_Object alloc_lrecord (const struct lrecord_implementation *imp);
1728 - If the size varies, i.e. it is not equal to the size of its 1926 Lisp_Object noseeum_alloc_lrecord (const struct lrecord_implementation *imp);
1729 struct, use alloc_lrecord and specify the amount of storage you 1927
1730 need for the object. 1928 MODULE_API Lisp_Object alloc_lrecord_array (int elemcount,
1731 1929 const struct lrecord_implementation *imp);
1732 - Some lrecords, which are used totally internally, use the 1930 MODULE_API Lisp_Object alloc_sized_lrecord_array (Bytecount size,
1733 noseeum-* functions for the reason of debugging. 1931 int elemcount,
1734 1932 const struct lrecord_implementation *imp);
1735 - To free a Lisp_Object manually, use free_lrecord. */
1736
1737 void *alloc_lrecord (Bytecount size,
1738 const struct lrecord_implementation *);
1739
1740 void *alloc_lrecord_array (Bytecount size, int elemcount,
1741 const struct lrecord_implementation *);
1742
1743 #define alloc_lrecord_type(type, lrecord_implementation) \
1744 ((type *) alloc_lrecord (sizeof (type), lrecord_implementation))
1745
1746 void *noseeum_alloc_lrecord (Bytecount size,
1747 const struct lrecord_implementation *);
1748
1749 #define noseeum_alloc_lrecord_type(type, lrecord_implementation) \
1750 ((type *) noseeum_alloc_lrecord (sizeof (type), lrecord_implementation))
1751
1752 void free_lrecord (Lisp_Object rec);
1753
1754
1755 /* Copy the data from one lrecord structure into another, but don't
1756 overwrite the header information. */
1757
1758 #define copy_sized_lrecord(dst, src, size) \
1759 memcpy ((char *) (dst) + sizeof (struct lrecord_header), \
1760 (char *) (src) + sizeof (struct lrecord_header), \
1761 (size) - sizeof (struct lrecord_header))
1762
1763 #define copy_lrecord(dst, src) copy_sized_lrecord (dst, src, sizeof (*(dst)))
1764 1933
1765 #endif /* NEW_GC */ 1934 #endif /* NEW_GC */
1766
1767 #define zero_sized_lrecord(lcr, size) \
1768 memset ((char *) (lcr) + sizeof (struct lrecord_header), 0, \
1769 (size) - sizeof (struct lrecord_header))
1770
1771 #define zero_lrecord(lcr) zero_sized_lrecord (lcr, sizeof (*(lcr)))
1772 1935
1773 DECLARE_INLINE_HEADER ( 1936 DECLARE_INLINE_HEADER (
1774 Bytecount 1937 Bytecount
1775 detagged_lisp_object_size (const struct lrecord_header *h) 1938 detagged_lisp_object_size (const struct lrecord_header *h)
1776 ) 1939 )
1777 { 1940 {
1778 const struct lrecord_implementation *imp = LHEADER_IMPLEMENTATION (h); 1941 const struct lrecord_implementation *imp = LHEADER_IMPLEMENTATION (h);
1779 1942
1780 return (imp->size_in_bytes_method ? 1943 return (imp->size_in_bytes_method ?
1781 imp->size_in_bytes_method (h) : 1944 imp->size_in_bytes_method (wrap_pointer_1 (h)) :
1782 imp->static_size); 1945 imp->static_size);
1783 } 1946 }
1784 1947
1785 DECLARE_INLINE_HEADER ( 1948 DECLARE_INLINE_HEADER (
1786 Bytecount 1949 Bytecount
1787 lisp_object_size (Lisp_Object o) 1950 lisp_object_size (Lisp_Object o)
1788 ) 1951 )
1789 { 1952 {
1790 return detagged_lisp_object_size (XRECORD_LHEADER (o)); 1953 return detagged_lisp_object_size (XRECORD_LHEADER (o));
1791 } 1954 }
1955
1956 struct overhead_stats;
1957
1958 MODULE_API void copy_lisp_object (Lisp_Object dst, Lisp_Object src);
1959 MODULE_API void zero_sized_lisp_object (Lisp_Object obj, Bytecount size);
1960 MODULE_API void zero_nonsized_lisp_object (Lisp_Object obj);
1961 #ifdef MEMORY_USAGE_STATS
1962 Bytecount lisp_object_storage_size (Lisp_Object obj,
1963 struct overhead_stats *ovstats);
1964 #endif /* MEMORY_USAGE_STATS */
1965 void free_normal_lisp_object (Lisp_Object obj);
1792 1966
1793 1967
1794 /************************************************************************/ 1968 /************************************************************************/
1795 /* Dumping */ 1969 /* Dumping */
1796 /************************************************************************/ 1970 /************************************************************************/