comparison src/lrecord.h @ 5118:e0db3c197671 ben-lisp-object

merge up to latest default branch, doesn't compile yet
author Ben Wing <ben@xemacs.org>
date Sat, 26 Dec 2009 21:18:49 -0600
parents 3742ea8250b5 8f1ee2d15784
children d1247f3cc363
comparison
equal deleted inserted replaced
5117:3742ea8250b5 5118:e0db3c197671
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 Ben Wing. 3 Copyright (C) 1996, 2001, 2002, 2004, 2005, 2009 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 #ifdef MC_ALLOC 29 #ifdef NEW_GC
30 /* The "lrecord" type of Lisp object is used for all object types 30 /* The "lrecord" type of Lisp object is used for all object types
31 other than a few simple ones (like char and int). This allows many 31 other than a few simple ones (like char and int). This allows many
32 types to be implemented but only a few bits required in a Lisp 32 types to be implemented but only a few bits required in a Lisp
33 object for type information. (The tradeoff is that each object has 33 object for type information. (The tradeoff is that each object has
34 its type marked in it, thereby increasing its size.) All lrecords 34 its type marked in it, thereby increasing its size.) All lrecords
43 defaults are provided for many of them. Alternatively, if you're 43 defaults are provided for many of them. Alternatively, if you're
44 just looking for a way of encapsulating data (which possibly 44 just looking for a way of encapsulating data (which possibly
45 could contain Lisp_Objects in it), you may well be able to use 45 could contain Lisp_Objects in it), you may well be able to use
46 the opaque type. 46 the opaque type.
47 */ 47 */
48 #else /* not MC_ALLOC */ 48 #else /* not NEW_GC */
49 /* The "lrecord" type of Lisp object is used for all object types 49 /* The "lrecord" type of Lisp object is used for all object types
50 other than a few simple ones. This allows many types to be 50 other than a few simple ones. This allows many types to be
51 implemented but only a few bits required in a Lisp object for type 51 implemented but only a few bits required in a Lisp object for type
52 information. (The tradeoff is that each object has its type marked 52 information. (The tradeoff is that each object has its type marked
53 in it, thereby increasing its size.) All lrecords begin with a 53 in it, thereby increasing its size.) All lrecords begin with a
77 defaults are provided for many of them. Alternatively, if you're 77 defaults are provided for many of them. Alternatively, if you're
78 just looking for a way of encapsulating data (which possibly 78 just looking for a way of encapsulating data (which possibly
79 could contain Lisp_Objects in it), you may well be able to use 79 could contain Lisp_Objects in it), you may well be able to use
80 the opaque type. --ben 80 the opaque type. --ben
81 */ 81 */
82 #endif /* not MC_ALLOC */ 82 #endif /* not NEW_GC */
83 83
84 #ifdef MC_ALLOC 84 #ifdef NEW_GC
85 #define ALLOC_LISP_OBJECT(type) alloc_lrecord (&lrecord_##type) 85 #define ALLOC_LISP_OBJECT(type) alloc_lrecord (&lrecord_##type)
86 #define ALLOC_SIZED_LISP_OBJECT(size, type) \ 86 #define ALLOC_SIZED_LISP_OBJECT(size, type) \
87 alloc_sized_lrecord (size, &lrecord_##type) 87 alloc_sized_lrecord (size, &lrecord_##type)
88 #define ALLOC_LCRECORD_TYPE alloc_lrecord_type
89 #define COPY_SIZED_LCRECORD copy_sized_lrecord 88 #define COPY_SIZED_LCRECORD copy_sized_lrecord
90 #define COPY_LCRECORD copy_lrecord 89 #define COPY_LCRECORD copy_lrecord
91 #define LISPOBJ_STORAGE_SIZE(ptr, size, stats) \ 90 #define LISPOBJ_STORAGE_SIZE(ptr, size, stats) \
92 mc_alloced_storage_size (size, stats) 91 mc_alloced_storage_size (size, stats)
93 #define ZERO_LCRECORD zero_lrecord 92 #define ZERO_LCRECORD zero_lrecord
94 #define LCRECORD_HEADER lrecord_header 93 #define LCRECORD_HEADER lrecord_header
95 #define FREE_LCRECORD free_lrecord 94 #define FREE_LCRECORD free_lrecord
96 #else 95 #else /* not NEW_GC */
97 #define ALLOC_LISP_OBJECT(type) alloc_lcrecord (&lrecord_##type) 96 #define ALLOC_LISP_OBJECT(type) alloc_automanaged_lcrecord (&lrecord_##type)
98 #define ALLOC_SIZED_LISP_OBJECT(size, type) \ 97 #define ALLOC_SIZED_LISP_OBJECT(size, type) \
99 old_alloc_sized_lcrecord (size, &lrecord_##type) 98 old_alloc_sized_lcrecord (size, &lrecord_##type)
100 #define ALLOC_LCRECORD_TYPE old_alloc_lcrecord_type
101 #define COPY_SIZED_LCRECORD old_copy_sized_lcrecord 99 #define COPY_SIZED_LCRECORD old_copy_sized_lcrecord
102 #define COPY_LCRECORD old_copy_lcrecord 100 #define COPY_LCRECORD old_copy_lcrecord
103 #define LISPOBJ_STORAGE_SIZE malloced_storage_size 101 #define LISPOBJ_STORAGE_SIZE malloced_storage_size
104 #define ZERO_LCRECORD old_zero_lcrecord 102 #define ZERO_LCRECORD old_zero_lcrecord
105 #define LCRECORD_HEADER old_lcrecord_header 103 #define LCRECORD_HEADER old_lcrecord_header
106 #define FREE_LCRECORD old_free_lcrecord 104 #define FREE_LCRECORD old_free_lcrecord
107 #endif 105 #endif /* not NEW_GC */
108 106
109 BEGIN_C_DECLS 107 BEGIN_C_DECLS
110 108
111 struct lrecord_header 109 struct lrecord_header
112 { 110 {
113 /* Index into lrecord_implementations_table[]. Objects that have been 111 /* Index into lrecord_implementations_table[]. Objects that have been
114 explicitly freed using e.g. free_cons() have lrecord_type_free in this 112 explicitly freed using e.g. free_cons() have lrecord_type_free in this
115 field. */ 113 field. */
116 unsigned int type :8; 114 unsigned int type :8;
117 115
118 #ifdef MC_ALLOC 116 #ifdef NEW_GC
119 /* 1 if the object is readonly from lisp */ 117 /* 1 if the object is readonly from lisp */
120 unsigned int lisp_readonly :1; 118 unsigned int lisp_readonly :1;
121 119
122 /* The `free' field is a flag that indicates whether this lrecord 120 /* The `free' field is a flag that indicates whether this lrecord
123 is currently free or not. This is used for error checking and 121 is currently free or not. This is used for error checking and
127 /* The `uid' field is just for debugging/printing convenience. Having 125 /* The `uid' field is just for debugging/printing convenience. Having
128 this slot doesn't hurt us spacewise, since the bits are unused 126 this slot doesn't hurt us spacewise, since the bits are unused
129 anyway. (The bits are used for strings, though.) */ 127 anyway. (The bits are used for strings, though.) */
130 unsigned int uid :22; 128 unsigned int uid :22;
131 129
132 #else /* not MC_ALLOC */ 130 #else /* not NEW_GC */
133 /* If `mark' is 0 after the GC mark phase, the object will be freed 131 /* If `mark' is 0 after the GC mark phase, the object will be freed
134 during the GC sweep phase. There are 2 ways that `mark' can be 1: 132 during the GC sweep phase. There are 2 ways that `mark' can be 1:
135 - by being referenced from other objects during the GC mark phase 133 - by being referenced from other objects during the GC mark phase
136 - because it is permanently on, for c_readonly objects */ 134 - because it is permanently on, for c_readonly objects */
137 unsigned int mark :1; 135 unsigned int mark :1;
147 /* The `uid' field is just for debugging/printing convenience. Having 145 /* The `uid' field is just for debugging/printing convenience. Having
148 this slot doesn't hurt us spacewise, since the bits are unused 146 this slot doesn't hurt us spacewise, since the bits are unused
149 anyway. (The bits are used for strings, though.) */ 147 anyway. (The bits are used for strings, though.) */
150 unsigned int uid :21; 148 unsigned int uid :21;
151 149
152 #endif /* not MC_ALLOC */ 150 #endif /* not NEW_GC */
153 }; 151 };
154 152
155 struct lrecord_implementation; 153 struct lrecord_implementation;
156 int lrecord_type_index (const struct lrecord_implementation *implementation); 154 int lrecord_type_index (const struct lrecord_implementation *implementation);
157 extern int lrecord_uid_counter; 155 extern int lrecord_uid_counter;
158 156
159 #ifdef MC_ALLOC 157 #ifdef NEW_GC
160 #define set_lheader_implementation(header,imp) do { \ 158 #define set_lheader_implementation(header,imp) do { \
161 struct lrecord_header* SLI_header = (header); \ 159 struct lrecord_header* SLI_header = (header); \
162 SLI_header->type = (imp)->lrecord_type_index; \ 160 SLI_header->type = (imp)->lrecord_type_index; \
163 SLI_header->lisp_readonly = 0; \ 161 SLI_header->lisp_readonly = 0; \
164 SLI_header->free = 0; \ 162 SLI_header->free = 0; \
165 SLI_header->uid = lrecord_uid_counter++; \ 163 SLI_header->uid = lrecord_uid_counter++; \
166 } while (0) 164 } while (0)
167 #else /* not MC_ALLOC */ 165 #else /* not NEW_GC */
168 #define set_lheader_implementation(header,imp) do { \ 166 #define set_lheader_implementation(header,imp) do { \
169 struct lrecord_header* SLI_header = (header); \ 167 struct lrecord_header* SLI_header = (header); \
170 SLI_header->type = (imp)->lrecord_type_index; \ 168 SLI_header->type = (imp)->lrecord_type_index; \
171 SLI_header->mark = 0; \ 169 SLI_header->mark = 0; \
172 SLI_header->c_readonly = 0; \ 170 SLI_header->c_readonly = 0; \
173 SLI_header->lisp_readonly = 0; \ 171 SLI_header->lisp_readonly = 0; \
174 SLI_header->uid = lrecord_uid_counter++; \ 172 SLI_header->uid = lrecord_uid_counter++; \
175 } while (0) 173 } while (0)
176 #endif /* not MC_ALLOC */ 174 #endif /* not NEW_GC */
177 175
178 #ifndef MC_ALLOC 176 #ifndef NEW_GC
179 struct old_lcrecord_header 177 struct old_lcrecord_header
180 { 178 {
181 struct lrecord_header lheader; 179 struct lrecord_header lheader;
182 180
183 /* The `next' field is normally used to chain all lcrecords together 181 /* The `next' field is normally used to chain all lcrecords together
211 struct free_lcrecord_header 209 struct free_lcrecord_header
212 { 210 {
213 struct old_lcrecord_header lcheader; 211 struct old_lcrecord_header lcheader;
214 Lisp_Object chain; 212 Lisp_Object chain;
215 }; 213 };
216 #endif /* not MC_ALLOC */ 214 #endif /* not NEW_GC */
217 215
216 /* DON'T FORGET to update .gdbinit.in if you change this list. */
218 enum lrecord_type 217 enum lrecord_type
219 { 218 {
220 /* Symbol value magic types come first to make SYMBOL_VALUE_MAGIC_P fast. 219 /* Symbol value magic types come first to make SYMBOL_VALUE_MAGIC_P fast.
221 #### This should be replaced by a symbol_value_magic_p flag 220 #### This should be replaced by a symbol_value_magic_p flag
222 in the Lisp_Symbol lrecord_header. */ 221 in the Lisp_Symbol lrecord_header. */
223 lrecord_type_symbol_value_forward, /* 0 */ 222 lrecord_type_symbol_value_forward, /* 0 */
224 lrecord_type_symbol_value_varalias, /* 1 */ 223 lrecord_type_symbol_value_varalias,
225 lrecord_type_symbol_value_lisp_magic, /* 2 */ 224 lrecord_type_symbol_value_lisp_magic,
226 lrecord_type_symbol_value_buffer_local, /* 3 */ 225 lrecord_type_symbol_value_buffer_local,
227 lrecord_type_max_symbol_value_magic = lrecord_type_symbol_value_buffer_local, 226 lrecord_type_max_symbol_value_magic = lrecord_type_symbol_value_buffer_local,
228 lrecord_type_symbol, /* 4 */ 227 lrecord_type_symbol,
229 lrecord_type_subr, /* 5 */ 228 lrecord_type_subr,
230 lrecord_type_cons, /* 6 */ 229 lrecord_type_multiple_value,
231 lrecord_type_vector, /* 7 */ 230 lrecord_type_cons,
232 lrecord_type_string, /* 8 */ 231 lrecord_type_vector,
233 #ifndef MC_ALLOC 232 lrecord_type_string,
233 #ifndef NEW_GC
234 lrecord_type_lcrecord_list, 234 lrecord_type_lcrecord_list,
235 #endif /* not MC_ALLOC */ 235 #endif /* not NEW_GC */
236 lrecord_type_compiled_function, /* 9 */ 236 lrecord_type_compiled_function,
237 lrecord_type_weak_list, /* 10 */ 237 lrecord_type_weak_list,
238 lrecord_type_bit_vector, /* 11 */ 238 lrecord_type_bit_vector,
239 lrecord_type_float, /* 12 */ 239 lrecord_type_float,
240 lrecord_type_hash_table, /* 13 */ 240 lrecord_type_hash_table,
241 lrecord_type_lstream, /* 14 */ 241 lrecord_type_lstream,
242 lrecord_type_process, /* 15 */ 242 lrecord_type_process,
243 lrecord_type_charset, /* 16 */ 243 lrecord_type_charset,
244 lrecord_type_coding_system, /* 17 */ 244 lrecord_type_coding_system,
245 lrecord_type_char_table, /* 18 */ 245 lrecord_type_char_table,
246 lrecord_type_char_table_entry, /* 19 */ 246 lrecord_type_char_table_entry,
247 lrecord_type_range_table, /* 20 */ 247 lrecord_type_range_table,
248 lrecord_type_opaque, /* 21 */ 248 lrecord_type_opaque,
249 lrecord_type_opaque_ptr, /* 22 */ 249 lrecord_type_opaque_ptr,
250 lrecord_type_buffer, /* 23 */ 250 lrecord_type_buffer,
251 lrecord_type_extent, /* 24 */ 251 lrecord_type_extent,
252 lrecord_type_extent_info, /* 25 */ 252 lrecord_type_extent_info,
253 lrecord_type_extent_auxiliary, /* 26 */ 253 lrecord_type_extent_auxiliary,
254 lrecord_type_marker, /* 27 */ 254 lrecord_type_marker,
255 lrecord_type_event, /* 28 */ 255 lrecord_type_event,
256 #ifdef EVENT_DATA_AS_OBJECTS /* not defined */ 256 #ifdef EVENT_DATA_AS_OBJECTS /* not defined */
257 lrecord_type_key_data, 257 lrecord_type_key_data,
258 lrecord_type_button_data, 258 lrecord_type_button_data,
259 lrecord_type_motion_data, 259 lrecord_type_motion_data,
260 lrecord_type_process_data, 260 lrecord_type_process_data,
262 lrecord_type_eval_data, 262 lrecord_type_eval_data,
263 lrecord_type_misc_user_data, 263 lrecord_type_misc_user_data,
264 lrecord_type_magic_eval_data, 264 lrecord_type_magic_eval_data,
265 lrecord_type_magic_data, 265 lrecord_type_magic_data,
266 #endif /* EVENT_DATA_AS_OBJECTS */ 266 #endif /* EVENT_DATA_AS_OBJECTS */
267 lrecord_type_keymap, /* 29 */ 267 lrecord_type_keymap,
268 lrecord_type_command_builder, /* 30 */ 268 lrecord_type_command_builder,
269 lrecord_type_timeout, /* 31 */ 269 lrecord_type_timeout,
270 lrecord_type_specifier, /* 32 */ 270 lrecord_type_specifier,
271 lrecord_type_console, /* 33 */ 271 lrecord_type_console,
272 lrecord_type_device, /* 34 */ 272 lrecord_type_device,
273 lrecord_type_frame, /* 35 */ 273 lrecord_type_frame,
274 lrecord_type_window, /* 36 */ 274 lrecord_type_window,
275 lrecord_type_window_mirror, /* 37 */ 275 lrecord_type_window_mirror,
276 lrecord_type_window_configuration, /* 38 */ 276 lrecord_type_window_configuration,
277 lrecord_type_gui_item, /* 39 */ 277 lrecord_type_gui_item,
278 lrecord_type_popup_data, /* 40 */ 278 lrecord_type_popup_data,
279 lrecord_type_toolbar_button, /* 41 */ 279 lrecord_type_toolbar_button,
280 lrecord_type_scrollbar_instance, /* 42 */ 280 lrecord_type_scrollbar_instance,
281 lrecord_type_color_instance, /* 43 */ 281 lrecord_type_color_instance,
282 lrecord_type_font_instance, /* 44 */ 282 lrecord_type_font_instance,
283 lrecord_type_image_instance, /* 45 */ 283 lrecord_type_image_instance,
284 lrecord_type_glyph, /* 46 */ 284 lrecord_type_glyph,
285 lrecord_type_face, /* 47 */ 285 lrecord_type_face,
286 lrecord_type_database, /* 48 */ 286 lrecord_type_fc_config,
287 lrecord_type_tooltalk_message, /* 49 */ 287 lrecord_type_fc_pattern,
288 lrecord_type_tooltalk_pattern, /* 50 */ 288 lrecord_type_database,
289 lrecord_type_ldap, /* 51 */ 289 lrecord_type_tooltalk_message,
290 lrecord_type_pgconn, /* 52 */ 290 lrecord_type_tooltalk_pattern,
291 lrecord_type_pgresult, /* 53 */ 291 lrecord_type_ldap,
292 lrecord_type_devmode, /* 54 */ 292 lrecord_type_pgconn,
293 lrecord_type_mswindows_dialog_id, /* 55 */ 293 lrecord_type_pgresult,
294 lrecord_type_case_table, /* 56 */ 294 lrecord_type_devmode,
295 lrecord_type_emacs_ffi, /* 57 */ 295 lrecord_type_mswindows_dialog_id,
296 lrecord_type_emacs_gtk_object, /* 58 */ 296 lrecord_type_case_table,
297 lrecord_type_emacs_gtk_boxed, /* 59 */ 297 lrecord_type_emacs_ffi,
298 lrecord_type_weak_box, /* 60 */ 298 lrecord_type_emacs_gtk_object,
299 lrecord_type_ephemeron, /* 61 */ 299 lrecord_type_emacs_gtk_boxed,
300 lrecord_type_bignum, /* 62 */ 300 lrecord_type_weak_box,
301 lrecord_type_ratio, /* 63 */ 301 lrecord_type_ephemeron,
302 lrecord_type_bigfloat, /* 64 */ 302 lrecord_type_bignum,
303 #ifndef MC_ALLOC 303 lrecord_type_ratio,
304 lrecord_type_bigfloat,
305 #ifndef NEW_GC
304 lrecord_type_free, /* only used for "free" lrecords */ 306 lrecord_type_free, /* only used for "free" lrecords */
305 lrecord_type_undefined, /* only used for debugging */ 307 lrecord_type_undefined, /* only used for debugging */
306 #endif /* not MC_ALLOC */ 308 #endif /* not NEW_GC */
307 lrecord_type_last_built_in_type /* 65 */ /* must be last */ 309 #ifdef NEW_GC
310 lrecord_type_string_indirect_data,
311 lrecord_type_string_direct_data,
312 lrecord_type_hash_table_entry,
313 lrecord_type_syntax_cache,
314 lrecord_type_buffer_text,
315 lrecord_type_compiled_function_args,
316 lrecord_type_tty_console,
317 lrecord_type_stream_console,
318 lrecord_type_dynarr,
319 lrecord_type_face_cachel,
320 lrecord_type_face_cachel_dynarr,
321 lrecord_type_glyph_cachel,
322 lrecord_type_glyph_cachel_dynarr,
323 lrecord_type_x_device,
324 lrecord_type_gtk_device,
325 lrecord_type_tty_device,
326 lrecord_type_mswindows_device,
327 lrecord_type_msprinter_device,
328 lrecord_type_x_frame,
329 lrecord_type_gtk_frame,
330 lrecord_type_mswindows_frame,
331 lrecord_type_gap_array_marker,
332 lrecord_type_gap_array,
333 lrecord_type_extent_list_marker,
334 lrecord_type_extent_list,
335 lrecord_type_stack_of_extents,
336 lrecord_type_tty_color_instance_data,
337 lrecord_type_tty_font_instance_data,
338 lrecord_type_specifier_caching,
339 lrecord_type_expose_ignore,
340 #endif /* NEW_GC */
341 lrecord_type_last_built_in_type /* must be last */
308 }; 342 };
309 343
310 extern MODULE_API int lrecord_type_count; 344 extern MODULE_API int lrecord_type_count;
311 345
312 struct lrecord_implementation 346 struct lrecord_implementation
379 Bytecount (*size_in_bytes_method) (const void *header); 413 Bytecount (*size_in_bytes_method) (const void *header);
380 414
381 /* The (constant) index into lrecord_implementations_table */ 415 /* The (constant) index into lrecord_implementations_table */
382 enum lrecord_type lrecord_type_index; 416 enum lrecord_type lrecord_type_index;
383 417
384 #ifndef MC_ALLOC 418 #ifndef NEW_GC
385 /* A "basic" lrecord is any lrecord that's not an lcrecord, i.e. 419 /* A "basic" lrecord is any lrecord that's not an lcrecord, i.e.
386 one that does not have an old_lcrecord_header at the front and which 420 one that does not have an old_lcrecord_header at the front and which
387 is (usually) allocated in frob blocks. */ 421 is (usually) allocated in frob blocks. */
388 unsigned int basic_p :1; 422 unsigned int basic_p :1;
389 #endif /* not MC_ALLOC */ 423 #endif /* not NEW_GC */
390 }; 424 };
391 425
392 /* All the built-in lisp object types are enumerated in `enum lrecord_type'. 426 /* All the built-in lisp object types are enumerated in `enum lrecord_type'.
393 Additional ones may be defined by a module (none yet). We leave some 427 Additional ones may be defined by a module (none yet). We leave some
394 room in `lrecord_implementations_table' for such new lisp object types. */ 428 room in `lrecord_implementations_table' for such new lisp object types. */
399 433
400 #define XRECORD_LHEADER_IMPLEMENTATION(obj) \ 434 #define XRECORD_LHEADER_IMPLEMENTATION(obj) \
401 LHEADER_IMPLEMENTATION (XRECORD_LHEADER (obj)) 435 LHEADER_IMPLEMENTATION (XRECORD_LHEADER (obj))
402 #define LHEADER_IMPLEMENTATION(lh) lrecord_implementations_table[(lh)->type] 436 #define LHEADER_IMPLEMENTATION(lh) lrecord_implementations_table[(lh)->type]
403 437
438 #include "gc.h"
439
440 #ifdef NEW_GC
441 #include "vdb.h"
442 #endif /* NEW_GC */
443
404 extern int gc_in_progress; 444 extern int gc_in_progress;
405 445
406 #ifdef MC_ALLOC 446 #ifdef NEW_GC
407 #include "mc-alloc.h" 447 #include "mc-alloc.h"
408 448
409 #ifdef ALLOC_TYPE_STATS 449 #ifdef ALLOC_TYPE_STATS
410 void init_lrecord_stats (void); 450 void init_lrecord_stats (void);
411 void inc_lrecord_string_data_stats (Bytecount size);
412 void dec_lrecord_string_data_stats (Bytecount size);
413 void inc_lrecord_stats (Bytecount size, const struct lrecord_header *h); 451 void inc_lrecord_stats (Bytecount size, const struct lrecord_header *h);
414 void dec_lrecord_stats (Bytecount size_including_overhead, 452 void dec_lrecord_stats (Bytecount size_including_overhead,
415 const struct lrecord_header *h); 453 const struct lrecord_header *h);
454 int lrecord_stats_heap_size (void);
416 #endif /* ALLOC_TYPE_STATS */ 455 #endif /* ALLOC_TYPE_STATS */
417 456
418 /* Tell mc-alloc how to call a finalizer. */ 457 /* Tell mc-alloc how to call a finalizer. */
419 #define MC_ALLOC_CALL_FINALIZER(ptr) \ 458 #define MC_ALLOC_CALL_FINALIZER(ptr) \
420 { \ 459 { \
424 && !LRECORD_FREE_P (MCACF_lheader) ) \ 463 && !LRECORD_FREE_P (MCACF_lheader) ) \
425 { \ 464 { \
426 const struct lrecord_implementation *MCACF_implementation \ 465 const struct lrecord_implementation *MCACF_implementation \
427 = LHEADER_IMPLEMENTATION (MCACF_lheader); \ 466 = LHEADER_IMPLEMENTATION (MCACF_lheader); \
428 if (MCACF_implementation && MCACF_implementation->finalizer) \ 467 if (MCACF_implementation && MCACF_implementation->finalizer) \
429 MCACF_implementation->finalizer (ptr, 0); \ 468 { \
469 GC_STAT_FINALIZED; \
470 MCACF_implementation->finalizer (ptr, 0); \
471 } \
430 } \ 472 } \
431 } while (0) 473 } while (0)
432 474
433 /* Tell mc-alloc how to call a finalizer for disksave. */ 475 /* Tell mc-alloc how to call a finalizer for disksave. */
434 #define MC_ALLOC_CALL_FINALIZER_FOR_DISKSAVE(ptr) \ 476 #define MC_ALLOC_CALL_FINALIZER_FOR_DISKSAVE(ptr) \
463 #define SET_LISP_READONLY_RECORD_HEADER(lheader) \ 505 #define SET_LISP_READONLY_RECORD_HEADER(lheader) \
464 ((void) ((lheader)->lisp_readonly = 1)) 506 ((void) ((lheader)->lisp_readonly = 1))
465 #define MARK_LRECORD_AS_LISP_READONLY(ptr) \ 507 #define MARK_LRECORD_AS_LISP_READONLY(ptr) \
466 ((void) (((struct lrecord_header *) ptr)->lisp_readonly = 1)) 508 ((void) (((struct lrecord_header *) ptr)->lisp_readonly = 1))
467 509
468 #else /* not MC_ALLOC */ 510 #else /* not NEW_GC */
469 511
470 #define LRECORD_FREE_P(ptr) \ 512 #define LRECORD_FREE_P(ptr) \
471 (((struct lrecord_header *) ptr)->type == lrecord_type_free) 513 (((struct lrecord_header *) ptr)->type == lrecord_type_free)
472 514
473 #define MARK_LRECORD_AS_FREE(ptr) \ 515 #define MARK_LRECORD_AS_FREE(ptr) \
486 SCRRH_lheader->lisp_readonly = 1; \ 528 SCRRH_lheader->lisp_readonly = 1; \
487 SCRRH_lheader->mark = 1; \ 529 SCRRH_lheader->mark = 1; \
488 } while (0) 530 } while (0)
489 #define SET_LISP_READONLY_RECORD_HEADER(lheader) \ 531 #define SET_LISP_READONLY_RECORD_HEADER(lheader) \
490 ((void) ((lheader)->lisp_readonly = 1)) 532 ((void) ((lheader)->lisp_readonly = 1))
491 #endif /* not MC_ALLOC */ 533 #endif /* not NEW_GC */
492 534
493 #ifdef USE_KKCC 535 #ifdef USE_KKCC
494 #define RECORD_DESCRIPTION(lheader) lrecord_memory_descriptions[(lheader)->type] 536 #define RECORD_DESCRIPTION(lheader) lrecord_memory_descriptions[(lheader)->type]
495 #else /* not USE_KKCC */ 537 #else /* not USE_KKCC */
496 #define RECORD_MARKER(lheader) lrecord_markers[(lheader)->type] 538 #define RECORD_MARKER(lheader) lrecord_markers[(lheader)->type]
951 993
952 enum memory_description_type 994 enum memory_description_type
953 { 995 {
954 XD_LISP_OBJECT_ARRAY, 996 XD_LISP_OBJECT_ARRAY,
955 XD_LISP_OBJECT, 997 XD_LISP_OBJECT,
998 #ifdef NEW_GC
999 XD_LISP_OBJECT_BLOCK_PTR,
1000 #endif /* NEW_GC */
956 XD_LO_LINK, 1001 XD_LO_LINK,
957 XD_OPAQUE_PTR, 1002 XD_OPAQUE_PTR,
958 XD_OPAQUE_PTR_CONVERTIBLE, 1003 XD_OPAQUE_PTR_CONVERTIBLE,
959 XD_OPAQUE_DATA_CONVERTIBLE, 1004 XD_OPAQUE_DATA_CONVERTIBLE,
960 XD_OPAQUE_DATA_PTR, 1005 XD_OPAQUE_DATA_PTR,
993 XD_FLAG_NO_KKCC = 1, 1038 XD_FLAG_NO_KKCC = 1,
994 /* If set, pdump does not process this entry. */ 1039 /* If set, pdump does not process this entry. */
995 XD_FLAG_NO_PDUMP = 2, 1040 XD_FLAG_NO_PDUMP = 2,
996 /* Indicates that this is a "default" entry in a union map. */ 1041 /* Indicates that this is a "default" entry in a union map. */
997 XD_FLAG_UNION_DEFAULT_ENTRY = 4, 1042 XD_FLAG_UNION_DEFAULT_ENTRY = 4,
998 #ifndef MC_ALLOC 1043 #ifndef NEW_GC
999 /* Indicates that this is a free Lisp object we're marking. 1044 /* Indicates that this is a free Lisp object we're marking.
1000 Only relevant for ERROR_CHECK_GC. This occurs when we're marking 1045 Only relevant for ERROR_CHECK_GC. This occurs when we're marking
1001 lcrecord-lists, where the objects have had their type changed to 1046 lcrecord-lists, where the objects have had their type changed to
1002 lrecord_type_free and also have had their free bit set, but we mark 1047 lrecord_type_free and also have had their free bit set, but we mark
1003 them as normal. */ 1048 them as normal. */
1004 XD_FLAG_FREE_LISP_OBJECT = 8 1049 XD_FLAG_FREE_LISP_OBJECT = 8
1005 #endif /* not MC_ALLOC */ 1050 #endif /* not NEW_GC */
1006 #if 0 1051 #if 0
1007 , 1052 ,
1008 /* Suggestions for other possible flags: */ 1053 /* Suggestions for other possible flags: */
1009 1054
1010 /* Eliminate XD_UNION_DYNAMIC_SIZE and replace it with a flag, like this. */ 1055 /* Eliminate XD_UNION_DYNAMIC_SIZE and replace it with a flag, like this. */
1087 #define XD_DYNARR_DESC(base_type, sub_desc) \ 1132 #define XD_DYNARR_DESC(base_type, sub_desc) \
1088 { XD_BLOCK_PTR, offsetof (base_type, base), XD_INDIRECT(1, 0), {sub_desc} },\ 1133 { XD_BLOCK_PTR, offsetof (base_type, base), XD_INDIRECT(1, 0), {sub_desc} },\
1089 { XD_INT, offsetof (base_type, cur) }, \ 1134 { XD_INT, offsetof (base_type, cur) }, \
1090 { XD_INT_RESET, offsetof (base_type, max), XD_INDIRECT(1, 0) } \ 1135 { XD_INT_RESET, offsetof (base_type, max), XD_INDIRECT(1, 0) } \
1091 1136
1092 /* DEFINE_LISP_OBJECT is for objects with constant size. 1137 #ifdef NEW_GC
1093 1138 #define XD_LISP_DYNARR_DESC(base_type, sub_desc) \
1094 DEFINE_SIZABLE_LISP_OBJECT is for objects whose size varies. 1139 { XD_LISP_OBJECT_BLOCK_PTR, offsetof (base_type, base), \
1095 1140 XD_INDIRECT(1, 0), {sub_desc} }, \
1096 DEFINE_FROB_BLOCK_LISP_OBJECT is for objects that are allocated in 1141 { XD_INT, offsetof (base_type, cur) }, \
1142 { XD_INT_RESET, offsetof (base_type, max), XD_INDIRECT(1, 0) }
1143 #endif /* not NEW_GC */
1144
1145 /* DEFINE_*_LISP_OBJECT is for objects with constant size. (Either
1146 DEFINE_DUMPABLE_LISP_OBJECT for objects that can be saved in a dumped
1147 executable, or DEFINE_NODUMP_LISP_OBJECT for objects that cannot be
1148 saved -- e.g. that contain pointers to non-persistent external objects
1149 such as window-system windows.)
1150
1151 DEFINE_*_SIZABLE_LISP_OBJECT is for objects whose size varies.
1152
1153 DEFINE_*_FROB_BLOCK_LISP_OBJECT is for objects that are allocated in
1097 large blocks ("frob blocks"), which are parceled up individually. Such 1154 large blocks ("frob blocks"), which are parceled up individually. Such
1098 objects need special handling in alloc.c. This does not apply to 1155 objects need special handling in alloc.c. This does not apply to
1099 MC_ALLOC, because it does this automatically. 1156 NEW_GC, because it does this automatically.
1100 1157
1101 DEFINE_*_WITH_PROPS is for objects which support the unified property 1158 DEFINE_*_WITH_PROPS is for objects which support the unified property
1102 interface using `get', `put', `remprop' and `object-plist'. 1159 interface using `get', `put', `remprop' and `object-plist'.
1103 1160
1104 DEFINE_EXTERNAL_* is for objects defined in an external module. 1161 DEFINE_MODULE_* is for objects defined in an external module.
1105 1162
1106 MAKE_LISP_OBJECT is what underlies all of these; it defines 1163 MAKE_LISP_OBJECT and MAKE_MODULE_LISP_OBJECT are what underlies all of
1107 1164 these; they define a structure containing pointers to object methods
1165 and other info such as the size of the structure containing the object.
1108 */ 1166 */
1109 1167
1168 /* #### FIXME What's going on here? */
1110 #if defined (ERROR_CHECK_TYPES) 1169 #if defined (ERROR_CHECK_TYPES)
1111 # define DECLARE_ERROR_CHECK_TYPES(c_name, structtype) 1170 # define DECLARE_ERROR_CHECK_TYPES(c_name, structtype)
1112 #else 1171 #else
1113 # define DECLARE_ERROR_CHECK_TYPES(c_name, structtype) 1172 # define DECLARE_ERROR_CHECK_TYPES(c_name, structtype)
1114 #endif 1173 #endif
1115 1174
1116 #error MUST STILL SUPPORT THIS::: 1175 /********* The dumpable versions *********** */
1117 1176
1118 #define DEFINE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,structtype) \ 1177 #define DEFINE_DUMPABLE_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \
1119 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype) 1178 DEFINE_DUMPABLE_LISP_OBJECT_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype)
1120 1179
1121 #error and variations 1180 #define DEFINE_DUMPABLE_LISP_OBJECT_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \
1122 1181 MAKE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof (structtype),0,0,structtype)
1123 #define DEFINE_INTERNAL_LISP_OBJECT(name,c_name,dumpable,structtype,desc,marker) ... 1182
1124 1183 #define DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \
1125 #define DEFINE_FROB_BLOCK_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,structtype) \ 1184 DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,sizer,structtype)
1126 DEFINE_FROB_BLOCK_LISP_OBJECT_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype) 1185
1127 1186 #define DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizer,structtype) \
1128 #define DEFINE_FROB_BLOCK_LISP_OBJECT_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \ 1187 MAKE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,0,sizer,0,structtype)
1129 MAKE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof(structtype),0,1,structtype) 1188
1130 1189 #define DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \
1131 #define DEFINE_INTERNAL_LISP_OBJECT(name,c_name,structtype,desc,dumpable,marker) \ 1190 DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype)
1132 DEFINE_LISP_OBJECT_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,) 1191
1133 1192 #define DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \
1134 #define DEFINE_LISP_OBJECT(name,c_name,structtype,desc,dumpable,marker,printer,equal,hash,nuker) \ 1193 MAKE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof(structtype),0,1,structtype)
1135 DEFINE_LISP_OBJECT_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,) 1194
1136 1195 #define DEFINE_DUMPABLE_FROB_BLOCK_SIZABLE_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \
1137 #define DEFINE_LISP_OBJECT_WITH_PROPS(name,c_name,structtype,dumpable,desc,marker,printer,equal,hash,nuker,getprop,putprop,remprop,plist) \ 1196 MAKE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,sizer,1,structtype)
1138 MAKE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof (structtype),0,0,structtype) 1197
1139 1198 #define DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT(name,c_name,marker,desc,structtype) \
1140 #define DEFINE_SIZABLE_LISP_OBJECT(name,c_name,structtype,sizer,desc,dumpable,marker,printer,equal,hash,nuker) \ 1199 DEFINE_DUMPABLE_LISP_OBJECT_WITH_PROPS(name,c_name,marker,internal_object_printer,0,0,0,desc,0,0,0,0,structtype)
1141 DEFINE_SIZABLE_LISP_OBJECT_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,sizer,structtype) 1200
1142 1201 #define DEFINE_DUMPABLE_SIZABLE_INTERNAL_LISP_OBJECT(name,c_name,marker,desc,sizer,structtype) \
1143 #define DEFINE_SIZABLE_LISP_OBJECT_WITH_PROPS(name,c_name,structtype,sizer,desc,dumpable,marker,printer,equal,hash,nuker,getprop,putprop,remprop,plist) \ 1202 DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT_WITH_PROPS(name,c_name,marker,internal_object_printer,0,0,0,desc,0,0,0,0,sizer,structtype)
1144 MAKE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,0,sizer,0,structtype) 1203
1145 1204 /********* The non-dumpable versions *********** */
1146 #ifdef MC_ALLOC 1205
1147 #define MAKE_LISP_OBJECT(name,c_name,structtype,sizer,desc,dumpable,marker,printer,equal,hash,nuker,getprop,putprop,remprop,plist,frob_block) \ 1206 #define DEFINE_NODUMP_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \
1207 DEFINE_NODUMP_LISP_OBJECT_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype)
1208
1209 #define DEFINE_NODUMP_LISP_OBJECT_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \
1210 MAKE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof (structtype),0,0,structtype)
1211
1212 #define DEFINE_NODUMP_SIZABLE_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \
1213 DEFINE_NODUMP_SIZABLE_LISP_OBJECT_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,sizer,structtype)
1214
1215 #define DEFINE_NODUMP_SIZABLE_LISP_OBJECT_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizer,structtype) \
1216 MAKE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,0,sizer,0,structtype)
1217
1218 #define DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \
1219 DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype)
1220
1221 #define DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \
1222 MAKE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof(structtype),0,1,structtype)
1223
1224 #define DEFINE_NODUMP_FROB_BLOCK_SIZABLE_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \
1225 MAKE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,sizer,1,structtype)
1226
1227 #define DEFINE_NODUMP_INTERNAL_LISP_OBJECT(name,c_name,marker,desc,structtype) \
1228 DEFINE_NODUMP_LISP_OBJECT_WITH_PROPS(name,c_name,marker,internal_object_printer,0,0,0,desc,0,0,0,0,structtype)
1229
1230 #define DEFINE_NODUMP_SIZABLE_INTERNAL_LISP_OBJECT(name,c_name,marker,desc,sizer,structtype) \
1231 DEFINE_NODUMP_SIZABLE_LISP_OBJECT_WITH_PROPS(name,c_name,marker,internal_object_printer,0,0,0,desc,0,0,0,0,sizer,structtype)
1232
1233 /********* MAKE_LISP_OBJECT, the underlying macro *********** */
1234
1235 #ifdef NEW_GC
1236 #define MAKE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,frob_block_p,structtype) \
1148 DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \ 1237 DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \
1149 const struct lrecord_implementation lrecord_##c_name = \ 1238 const struct lrecord_implementation lrecord_##c_name = \
1150 { name, dumpable, marker, printer, nuker, equal, hash, desc, \ 1239 { name, dumpable, marker, printer, nuker, equal, hash, desc, \
1151 getprop, putprop, remprop, plist, size, sizer, \ 1240 getprop, putprop, remprop, plist, size, sizer, \
1152 lrecord_type_##c_name } 1241 lrecord_type_##c_name }
1153 #else /* not MC_ALLOC */ 1242 #else /* not NEW_GC */
1154 #define MAKE_LISP_OBJECT(name,c_name,structtype,sizer,desc,dumpable,marker,printer,equal,hash,nuker,getprop,putprop,remprop,plist,frob_block) \ 1243 #define MAKE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,frob_block_p,structtype) \
1155 DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \ 1244 DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \
1156 const struct lrecord_implementation lrecord_##c_name = \ 1245 const struct lrecord_implementation lrecord_##c_name = \
1157 { name, dumpable, marker, printer, nuker, equal, hash, desc, \ 1246 { name, dumpable, marker, printer, nuker, equal, hash, desc, \
1158 getprop, putprop, remprop, plist, size, sizer, \ 1247 getprop, putprop, remprop, plist, size, sizer, \
1159 lrecord_type_##c_name, frob_block } 1248 lrecord_type_##c_name, frob_block_p }
1160 #endif /* not MC_ALLOC */ 1249 #endif /* not NEW_GC */
1161 1250
1162 #define DEFINE_EXTERNAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,structtype) \ 1251
1163 DEFINE_EXTERNAL_LISP_OBJECT_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype) 1252 /********* The module dumpable versions *********** */
1164 1253
1165 #define DEFINE_EXTERNAL_LISP_OBJECT_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \ 1254 #define DEFINE_DUMPABLE_MODULE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,structtype) \
1166 MAKE_EXTERNAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof (structtype),0,0,structtype) 1255 DEFINE_DUMPABLE_MODULE_LISP_OBJECT_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype)
1167 1256
1168 #define DEFINE_EXTERNAL_SIZABLE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,sizer,structtype) \ 1257 #define DEFINE_DUMPABLE_MODULE_LISP_OBJECT_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \
1169 DEFINE_EXTERNAL_SIZABLE_LISP_OBJECT_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,sizer,structtype) 1258 MAKE_MODULE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof (structtype),0,0,structtype)
1170 1259
1171 #define DEFINE_EXTERNAL_SIZABLE_LISP_OBJECT_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizer,structtype) \ 1260 #define DEFINE_DUMPABLE_MODULE_SIZABLE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,sizer,structtype) \
1172 MAKE_EXTERNAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,0,sizer,0,structtype) 1261 DEFINE_DUMPABLE_MODULE_SIZABLE_LISP_OBJECT_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,sizer,structtype)
1173 1262
1174 #ifdef MC_ALLOC 1263 #define DEFINE_DUMPABLE_MODULE_SIZABLE_LISP_OBJECT_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizer,structtype) \
1175 #define MAKE_EXTERNAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \ 1264 MAKE_MODULE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,0,sizer,0,structtype)
1265
1266 /********* The module non-dumpable versions *********** */
1267
1268 #define DEFINE_NODUMP_MODULE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,structtype) \
1269 DEFINE_NODUMP_MODULE_LISP_OBJECT_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype)
1270
1271 #define DEFINE_NODUMP_MODULE_LISP_OBJECT_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \
1272 MAKE_MODULE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof (structtype),0,0,structtype)
1273
1274 #define DEFINE_NODUMP_MODULE_SIZABLE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,sizer,structtype) \
1275 DEFINE_NODUMP_MODULE_SIZABLE_LISP_OBJECT_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,sizer,structtype)
1276
1277 #define DEFINE_NODUMP_MODULE_SIZABLE_LISP_OBJECT_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizer,structtype) \
1278 MAKE_MODULE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,0,sizer,0,structtype)
1279
1280 /********* MAKE_MODULE_LISP_OBJECT, the underlying macro *********** */
1281
1282 #ifdef NEW_GC
1283 #define MAKE_MODULE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,frob_block_p,structtype) \
1176 DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \ 1284 DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \
1177 int lrecord_type_##c_name; \ 1285 int lrecord_type_##c_name; \
1178 struct lrecord_implementation lrecord_##c_name = \ 1286 struct lrecord_implementation lrecord_##c_name = \
1179 { name, dumpable, marker, printer, nuker, equal, hash, desc, \ 1287 { name, dumpable, marker, printer, nuker, equal, hash, desc, \
1180 getprop, putprop, remprop, plist, size, sizer, \ 1288 getprop, putprop, remprop, plist, size, sizer, \
1181 lrecord_type_last_built_in_type } 1289 lrecord_type_last_built_in_type }
1182 #else /* not MC_ALLOC */ 1290 #else /* not NEW_GC */
1183 #define MAKE_EXTERNAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \ 1291 #define MAKE_MODULE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,frob_block_p,structtype) \
1184 DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \ 1292 DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \
1185 int lrecord_type_##c_name; \ 1293 int lrecord_type_##c_name; \
1186 struct lrecord_implementation lrecord_##c_name = \ 1294 struct lrecord_implementation lrecord_##c_name = \
1187 { name, dumpable, marker, printer, nuker, equal, hash, desc, \ 1295 { name, dumpable, marker, printer, nuker, equal, hash, desc, \
1188 getprop, putprop, remprop, plist, size, sizer, \ 1296 getprop, putprop, remprop, plist, size, sizer, \
1189 lrecord_type_last_built_in_type, basic_p } 1297 lrecord_type_last_built_in_type, frob_block_p }
1190 #endif /* not MC_ALLOC */ 1298 #endif /* not NEW_GC */
1191 1299
1192 #ifdef USE_KKCC 1300 #ifdef USE_KKCC
1193 extern MODULE_API const struct memory_description *lrecord_memory_descriptions[]; 1301 extern MODULE_API const struct memory_description *lrecord_memory_descriptions[];
1194 1302
1195 #define INIT_LISP_OBJECT(type) do { \ 1303 #define INIT_LISP_OBJECT(type) do { \
1205 lrecord_markers[lrecord_type_##type] = \ 1313 lrecord_markers[lrecord_type_##type] = \
1206 lrecord_implementations_table[lrecord_type_##type]->marker; \ 1314 lrecord_implementations_table[lrecord_type_##type]->marker; \
1207 } while (0) 1315 } while (0)
1208 #endif /* not USE_KKCC */ 1316 #endif /* not USE_KKCC */
1209 1317
1210 #define INIT_EXTERNAL_LISP_OBJECT(type) do { \ 1318 #define INIT_MODULE_LISP_OBJECT(type) do { \
1211 lrecord_type_##type = lrecord_type_count++; \ 1319 lrecord_type_##type = lrecord_type_count++; \
1212 lrecord_##type.lrecord_type_index = lrecord_type_##type; \ 1320 lrecord_##type.lrecord_type_index = lrecord_type_##type; \
1213 INIT_LISP_OBJECT(type); \ 1321 INIT_LISP_OBJECT(type); \
1214 } while (0) 1322 } while (0)
1215 1323
1226 lrecord_implementations_table[lrecord_type_##type] = NULL; \ 1334 lrecord_implementations_table[lrecord_type_##type] = NULL; \
1227 lrecord_markers[lrecord_type_##type] = NULL; \ 1335 lrecord_markers[lrecord_type_##type] = NULL; \
1228 } while (0) 1336 } while (0)
1229 #endif /* not USE_KKCC */ 1337 #endif /* not USE_KKCC */
1230 1338
1231 #define UNDEF_EXTERNAL_LISP_OBJECT(type) do { \ 1339 #define UNDEF_MODULE_LISP_OBJECT(type) do { \
1232 if (lrecord_##type.lrecord_type_index == lrecord_type_count - 1) { \ 1340 if (lrecord_##type.lrecord_type_index == lrecord_type_count - 1) { \
1233 /* This is the most recently defined type. Clean up nicely. */ \ 1341 /* This is the most recently defined type. Clean up nicely. */ \
1234 lrecord_type_##type = lrecord_type_count--; \ 1342 lrecord_type_##type = lrecord_type_count--; \
1235 } /* Else we can't help leaving a hole with this implementation. */ \ 1343 } /* Else we can't help leaving a hole with this implementation. */ \
1236 UNDEF_LISP_OBJECT(type); \ 1344 UNDEF_LISP_OBJECT(type); \
1312 int border_width; 1420 int border_width;
1313 }; 1421 };
1314 1422
1315 [[ the standard junk: ]] 1423 [[ the standard junk: ]]
1316 1424
1317 DECLARE_LRECORD (toolbar_button, struct toolbar_button); 1425 DECLARE_LISP_OBJECT (toolbar_button, struct toolbar_button);
1318 #define XTOOLBAR_BUTTON(x) XRECORD (x, toolbar_button, struct toolbar_button) 1426 #define XTOOLBAR_BUTTON(x) XRECORD (x, toolbar_button, struct toolbar_button)
1319 #define wrap_toolbar_button(p) wrap_record (p, toolbar_button) 1427 #define wrap_toolbar_button(p) wrap_record (p, toolbar_button)
1320 #define TOOLBAR_BUTTONP(x) RECORDP (x, toolbar_button) 1428 #define TOOLBAR_BUTTONP(x) RECORDP (x, toolbar_button)
1321 #define CHECK_TOOLBAR_BUTTON(x) CHECK_RECORD (x, toolbar_button) 1429 #define CHECK_TOOLBAR_BUTTON(x) CHECK_RECORD (x, toolbar_button)
1322 #define CONCHECK_TOOLBAR_BUTTON(x) CONCHECK_RECORD (x, toolbar_button) 1430 #define CONCHECK_TOOLBAR_BUTTON(x) CONCHECK_RECORD (x, toolbar_button)
1357 mark_object (data->callback); 1465 mark_object (data->callback);
1358 mark_object (data->enabled_p); 1466 mark_object (data->enabled_p);
1359 return data->help_string; 1467 return data->help_string;
1360 } 1468 }
1361 1469
1362 DEFINE_NONDUMPABLE_LISP_OBJECT ("toolbar-button", toolbar_button, 1470 DEFINE_NODUMP_LISP_OBJECT ("toolbar-button", toolbar_button,
1363 mark_toolbar_button, 1471 mark_toolbar_button,
1364 external_object_printer, 0, 0, 0, 1472 external_object_printer, 0, 0, 0,
1365 toolbar_button_description, 1473 toolbar_button_description,
1366 struct toolbar_button); 1474 struct toolbar_button);
1367 1475
1368 ... 1476 ...
1369 1477
1370 void 1478 void
1371 syms_of_toolbar (void) 1479 syms_of_toolbar (void)
1396 */ 1504 */
1397 1505
1398 /* 1506 /*
1399 1507
1400 Note: Object types defined in external dynamically-loaded modules (not 1508 Note: Object types defined in external dynamically-loaded modules (not
1401 part of the XEmacs main source code) should use DECLARE_EXTERNAL_LRECORD 1509 part of the XEmacs main source code) should use DECLARE_MODULE_LRECORD
1402 and DEFINE_EXTERNAL_LISP_OBJECT rather than DECLARE_LRECORD 1510 and DEFINE_MODULE_LISP_OBJECT rather than DECLARE_LISP_OBJECT
1403 and DEFINE_LISP_OBJECT. The EXTERNAL versions declare and 1511 and DEFINE_LISP_OBJECT. The MODULE versions declare and
1404 allocate an enumerator for the type being defined. 1512 allocate an enumerator for the type being defined.
1405 1513
1406 */ 1514 */
1407 1515
1408 1516
1409 #ifdef ERROR_CHECK_TYPES 1517 #ifdef ERROR_CHECK_TYPES
1410 1518
1411 # define DECLARE_LRECORD(c_name, structtype) \ 1519 # define DECLARE_LISP_OBJECT(c_name, structtype) \
1412 extern const struct lrecord_implementation lrecord_##c_name; \ 1520 extern const struct lrecord_implementation lrecord_##c_name; \
1413 DECLARE_INLINE_HEADER ( \ 1521 DECLARE_INLINE_HEADER ( \
1414 structtype * \ 1522 structtype * \
1415 error_check_##c_name (Lisp_Object obj, const Ascbyte *file, int line) \ 1523 error_check_##c_name (Lisp_Object obj, const Ascbyte *file, int line) \
1416 ) \ 1524 ) \
1430 assert_at_line (RECORD_TYPEP (obj, lrecord_type_##c_name), file, line); \ 1538 assert_at_line (RECORD_TYPEP (obj, lrecord_type_##c_name), file, line); \
1431 return (structtype *) XPNTR (obj); \ 1539 return (structtype *) XPNTR (obj); \
1432 } \ 1540 } \
1433 extern MODULE_API Lisp_Object Q##c_name##p 1541 extern MODULE_API Lisp_Object Q##c_name##p
1434 1542
1435 # define DECLARE_EXTERNAL_LRECORD(c_name, structtype) \ 1543 # define DECLARE_MODULE_LRECORD(c_name, structtype) \
1436 extern int lrecord_type_##c_name; \ 1544 extern int lrecord_type_##c_name; \
1437 extern struct lrecord_implementation lrecord_##c_name; \ 1545 extern struct lrecord_implementation lrecord_##c_name; \
1438 DECLARE_INLINE_HEADER ( \ 1546 DECLARE_INLINE_HEADER ( \
1439 structtype * \ 1547 structtype * \
1440 error_check_##c_name (Lisp_Object obj, const Ascbyte *file, int line) \ 1548 error_check_##c_name (Lisp_Object obj, const Ascbyte *file, int line) \
1476 #define wrap_record(ptr, ty) \ 1584 #define wrap_record(ptr, ty) \
1477 wrap_record_1 (ptr, lrecord_type_##ty, __FILE__, __LINE__) 1585 wrap_record_1 (ptr, lrecord_type_##ty, __FILE__, __LINE__)
1478 1586
1479 #else /* not ERROR_CHECK_TYPES */ 1587 #else /* not ERROR_CHECK_TYPES */
1480 1588
1481 # define DECLARE_LRECORD(c_name, structtype) \ 1589 # define DECLARE_LISP_OBJECT(c_name, structtype) \
1482 extern Lisp_Object Q##c_name##p; \ 1590 extern Lisp_Object Q##c_name##p; \
1483 extern const struct lrecord_implementation lrecord_##c_name 1591 extern const struct lrecord_implementation lrecord_##c_name
1484 # define DECLARE_MODULE_API_LRECORD(c_name, structtype) \ 1592 # define DECLARE_MODULE_API_LRECORD(c_name, structtype) \
1485 extern MODULE_API Lisp_Object Q##c_name##p; \ 1593 extern MODULE_API Lisp_Object Q##c_name##p; \
1486 extern MODULE_API const struct lrecord_implementation lrecord_##c_name 1594 extern MODULE_API const struct lrecord_implementation lrecord_##c_name
1487 # define DECLARE_EXTERNAL_LRECORD(c_name, structtype) \ 1595 # define DECLARE_MODULE_LRECORD(c_name, structtype) \
1488 extern Lisp_Object Q##c_name##p; \ 1596 extern Lisp_Object Q##c_name##p; \
1489 extern int lrecord_type_##c_name; \ 1597 extern int lrecord_type_##c_name; \
1490 extern struct lrecord_implementation lrecord_##c_name 1598 extern struct lrecord_implementation lrecord_##c_name
1491 # define DECLARE_NONRECORD(c_name, type_enum, structtype) \ 1599 # define DECLARE_NONRECORD(c_name, type_enum, structtype) \
1492 extern Lisp_Object Q##c_name##p 1600 extern Lisp_Object Q##c_name##p
1549 1657
1550 - For objects whose size can vary (and hence which have a 1658 - For objects whose size can vary (and hence which have a
1551 size_in_bytes_method rather than a static_size), call 1659 size_in_bytes_method rather than a static_size), call
1552 ALLOC_SIZED_LISP_OBJECT (size, type), where TYPE is the 1660 ALLOC_SIZED_LISP_OBJECT (size, type), where TYPE is the
1553 name of the type. NOTE: You cannot call FREE_LCRECORD() on such 1661 name of the type. NOTE: You cannot call FREE_LCRECORD() on such
1554 on object! (At least when not MC_ALLOC) 1662 on object! (At least when not NEW_GC)
1555 1663
1556 - Basic lrecords (of which there are a limited number, which exist only 1664 - Basic lrecords (of which there are a limited number, which exist only
1557 when not MC_ALLOC, and which have special handling in alloc.c) need 1665 when not NEW_GC, and which have special handling in alloc.c) need
1558 special handling; if you don't understand this, just ignore it. 1666 special handling; if you don't understand this, just ignore it.
1559 1667
1560 - Some lrecords, which are used totally internally, use the 1668 - Some lrecords, which are used totally internally, use the
1561 noseeum-* functions for the reason of debugging. 1669 noseeum-* functions for the reason of debugging.
1562 */ 1670 */
1563 1671
1564 #ifndef MC_ALLOC 1672 #ifndef NEW_GC
1565 /*-------------------------- lcrecord-list -----------------------------*/ 1673 /*-------------------------- lcrecord-list -----------------------------*/
1566 1674
1567 struct lcrecord_list 1675 struct lcrecord_list
1568 { 1676 {
1569 struct LCRECORD_HEADER header; 1677 struct LCRECORD_HEADER header;
1570 Lisp_Object free; 1678 Lisp_Object free;
1571 Elemcount size; 1679 Elemcount size;
1572 const struct lrecord_implementation *implementation; 1680 const struct lrecord_implementation *implementation;
1573 }; 1681 };
1574 1682
1575 DECLARE_LRECORD (lcrecord_list, struct lcrecord_list); 1683 DECLARE_LISP_OBJECT (lcrecord_list, struct lcrecord_list);
1576 #define XLCRECORD_LIST(x) XRECORD (x, lcrecord_list, struct lcrecord_list) 1684 #define XLCRECORD_LIST(x) XRECORD (x, lcrecord_list, struct lcrecord_list)
1577 #define wrap_lcrecord_list(p) wrap_record (p, lcrecord_list) 1685 #define wrap_lcrecord_list(p) wrap_record (p, lcrecord_list)
1578 #define LCRECORD_LISTP(x) RECORDP (x, lcrecord_list) 1686 #define LCRECORD_LISTP(x) RECORDP (x, lcrecord_list)
1579 /* #define CHECK_LCRECORD_LIST(x) CHECK_RECORD (x, lcrecord_list) 1687 /* #define CHECK_LCRECORD_LIST(x) CHECK_RECORD (x, lcrecord_list)
1580 Lcrecord lists should never escape to the Lisp level, so 1688 Lcrecord lists should never escape to the Lisp level, so
1669 Lisp_Object alloc_managed_lcrecord (Lisp_Object lcrecord_list); 1777 Lisp_Object alloc_managed_lcrecord (Lisp_Object lcrecord_list);
1670 void free_managed_lcrecord (Lisp_Object lcrecord_list, Lisp_Object lcrecord); 1778 void free_managed_lcrecord (Lisp_Object lcrecord_list, Lisp_Object lcrecord);
1671 1779
1672 /* AUTO-MANAGED MODEL: */ 1780 /* AUTO-MANAGED MODEL: */
1673 MODULE_API Lisp_Object 1781 MODULE_API Lisp_Object
1674 alloc_automanaged_lcrecord (Bytecount size, 1782 alloc_automanaged_sized_lcrecord (Bytecount size,
1675 const struct lrecord_implementation *); 1783 const struct lrecord_implementation *imp);
1784 MODULE_API Lisp_Object
1785 alloc_automanaged_lcrecord (const struct lrecord_implementation *imp);
1676 1786
1677 #define old_alloc_lcrecord_type(type, imp) \ 1787 #define old_alloc_lcrecord_type(type, imp) \
1678 ((type *) XPNTR (alloc_automanaged_lcrecord (sizeof (type), imp))) 1788 ((type *) XPNTR (alloc_automanaged_lcrecord (sizeof (type), imp)))
1679 1789
1680 void old_free_lcrecord (Lisp_Object rec); 1790 void old_free_lcrecord (Lisp_Object rec);
1695 memset ((Rawbyte *) (lcr) + sizeof (struct old_lcrecord_header), 0, \ 1805 memset ((Rawbyte *) (lcr) + sizeof (struct old_lcrecord_header), 0, \
1696 (size) - sizeof (struct old_lcrecord_header)) 1806 (size) - sizeof (struct old_lcrecord_header))
1697 1807
1698 #define old_zero_lcrecord(lcr) old_zero_sized_lcrecord (lcr, sizeof (*(lcr))) 1808 #define old_zero_lcrecord(lcr) old_zero_sized_lcrecord (lcr, sizeof (*(lcr)))
1699 1809
1700 #else /* MC_ALLOC */ 1810 #else /* NEW_GC */
1701 1811
1702 Lisp_Object alloc_sized_lrecord (Bytecount size, 1812 Lisp_Object alloc_sized_lrecord (Bytecount size,
1703 const struct lrecord_implementation *imp); 1813 const struct lrecord_implementation *imp);
1704 Lisp_Object noseeum_alloc_sized_lrecord (Bytecount size, 1814 Lisp_Object noseeum_alloc_sized_lrecord (Bytecount size,
1705 const struct lrecord_implementation *); 1815 const struct lrecord_implementation *);
1706 Lisp_Object alloc_lrecord (const struct lrecord_implementation *imp); 1816 Lisp_Object alloc_lrecord (const struct lrecord_implementation *imp);
1817 Lisp_Object noseeum_alloc_lrecord (const struct lrecord_implementation *imp);
1818
1819 Lisp_Object alloc_lrecord_array (int elemcount,
1820 const struct lrecord_implementation *imp);
1821 Lisp_Object alloc_sized_lrecord_array (Bytecount size, int elemcount,
1822 const struct lrecord_implementation *imp);
1707 1823
1708 #define alloc_lrecord_type(type, imp) \ 1824 #define alloc_lrecord_type(type, imp) \
1709 ((type *) XPNTR (alloc_sized_lrecord (sizeof (type), imp))) 1825 ((type *) XPNTR (alloc_sized_lrecord (sizeof (type), imp)))
1710
1711 void *noseeum_alloc_lrecord (Bytecount size,
1712 const struct lrecord_implementation *);
1713 1826
1714 #define noseeum_alloc_lrecord_type(type, imp) \ 1827 #define noseeum_alloc_lrecord_type(type, imp) \
1715 ((type *) XPNTR (noseeum_alloc_sized_lrecord (sizeof (type), imp))) 1828 ((type *) XPNTR (noseeum_alloc_sized_lrecord (sizeof (type), imp)))
1716 1829
1717 void free_lrecord (Lisp_Object rec); 1830 void free_lrecord (Lisp_Object rec);
1725 (char *) (src) + sizeof (struct lrecord_header), \ 1838 (char *) (src) + sizeof (struct lrecord_header), \
1726 (size) - sizeof (struct lrecord_header)) 1839 (size) - sizeof (struct lrecord_header))
1727 1840
1728 #define copy_lrecord(dst, src) copy_sized_lrecord (dst, src, sizeof (*(dst))) 1841 #define copy_lrecord(dst, src) copy_sized_lrecord (dst, src, sizeof (*(dst)))
1729 1842
1730 #endif /* MC_ALLOC */ 1843 #endif /* NEW_GC */
1731 1844
1732 #define zero_sized_lrecord(lcr, size) \ 1845 #define zero_sized_lrecord(lcr, size) \
1733 memset ((char *) (lcr) + sizeof (struct lrecord_header), 0, \ 1846 memset ((char *) (lcr) + sizeof (struct lrecord_header), 0, \
1734 (size) - sizeof (struct lrecord_header)) 1847 (size) - sizeof (struct lrecord_header))
1735 1848
1844 Used during startup to detect startup of dumped Emacs. */ 1957 Used during startup to detect startup of dumped Emacs. */
1845 extern MODULE_API int initialized; 1958 extern MODULE_API int initialized;
1846 1959
1847 #ifdef PDUMP 1960 #ifdef PDUMP
1848 #include "dumper.h" 1961 #include "dumper.h"
1849 #ifdef MC_ALLOC 1962 #ifdef NEW_GC
1850 #define DUMPEDP(adr) 0 1963 #define DUMPEDP(adr) 0
1851 #else /* not MC_ALLOC */ 1964 #else /* not NEW_GC */
1852 #define DUMPEDP(adr) ((((Rawbyte *) (adr)) < pdump_end) && \ 1965 #define DUMPEDP(adr) ((((Rawbyte *) (adr)) < pdump_end) && \
1853 (((Rawbyte *) (adr)) >= pdump_start)) 1966 (((Rawbyte *) (adr)) >= pdump_start))
1854 #endif /* not MC_ALLOC */ 1967 #endif /* not NEW_GC */
1855 #else 1968 #else
1856 #define DUMPEDP(adr) 0 1969 #define DUMPEDP(adr) 0
1857 #endif 1970 #endif
1858 1971
1859 #define OBJECT_DUMPED_P(obj) DUMPEDP (XPNTR (obj)) 1972 #define OBJECT_DUMPED_P(obj) DUMPEDP (XPNTR (obj))