Mercurial > hg > xemacs-beta

comparison src/lrecord.h @ 442:abe6d1db359e r21-2-36

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-36
author cvs
date Mon, 13 Aug 2007 11:35:02 +0200
parents 8de8e3f6228a
children 576fb035e263
comparison
equal deleted inserted replaced
441:72a7cfa4a488 442:abe6d1db359e
24 #ifndef INCLUDED_lrecord_h_ 24 #ifndef INCLUDED_lrecord_h_
25 #define INCLUDED_lrecord_h_ 25 #define INCLUDED_lrecord_h_
26 26
27 /* The "lrecord" type of Lisp object is used for all object types 27 /* The "lrecord" type of Lisp object is used for all object types
28 other than a few simple ones. This allows many types to be 28 other than a few simple ones. This allows many types to be
29 implemented but only a few bits required in a Lisp object for 29 implemented but only a few bits required in a Lisp object for type
30 type information. (The tradeoff is that each object has its 30 information. (The tradeoff is that each object has its type marked
31 type marked in it, thereby increasing its size.) The first 31 in it, thereby increasing its size.) All lrecords begin with a
32 four bytes of all lrecords is either a pointer to a struct 32 `struct lrecord_header', which identifies the lisp object type, by
33 lrecord_implementation, which contains methods describing how 33 providing an index into a table of `struct lrecord_implementation',
34 to process this object, or an index into an array of pointers 34 which describes the behavior of the lisp object. It also contains
35 to struct lrecord_implementations plus some other data bits. 35 some other data bits.
36 36
37 Lrecords are of two types: straight lrecords, and lcrecords. 37 Lrecords are of two types: straight lrecords, and lcrecords.
38 Straight lrecords are used for those types of objects that have 38 Straight lrecords are used for those types of objects that have
39 their own allocation routines (typically allocated out of 2K chunks 39 their own allocation routines (typically allocated out of 2K chunks
40 of memory called `frob blocks'). These objects have a `struct 40 of memory called `frob blocks'). These objects have a `struct
41 lrecord_header' at the top, containing only the bits needed to find 41 lrecord_header' at the top, containing only the bits needed to find
42 the lrecord_implementation for the object. There are special 42 the lrecord_implementation for the object. There are special
43 routines in alloc.c to deal with each such object type. 43 routines in alloc.c to deal with each such object type.
44 44
45 Lcrecords are used for less common sorts of objects that don't 45 Lcrecords are used for less common sorts of objects that don't do
46 do their own allocation. Each such object is malloc()ed 46 their own allocation. Each such object is malloc()ed individually,
47 individually, and the objects are chained together through 47 and the objects are chained together through a `next' pointer.
48 a `next' pointer. Lcrecords have a `struct lcrecord_header' 48 Lcrecords have a `struct lcrecord_header' at the top, which
49 at the top, which contains a `struct lrecord_header' and 49 contains a `struct lrecord_header' and a `next' pointer, and are
50 a `next' pointer, and are allocated using alloc_lcrecord(). 50 allocated using alloc_lcrecord().
51 51
52 Creating a new lcrecord type is fairly easy; just follow the 52 Creating a new lcrecord type is fairly easy; just follow the
53 lead of some existing type (e.g. hash tables). Note that you 53 lead of some existing type (e.g. hash tables). Note that you
54 do not need to supply all the methods (see below); reasonable 54 do not need to supply all the methods (see below); reasonable
55 defaults are provided for many of them. Alternatively, if you're 55 defaults are provided for many of them. Alternatively, if you're
58 the opaque type. */ 58 the opaque type. */
59 59
60 struct lrecord_header 60 struct lrecord_header
61 { 61 {
62 /* index into lrecord_implementations_table[] */ 62 /* index into lrecord_implementations_table[] */
63 unsigned type :8; 63 unsigned int type :8;
64 /* 1 if the object is marked during GC. */ 64
65 unsigned mark :1; 65 /* If `mark' is 0 after the GC mark phase, the object will be freed
66 /* 1 if the object resides in read-only space */ 66 during the GC sweep phase. There are 2 ways that `mark' can be 1:
67 unsigned c_readonly : 1; 67 - by being referenced from other objects during the GC mark phase
68 - because it is permanently on, for c_readonly objects */
69 unsigned int mark :1;
70
71 /* 1 if the object resides in logically read-only space, and does not
72 reference other non-c_readonly objects.
73 Invariant: if (c_readonly == 1), then (mark == 1 && lisp_readonly == 1) */
74 unsigned int c_readonly :1;
75
68 /* 1 if the object is readonly from lisp */ 76 /* 1 if the object is readonly from lisp */
69 unsigned lisp_readonly : 1; 77 unsigned int lisp_readonly :1;
70 }; 78 };
71 79
72 struct lrecord_implementation; 80 struct lrecord_implementation;
73 int lrecord_type_index (CONST struct lrecord_implementation *implementation); 81 int lrecord_type_index (const struct lrecord_implementation *implementation);
74 82
75 #define set_lheader_implementation(header,imp) do { \ 83 #define set_lheader_implementation(header,imp) do { \
76 struct lrecord_header* SLI_header = (header); \ 84 struct lrecord_header* SLI_header = (header); \
77 SLI_header->type = lrecord_type_index (imp); \ 85 SLI_header->type = (imp)->lrecord_type_index; \
78 SLI_header->mark = 0; \ 86 SLI_header->mark = 0; \
79 SLI_header->c_readonly = 0; \ 87 SLI_header->c_readonly = 0; \
80 SLI_header->lisp_readonly = 0; \ 88 SLI_header->lisp_readonly = 0; \
81 } while (0) 89 } while (0)
82 90
83 struct lcrecord_header 91 struct lcrecord_header
84 { 92 {
85 struct lrecord_header lheader; 93 struct lrecord_header lheader;
86 94
87 /* The `next' field is normally used to chain all lrecords together 95 /* The `next' field is normally used to chain all lcrecords together
88 so that the GC can find (and free) all of them. 96 so that the GC can find (and free) all of them.
89 `alloc_lcrecord' threads records together. 97 `alloc_lcrecord' threads lcrecords together.
90 98
91 The `next' field may be used for other purposes as long as some 99 The `next' field may be used for other purposes as long as some
92 other mechanism is provided for letting the GC do its work. 100 other mechanism is provided for letting the GC do its work.
93 101
94 For example, the event and marker object types allocate members 102 For example, the event and marker object types allocate members
116 { 124 {
117 struct lcrecord_header lcheader; 125 struct lcrecord_header lcheader;
118 Lisp_Object chain; 126 Lisp_Object chain;
119 }; 127 };
120 128
121 /* see alloc.c for an explanation */ 129 enum lrecord_type
122 Lisp_Object this_one_is_unmarkable (Lisp_Object obj); 130 {
131 /* Symbol value magic types come first to make SYMBOL_VALUE_MAGIC_P fast.
132 #### This should be replaced by a symbol_value_magic_p flag
133 in the Lisp_Symbol lrecord_header. */
134 lrecord_type_symbol_value_forward,
135 lrecord_type_symbol_value_varalias,
136 lrecord_type_symbol_value_lisp_magic,
137 lrecord_type_symbol_value_buffer_local,
138 lrecord_type_max_symbol_value_magic = lrecord_type_symbol_value_buffer_local,
139
140 lrecord_type_symbol,
141 lrecord_type_subr,
142 lrecord_type_cons,
143 lrecord_type_vector,
144 lrecord_type_string,
145 lrecord_type_lcrecord_list,
146 lrecord_type_compiled_function,
147 lrecord_type_weak_list,
148 lrecord_type_bit_vector,
149 lrecord_type_float,
150 lrecord_type_hash_table,
151 lrecord_type_lstream,
152 lrecord_type_process,
153 lrecord_type_charset,
154 lrecord_type_coding_system,
155 lrecord_type_char_table,
156 lrecord_type_char_table_entry,
157 lrecord_type_range_table,
158 lrecord_type_opaque,
159 lrecord_type_opaque_ptr,
160 lrecord_type_buffer,
161 lrecord_type_extent,
162 lrecord_type_extent_info,
163 lrecord_type_extent_auxiliary,
164 lrecord_type_marker,
165 lrecord_type_event,
166 lrecord_type_keymap,
167 lrecord_type_command_builder,
168 lrecord_type_timeout,
169 lrecord_type_specifier,
170 lrecord_type_console,
171 lrecord_type_device,
172 lrecord_type_frame,
173 lrecord_type_window,
174 lrecord_type_window_configuration,
175 lrecord_type_gui_item,
176 lrecord_type_popup_data,
177 lrecord_type_toolbar_button,
178 lrecord_type_color_instance,
179 lrecord_type_font_instance,
180 lrecord_type_image_instance,
181 lrecord_type_glyph,
182 lrecord_type_face,
183 lrecord_type_database,
184 lrecord_type_tooltalk_message,
185 lrecord_type_tooltalk_pattern,
186 lrecord_type_ldap,
187 lrecord_type_pgconn,
188 lrecord_type_pgresult,
189 lrecord_type_devmode,
190 lrecord_type_mswindows_dialog_id,
191 lrecord_type_last_built_in_type /* must be last */
192 };
193
194 extern unsigned int lrecord_type_count;
123 195
124 struct lrecord_implementation 196 struct lrecord_implementation
125 { 197 {
126 CONST char *name; 198 const char *name;
127 /* This function is called at GC time, to make sure that all Lisp_Objects 199
200 /* `marker' is called at GC time, to make sure that all Lisp_Objects
128 pointed to by this object get properly marked. It should call 201 pointed to by this object get properly marked. It should call
129 the mark_object function on all Lisp_Objects in the object. If 202 the mark_object function on all Lisp_Objects in the object. If
130 the return value is non-nil, it should be a Lisp_Object to be 203 the return value is non-nil, it should be a Lisp_Object to be
131 marked (don't call the mark_object function explicitly on it, 204 marked (don't call the mark_object function explicitly on it,
132 because the GC routines will do this). Doing it this way reduces 205 because the GC routines will do this). Doing it this way reduces
133 recursion, so the object returned should preferably be the one 206 recursion, so the object returned should preferably be the one
134 with the deepest level of Lisp_Object pointers. This function 207 with the deepest level of Lisp_Object pointers. This function
135 can be NULL, meaning no GC marking is necessary. */ 208 can be NULL, meaning no GC marking is necessary. */
136 Lisp_Object (*marker) (Lisp_Object); 209 Lisp_Object (*marker) (Lisp_Object);
137 /* This can be NULL if the object is an lcrecord; the 210
138 default_object_printer() in print.c will be used. */ 211 /* `printer' converts the object to a printed representation.
212 This can be NULL; in this case default_object_printer() will be
213 used instead. */
139 void (*printer) (Lisp_Object, Lisp_Object printcharfun, int escapeflag); 214 void (*printer) (Lisp_Object, Lisp_Object printcharfun, int escapeflag);
140 /* This function is called at GC time when the object is about to 215
216 /* `finalizer' is called at GC time when the object is about to
141 be freed, and at dump time (FOR_DISKSAVE will be non-zero in this 217 be freed, and at dump time (FOR_DISKSAVE will be non-zero in this
142 case). It should perform any necessary cleanup (e.g. freeing 218 case). It should perform any necessary cleanup (e.g. freeing
143 malloc()ed memory. This can be NULL, meaning no special 219 malloc()ed memory). This can be NULL, meaning no special
144 finalization is necessary. 220 finalization is necessary.
145 221
146 WARNING: remember that the finalizer is called at dump time even 222 WARNING: remember that `finalizer' is called at dump time even
147 though the object is not being freed. */ 223 though the object is not being freed. */
148 void (*finalizer) (void *header, int for_disksave); 224 void (*finalizer) (void *header, int for_disksave);
225
149 /* This can be NULL, meaning compare objects with EQ(). */ 226 /* This can be NULL, meaning compare objects with EQ(). */
150 int (*equal) (Lisp_Object obj1, Lisp_Object obj2, int depth); 227 int (*equal) (Lisp_Object obj1, Lisp_Object obj2, int depth);
151 /* This can be NULL, meaning use the Lisp_Object itself as the hash; 228
152 but *only* if the `equal' function is EQ (if two objects are 229 /* `hash' generates hash values for use with hash tables that have
153 `equal', they *must* hash to the same value or the hashing won't 230 `equal' as their test function. This can be NULL, meaning use
154 work). */ 231 the Lisp_Object itself as the hash. But, you must still satisfy
232 the constraint that if two objects are `equal', then they *must*
233 hash to the same value in order for hash tables to work properly.
234 This means that `hash' can be NULL only if the `equal' method is
235 also NULL. */
155 unsigned long (*hash) (Lisp_Object, int); 236 unsigned long (*hash) (Lisp_Object, int);
156 237
157 /* External data layout description */ 238 /* External data layout description */
158 const struct lrecord_description *description; 239 const struct lrecord_description *description;
159 240
241 /* These functions allow any object type to have builtin property
242 lists that can be manipulated from the lisp level with
243 `get', `put', `remprop', and `object-plist'. */
160 Lisp_Object (*getprop) (Lisp_Object obj, Lisp_Object prop); 244 Lisp_Object (*getprop) (Lisp_Object obj, Lisp_Object prop);
161 int (*putprop) (Lisp_Object obj, Lisp_Object prop, Lisp_Object val); 245 int (*putprop) (Lisp_Object obj, Lisp_Object prop, Lisp_Object val);
162 int (*remprop) (Lisp_Object obj, Lisp_Object prop); 246 int (*remprop) (Lisp_Object obj, Lisp_Object prop);
163 Lisp_Object (*plist) (Lisp_Object obj); 247 Lisp_Object (*plist) (Lisp_Object obj);
164 248
165 /* Only one of these is non-0. If both are 0, it means that this type 249 /* Only one of `static_size' and `size_in_bytes_method' is non-0.
166 is not instantiable by alloc_lcrecord(). */ 250 If both are 0, this type is not instantiable by alloc_lcrecord(). */
167 size_t static_size; 251 size_t static_size;
168 size_t (*size_in_bytes_method) (CONST void *header); 252 size_t (*size_in_bytes_method) (const void *header);
169 /* A unique subtag-code (dynamically) assigned to this datatype. */ 253
170 /* (This is a pointer so the rest of this structure can be read-only.) */ 254 /* The (constant) index into lrecord_implementations_table */
171 int *lrecord_type_index; 255 enum lrecord_type lrecord_type_index;
256
172 /* A "basic" lrecord is any lrecord that's not an lcrecord, i.e. 257 /* A "basic" lrecord is any lrecord that's not an lcrecord, i.e.
173 one that does not have an lcrecord_header at the front and which 258 one that does not have an lcrecord_header at the front and which
174 is (usually) allocated in frob blocks. We only use this flag for 259 is (usually) allocated in frob blocks. We only use this flag for
175 some consistency checking, and that only when error-checking is 260 some consistency checking, and that only when error-checking is
176 enabled. */ 261 enabled. */
177 int basic_p; 262 unsigned int basic_p :1;
178 }; 263 };
179 264
180 extern CONST struct lrecord_implementation *lrecord_implementations_table[]; 265 /* All the built-in lisp object types are enumerated in `enum record_type'.
266 Additional ones may be defined by a module (none yet). We leave some
267 room in `lrecord_implementations_table' for such new lisp object types. */
268 #define MODULE_DEFINABLE_TYPE_COUNT 32
269
270 extern const struct lrecord_implementation *lrecord_implementations_table[(unsigned int)lrecord_type_last_built_in_type + MODULE_DEFINABLE_TYPE_COUNT];
181 271
182 #define XRECORD_LHEADER_IMPLEMENTATION(obj) \ 272 #define XRECORD_LHEADER_IMPLEMENTATION(obj) \
183 (lrecord_implementations_table[XRECORD_LHEADER (obj)->type]) 273 LHEADER_IMPLEMENTATION (XRECORD_LHEADER (obj))
184 #define LHEADER_IMPLEMENTATION(lh) (lrecord_implementations_table[(lh)->type]) 274 #define LHEADER_IMPLEMENTATION(lh) lrecord_implementations_table[(lh)->type]
185 275
186 extern int gc_in_progress; 276 extern int gc_in_progress;
187 277
188 #define MARKED_RECORD_P(obj) (gc_in_progress && XRECORD_LHEADER (obj)->mark) 278 #define MARKED_RECORD_P(obj) (XRECORD_LHEADER (obj)->mark)
189 #define MARKED_RECORD_HEADER_P(lheader) ((lheader)->mark) 279 #define MARKED_RECORD_HEADER_P(lheader) ((lheader)->mark)
190 #define MARK_RECORD_HEADER(lheader) ((void) ((lheader)->mark = 1)) 280 #define MARK_RECORD_HEADER(lheader) ((void) ((lheader)->mark = 1))
191 #define UNMARK_RECORD_HEADER(lheader) ((void) ((lheader)->mark = 0)) 281 #define UNMARK_RECORD_HEADER(lheader) ((void) ((lheader)->mark = 0))
192 282
193 #define UNMARKABLE_RECORD_HEADER_P(lheader) \
194 (LHEADER_IMPLEMENTATION (lheader)->marker == this_one_is_unmarkable)
195
196 #define C_READONLY_RECORD_HEADER_P(lheader) ((lheader)->c_readonly) 283 #define C_READONLY_RECORD_HEADER_P(lheader) ((lheader)->c_readonly)
197 #define LISP_READONLY_RECORD_HEADER_P(lheader) ((lheader)->lisp_readonly) 284 #define LISP_READONLY_RECORD_HEADER_P(lheader) ((lheader)->lisp_readonly)
198 #define SET_C_READONLY_RECORD_HEADER(lheader) \ 285 #define SET_C_READONLY_RECORD_HEADER(lheader) do { \
199 ((void) ((lheader)->c_readonly = (lheader)->lisp_readonly = 1)) 286 struct lrecord_header *SCRRH_lheader = (lheader); \
287 SCRRH_lheader->c_readonly = 1; \
288 SCRRH_lheader->lisp_readonly = 1; \
289 SCRRH_lheader->mark = 1; \
290 } while (0)
200 #define SET_LISP_READONLY_RECORD_HEADER(lheader) \ 291 #define SET_LISP_READONLY_RECORD_HEADER(lheader) \
201 ((void) ((lheader)->lisp_readonly = 1)) 292 ((void) ((lheader)->lisp_readonly = 1))
293 #define RECORD_MARKER(lheader) lrecord_markers[(lheader)->type]
202 294
203 /* External description stuff 295 /* External description stuff
204 296
205 A lrecord external description is an array of values. The first 297 A lrecord external description is an array of values. The first
206 value of each line is a type, the second the offset in the lrecord 298 value of each line is a type, the second the offset in the lrecord
207 structure. Following values are parameters, their presence, type 299 structure. Following values are parameters, their presence, type
208 and number is type-dependant. 300 and number is type-dependent.
209 301
210 The description ends with a "XD_END" or "XD_SPECIFIER_END" record. 302 The description ends with a "XD_END" or "XD_SPECIFIER_END" record.
211 303
212 Some example descriptions : 304 Some example descriptions :
213 305
234 326
235 XD_LISP_OBJECT_ARRAY 327 XD_LISP_OBJECT_ARRAY
236 An array of Lisp objects or pointers to lrecords. 328 An array of Lisp objects or pointers to lrecords.
237 The third element is the count. 329 The third element is the count.
238 330
239 XD_LO_RESET_NIL 331 XD_LO_RESET_NIL
240 Lisp objects which will be reset to Qnil when dumping. Useful for cleaning 332 Lisp objects which will be reset to Qnil when dumping. Useful for cleaning
241 up caches. 333 up caches.
242 334
243 XD_LO_LINK 335 XD_LO_LINK
244 Link in a linked list of objects of the same type. 336 Link in a linked list of objects of the same type.
331 #define XD_DYNARR_DESC(base_type, sub_desc) \ 423 #define XD_DYNARR_DESC(base_type, sub_desc) \
332 { XD_STRUCT_PTR, offsetof (base_type, base), XD_INDIRECT(1, 0), sub_desc }, \ 424 { XD_STRUCT_PTR, offsetof (base_type, base), XD_INDIRECT(1, 0), sub_desc }, \
333 { XD_INT, offsetof (base_type, cur) }, \ 425 { XD_INT, offsetof (base_type, cur) }, \
334 { XD_INT_RESET, offsetof (base_type, max), XD_INDIRECT(1, 0) } 426 { XD_INT_RESET, offsetof (base_type, max), XD_INDIRECT(1, 0) }
335 427
336 /* Declaring the following structures as const puts them in the
337 text (read-only) segment, which makes debugging inconvenient
338 because this segment is not mapped when processing a core-
339 dump file */
340
341 #ifdef DEBUG_XEMACS
342 #define CONST_IF_NOT_DEBUG
343 #else
344 #define CONST_IF_NOT_DEBUG CONST
345 #endif
346
347 /* DEFINE_LRECORD_IMPLEMENTATION is for objects with constant size. 428 /* DEFINE_LRECORD_IMPLEMENTATION is for objects with constant size.
348 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION is for objects whose size varies. 429 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION is for objects whose size varies.
349 */ 430 */
350 431
351 #if defined (ERROR_CHECK_TYPECHECK) 432 #if defined (ERROR_CHECK_TYPECHECK)
355 #endif 436 #endif
356 437
357 #define DEFINE_BASIC_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \ 438 #define DEFINE_BASIC_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \
358 DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype) 439 DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype)
359 440
360 #define DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,props,structtype) \ 441 #define DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \
361 MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,props,sizeof(structtype),0,1,structtype) 442 MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof(structtype),0,1,structtype)
362 443
363 #define DEFINE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \ 444 #define DEFINE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \
364 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype) 445 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype)
365 446
366 #define DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,props,structtype) \ 447 #define DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \
367 MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,props,sizeof (structtype),0,0,structtype) 448 MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof (structtype),0,0,structtype)
368 449
369 #define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \ 450 #define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \
370 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,sizer,structtype) 451 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,sizer,structtype)
371 452
372 #define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,props,sizer,structtype) \ 453 #define DEFINE_BASIC_LRECORD_SEQUENCE_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \
373 MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,props,0,sizer,0,structtype) \ 454 MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,sizer,1,structtype)
374 455
375 #define MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,props,size,sizer,basic_p,structtype) \ 456 #define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizer,structtype) \
457 MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,0,sizer,0,structtype) \
458
459 #define MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \
376 DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype) \ 460 DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype) \
377 static int lrecord_##c_name##_lrecord_type_index; \ 461 const struct lrecord_implementation lrecord_##c_name = \
378 CONST_IF_NOT_DEBUG struct lrecord_implementation lrecord_##c_name = \
379 { name, marker, printer, nuker, equal, hash, desc, \ 462 { name, marker, printer, nuker, equal, hash, desc, \
380 getprop, putprop, remprop, props, size, sizer, \ 463 getprop, putprop, remprop, plist, size, sizer, \
381 &(lrecord_##c_name##_lrecord_type_index), basic_p } \ 464 lrecord_type_##c_name, basic_p }
465
466 #define DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \
467 DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype)
468
469 #define DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \
470 MAKE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof (structtype),0,0,structtype)
471
472 #define DEFINE_EXTERNAL_LRECORD_SEQUENCE_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \
473 DEFINE_EXTERNAL_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,sizer,structtype)
474
475 #define DEFINE_EXTERNAL_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizer,structtype) \
476 MAKE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,0,sizer,0,structtype)
477
478 #define MAKE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \
479 DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype) \
480 unsigned int lrecord_type_##c_name = lrecord_type_count++; \
481 const struct lrecord_implementation lrecord_##c_name = \
482 { name, marker, printer, nuker, equal, hash, desc, \
483 getprop, putprop, remprop, plist, size, sizer, \
484 (enum lrecord_type)lrecord_type_##c_name, basic_p }
485
486
487 extern Lisp_Object (*lrecord_markers[]) (Lisp_Object);
488
489 #define INIT_LRECORD_IMPLEMENTATION(type) do { \
490 lrecord_implementations_table[lrecord_type_##type] = &lrecord_##type; \
491 lrecord_markers[lrecord_type_##type] = \
492 lrecord_implementations_table[lrecord_type_##type]->marker; \
493 } while (0)
382 494
383 #define LRECORDP(a) (XTYPE (a) == Lisp_Type_Record) 495 #define LRECORDP(a) (XTYPE (a) == Lisp_Type_Record)
384 #define XRECORD_LHEADER(a) ((struct lrecord_header *) XPNTR (a)) 496 #define XRECORD_LHEADER(a) ((struct lrecord_header *) XPNTR (a))
385 497
386 #define RECORD_TYPEP(x, ty) \ 498 #define RECORD_TYPEP(x, ty) \
387 (LRECORDP (x) && \ 499 (LRECORDP (x) && (((unsigned int)(XRECORD_LHEADER (x)->type)) == ((unsigned int)(ty))))
388 lrecord_implementations_table[XRECORD_LHEADER (x)->type] == (ty)) 500
389 501 /* Steps to create a new object:
390 /* NOTE: the DECLARE_LRECORD() must come before the associated 502
391 DEFINE_LRECORD_*() or you will get compile errors. 503 1. Declare the struct for your object in a header file somewhere.
392 504 Remember that it must begin with
393 Furthermore, you always need to put the DECLARE_LRECORD() in a header 505
394 file, and make sure the header file is included in inline.c, even 506 struct lcrecord_header header;
395 if the type is private to a particular file. Otherwise, you will 507
396 get undefined references for the error_check_foo() inline function 508 2. Put a DECLARE_LRECORD() for the object below the struct definition,
397 under GCC. */ 509 along with the standard XFOO/XSETFOO junk.
510
511 3. Add this header file to inline.c.
512
513 4. Create the methods for your object. Note that technically you don't
514 need any, but you will almost always want at least a mark method.
515
516 5. Define your object with DEFINE_LRECORD_IMPLEMENTATION() or some
517 variant.
518
519 6. Include the header file in the .c file where you defined the object.
520
521 7. Put a call to INIT_LRECORD_IMPLEMENTATION() for the object in the
522 .c file's syms_of_foo() function.
523
524 8. Add a type enum for the object to enum lrecord_type, earlier in this
525 file.
526
527 An example:
528
529 ------------------------------ in toolbar.h -----------------------------
530
531 struct toolbar_button
532 {
533 struct lcrecord_header header;
534
535 Lisp_Object next;
536 Lisp_Object frame;
537
538 Lisp_Object up_glyph;
539 Lisp_Object down_glyph;
540 Lisp_Object disabled_glyph;
541
542 Lisp_Object cap_up_glyph;
543 Lisp_Object cap_down_glyph;
544 Lisp_Object cap_disabled_glyph;
545
546 Lisp_Object callback;
547 Lisp_Object enabled_p;
548 Lisp_Object help_string;
549
550 char enabled;
551 char down;
552 char pushright;
553 char blank;
554
555 int x, y;
556 int width, height;
557 int dirty;
558 int vertical;
559 int border_width;
560 };
561
562 DECLARE_LRECORD (toolbar_button, struct toolbar_button);
563 #define XTOOLBAR_BUTTON(x) XRECORD (x, toolbar_button, struct toolbar_button)
564 #define XSETTOOLBAR_BUTTON(x, p) XSETRECORD (x, p, toolbar_button)
565 #define TOOLBAR_BUTTONP(x) RECORDP (x, toolbar_button)
566 #define CHECK_TOOLBAR_BUTTON(x) CHECK_RECORD (x, toolbar_button)
567 #define CONCHECK_TOOLBAR_BUTTON(x) CONCHECK_RECORD (x, toolbar_button)
568
569 ------------------------------ in toolbar.c -----------------------------
570
571 #include "toolbar.h"
572
573 ...
574
575 static Lisp_Object
576 mark_toolbar_button (Lisp_Object obj)
577 {
578 struct toolbar_button *data = XTOOLBAR_BUTTON (obj);
579 mark_object (data->next);
580 mark_object (data->frame);
581 mark_object (data->up_glyph);
582 mark_object (data->down_glyph);
583 mark_object (data->disabled_glyph);
584 mark_object (data->cap_up_glyph);
585 mark_object (data->cap_down_glyph);
586 mark_object (data->cap_disabled_glyph);
587 mark_object (data->callback);
588 mark_object (data->enabled_p);
589 return data->help_string;
590 }
591
592 DEFINE_LRECORD_IMPLEMENTATION ("toolbar-button", toolbar_button,
593 mark_toolbar_button, 0, 0, 0, 0, 0,
594 struct toolbar_button);
595
596 ...
597
598 void
599 syms_of_toolbar (void)
600 {
601 INIT_LRECORD_IMPLEMENTATION (toolbar_button);
602
603 ...;
604 }
605
606 ------------------------------ in inline.c -----------------------------
607
608 #ifdef HAVE_TOOLBARS
609 #include "toolbar.h"
610 #endif
611
612 ------------------------------ in lrecord.h -----------------------------
613
614 enum lrecord_type
615 {
616 ...
617 lrecord_type_toolbar_button,
618 ...
619 };
620
621 */
622
623 /*
624
625 Note: Object types defined in external dynamically-loaded modules (not
626 part of the XEmacs main source code) should use DECLARE_EXTERNAL_LRECORD
627 and DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION rather than DECLARE_LRECORD
628 and DEFINE_LRECORD_IMPLEMENTATION.
629
630 */
631
398 632
399 #ifdef ERROR_CHECK_TYPECHECK 633 #ifdef ERROR_CHECK_TYPECHECK
400 634
401 # define DECLARE_LRECORD(c_name, structtype) \ 635 # define DECLARE_LRECORD(c_name, structtype) \
402 extern CONST_IF_NOT_DEBUG struct lrecord_implementation \ 636 extern const struct lrecord_implementation lrecord_##c_name; \
403 lrecord_##c_name; \ 637 INLINE_HEADER structtype * \
404 INLINE structtype *error_check_##c_name (Lisp_Object obj); \ 638 error_check_##c_name (Lisp_Object obj); \
405 INLINE structtype * \ 639 INLINE_HEADER structtype * \
406 error_check_##c_name (Lisp_Object obj) \ 640 error_check_##c_name (Lisp_Object obj) \
407 { \ 641 { \
408 assert (RECORD_TYPEP (obj, &lrecord_##c_name)); \ 642 assert (RECORD_TYPEP (obj, lrecord_type_##c_name)); \
409 return (structtype *) XPNTR (obj); \ 643 return (structtype *) XPNTR (obj); \
410 } \ 644 } \
411 extern Lisp_Object Q##c_name##p 645 extern Lisp_Object Q##c_name##p
412 646
647 # define DECLARE_EXTERNAL_LRECORD(c_name, structtype) \
648 extern unsigned int lrecord_type_##c_name; \
649 DECLARE_LRECORD(c_name, structtype)
650
413 # define DECLARE_NONRECORD(c_name, type_enum, structtype) \ 651 # define DECLARE_NONRECORD(c_name, type_enum, structtype) \
414 INLINE structtype *error_check_##c_name (Lisp_Object obj); \ 652 INLINE_HEADER structtype * \
415 INLINE structtype * \ 653 error_check_##c_name (Lisp_Object obj); \
654 INLINE_HEADER structtype * \
416 error_check_##c_name (Lisp_Object obj) \ 655 error_check_##c_name (Lisp_Object obj) \
417 { \ 656 { \
418 assert (XTYPE (obj) == type_enum); \ 657 assert (XTYPE (obj) == type_enum); \
419 return (structtype *) XPNTR (obj); \ 658 return (structtype *) XPNTR (obj); \
420 } \ 659 } \
423 # define XRECORD(x, c_name, structtype) error_check_##c_name (x) 662 # define XRECORD(x, c_name, structtype) error_check_##c_name (x)
424 # define XNONRECORD(x, c_name, type_enum, structtype) error_check_##c_name (x) 663 # define XNONRECORD(x, c_name, type_enum, structtype) error_check_##c_name (x)
425 664
426 # define XSETRECORD(var, p, c_name) do \ 665 # define XSETRECORD(var, p, c_name) do \
427 { \ 666 { \
428 XSETOBJ (var, Lisp_Type_Record, p); \ 667 XSETOBJ (var, p); \
429 assert (RECORD_TYPEP (var, &lrecord_##c_name)); \ 668 assert (RECORD_TYPEP (var, lrecord_type_##c_name)); \
430 } while (0) 669 } while (0)
431 670
432 #else /* not ERROR_CHECK_TYPECHECK */ 671 #else /* not ERROR_CHECK_TYPECHECK */
433 672
434 # define DECLARE_LRECORD(c_name, structtype) \ 673 # define DECLARE_LRECORD(c_name, structtype) \
435 extern Lisp_Object Q##c_name##p; \ 674 extern Lisp_Object Q##c_name##p; \
436 extern CONST_IF_NOT_DEBUG struct lrecord_implementation \ 675 extern const struct lrecord_implementation lrecord_##c_name
437 lrecord_##c_name 676 # define DECLARE_EXTERNAL_LRECORD(c_name, structtype) \
677 extern Lisp_Object Q##c_name##p; \
678 extern unsigned int lrecord_type_##c_name; \
679 extern const struct lrecord_implementation lrecord_##c_name
438 # define DECLARE_NONRECORD(c_name, type_enum, structtype) \ 680 # define DECLARE_NONRECORD(c_name, type_enum, structtype) \
439 extern Lisp_Object Q##c_name##p 681 extern Lisp_Object Q##c_name##p
440 # define XRECORD(x, c_name, structtype) ((structtype *) XPNTR (x)) 682 # define XRECORD(x, c_name, structtype) ((structtype *) XPNTR (x))
441 # define XNONRECORD(x, c_name, type_enum, structtype) \ 683 # define XNONRECORD(x, c_name, type_enum, structtype) \
442 ((structtype *) XPNTR (x)) 684 ((structtype *) XPNTR (x))
443 # define XSETRECORD(var, p, c_name) XSETOBJ (var, Lisp_Type_Record, p) 685 # define XSETRECORD(var, p, c_name) XSETOBJ (var, p)
444 686
445 #endif /* not ERROR_CHECK_TYPECHECK */ 687 #endif /* not ERROR_CHECK_TYPECHECK */
446 688
447 #define RECORDP(x, c_name) RECORD_TYPEP (x, &lrecord_##c_name) 689 #define RECORDP(x, c_name) RECORD_TYPEP (x, lrecord_type_##c_name)
448 690
449 /* Note: we now have two different kinds of type-checking macros. 691 /* Note: we now have two different kinds of type-checking macros.
450 The "old" kind has now been renamed CONCHECK_foo. The reason for 692 The "old" kind has now been renamed CONCHECK_foo. The reason for
451 this is that the CONCHECK_foo macros signal a continuable error, 693 this is that the CONCHECK_foo macros signal a continuable error,
452 allowing the user (through debug-on-error) to substitute a different 694 allowing the user (through debug-on-error) to substitute a different
468 710
469 FSF Emacs does not have this problem because RMS took the cheesy 711 FSF Emacs does not have this problem because RMS took the cheesy
470 way out and disabled returning from a signal entirely. */ 712 way out and disabled returning from a signal entirely. */
471 713
472 #define CONCHECK_RECORD(x, c_name) do { \ 714 #define CONCHECK_RECORD(x, c_name) do { \
473 if (!RECORD_TYPEP (x, &lrecord_##c_name)) \ 715 if (!RECORD_TYPEP (x, lrecord_type_##c_name)) \
474 x = wrong_type_argument (Q##c_name##p, x); \ 716 x = wrong_type_argument (Q##c_name##p, x); \
475 } while (0) 717 } while (0)
476 #define CONCHECK_NONRECORD(x, lisp_enum, predicate) do {\ 718 #define CONCHECK_NONRECORD(x, lisp_enum, predicate) do {\
477 if (XTYPE (x) != lisp_enum) \ 719 if (XTYPE (x) != lisp_enum) \
478 x = wrong_type_argument (predicate, x); \ 720 x = wrong_type_argument (predicate, x); \
479 } while (0) 721 } while (0)
480 #define CHECK_RECORD(x, c_name) do { \ 722 #define CHECK_RECORD(x, c_name) do { \
481 if (!RECORD_TYPEP (x, &lrecord_##c_name)) \ 723 if (!RECORD_TYPEP (x, lrecord_type_##c_name)) \
482 dead_wrong_type_argument (Q##c_name##p, x); \ 724 dead_wrong_type_argument (Q##c_name##p, x); \
483 } while (0) 725 } while (0)
484 #define CHECK_NONRECORD(x, lisp_enum, predicate) do { \ 726 #define CHECK_NONRECORD(x, lisp_enum, predicate) do { \
485 if (XTYPE (x) != lisp_enum) \ 727 if (XTYPE (x) != lisp_enum) \
486 dead_wrong_type_argument (predicate, x); \ 728 dead_wrong_type_argument (predicate, x); \
487 } while (0) 729 } while (0)
488 730
489 void *alloc_lcrecord (size_t size, CONST struct lrecord_implementation *); 731 void *alloc_lcrecord (size_t size, const struct lrecord_implementation *);
490 732
491 #define alloc_lcrecord_type(type, lrecord_implementation) \ 733 #define alloc_lcrecord_type(type, lrecord_implementation) \
492 ((type *) alloc_lcrecord (sizeof (type), lrecord_implementation)) 734 ((type *) alloc_lcrecord (sizeof (type), lrecord_implementation))
493 735
494 /* Copy the data from one lcrecord structure into another, but don't 736 /* Copy the data from one lcrecord structure into another, but don't