Mercurial > hg > xemacs-beta
annotate src/lrecord.h @ 4792:95b04754ea8c
Make #'equalp more compatible with CL; add a compiler macro, test & doc it.
lisp/ChangeLog addition:
2009-11-08 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (cl-string-vector-equalp)
(cl-bit-vector-vector-equalp, cl-vector-array-equalp)
(cl-hash-table-contents-equalp): New functions, to implement
equalp treating arrays with identical contents as equivalent, as
specified by Common Lisp.
(equalp): Revise this function to implement array equivalence,
and the hash-table equalp behaviour specified by CL.
* cl-macs.el (equalp): Add a compiler macro for this function,
used when one of the arguments is constant, and as such, its type
is known at compile time.
man/ChangeLog addition:
2009-11-08 Aidan Kehoe <kehoea@parhasard.net>
* lispref/objects.texi (Equality Predicates):
Document #'equalp here, as well as #'equal and #'eq.
tests/ChangeLog addition:
2009-12-31 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-tests.el:
Test much of the functionality of equalp; add a pointer to Paul
Dietz' ANSI test suite for this function, converted to Emacs
Lisp. Not including the tests themselves in XEmacs because who
owns the copyright on the files is unclear and the GCL people
didn't respond to my queries.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Thu, 31 Dec 2009 15:09:41 +0000 |
| parents | 8f1ee2d15784 |
| children | 91b3d00e717f e0db3c197671 |
| rev | line source |
|---|---|
| 428 | 1 /* The "lrecord" structure (header of a compound lisp object). |
| 2 Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc. | |
| 3017 | 3 Copyright (C) 1996, 2001, 2002, 2004, 2005 Ben Wing. |
| 428 | 4 |
| 5 This file is part of XEmacs. | |
| 6 | |
| 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 | |
| 9 Free Software Foundation; either version 2, or (at your option) any | |
| 10 later version. | |
| 11 | |
| 12 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 15 for more details. | |
| 16 | |
| 17 You should have received a copy of the GNU General Public License | |
| 18 along with XEmacs; see the file COPYING. If not, write to | |
| 19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 20 Boston, MA 02111-1307, USA. */ | |
| 21 | |
| 22 /* Synched up with: Not in FSF. */ | |
| 23 | |
| 2367 | 24 /* This file has been Mule-ized, Ben Wing, 10-13-04. */ |
| 25 | |
| 440 | 26 #ifndef INCLUDED_lrecord_h_ |
| 27 #define INCLUDED_lrecord_h_ | |
| 428 | 28 |
| 3263 | 29 #ifdef NEW_GC |
| 2720 | 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 | |
| 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 | |
| 34 its type marked in it, thereby increasing its size.) All lrecords | |
| 35 begin with a `struct lrecord_header', which identifies the lisp | |
| 36 object type, by providing an index into a table of `struct | |
| 37 lrecord_implementation', which describes the behavior of the lisp | |
| 38 object. It also contains some other data bits. | |
| 39 | |
| 40 Creating a new lrecord type is fairly easy; just follow the | |
| 41 lead of some existing type (e.g. hash tables). Note that you | |
| 42 do not need to supply all the methods (see below); reasonable | |
| 43 defaults are provided for many of them. Alternatively, if you're | |
| 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 | |
| 46 the opaque type. | |
| 47 */ | |
| 3263 | 48 #else /* not NEW_GC */ |
| 428 | 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 | |
| 442 | 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 | |
| 53 in it, thereby increasing its size.) All lrecords begin with a | |
| 54 `struct lrecord_header', which identifies the lisp object type, by | |
| 55 providing an index into a table of `struct lrecord_implementation', | |
| 56 which describes the behavior of the lisp object. It also contains | |
| 57 some other data bits. | |
| 428 | 58 |
| 59 Lrecords are of two types: straight lrecords, and lcrecords. | |
| 60 Straight lrecords are used for those types of objects that have | |
| 61 their own allocation routines (typically allocated out of 2K chunks | |
| 62 of memory called `frob blocks'). These objects have a `struct | |
| 63 lrecord_header' at the top, containing only the bits needed to find | |
| 64 the lrecord_implementation for the object. There are special | |
| 1204 | 65 routines in alloc.c to create an object of each such type. |
| 428 | 66 |
| 442 | 67 Lcrecords are used for less common sorts of objects that don't do |
| 68 their own allocation. Each such object is malloc()ed individually, | |
| 69 and the objects are chained together through a `next' pointer. | |
| 3024 | 70 Lcrecords have a `struct old_lcrecord_header' at the top, which |
| 442 | 71 contains a `struct lrecord_header' and a `next' pointer, and are |
| 3024 | 72 allocated using old_alloc_lcrecord_type() or its variants. |
| 428 | 73 |
| 74 Creating a new lcrecord type is fairly easy; just follow the | |
| 75 lead of some existing type (e.g. hash tables). Note that you | |
| 76 do not need to supply all the methods (see below); reasonable | |
| 77 defaults are provided for many of them. Alternatively, if you're | |
| 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 | |
| 1204 | 80 the opaque type. --ben |
| 81 */ | |
| 3263 | 82 #endif /* not NEW_GC */ |
| 428 | 83 |
| 3263 | 84 #ifdef NEW_GC |
| 3024 | 85 #define ALLOC_LCRECORD_TYPE alloc_lrecord_type |
| 86 #define COPY_SIZED_LCRECORD copy_sized_lrecord | |
| 87 #define COPY_LCRECORD copy_lrecord | |
| 88 #define LISPOBJ_STORAGE_SIZE(ptr, size, stats) \ | |
| 89 mc_alloced_storage_size (size, stats) | |
| 90 #define ZERO_LCRECORD zero_lrecord | |
| 91 #define LCRECORD_HEADER lrecord_header | |
| 92 #define BASIC_ALLOC_LCRECORD alloc_lrecord | |
| 93 #define FREE_LCRECORD free_lrecord | |
| 3263 | 94 #else /* not NEW_GC */ |
| 3024 | 95 #define ALLOC_LCRECORD_TYPE old_alloc_lcrecord_type |
| 96 #define COPY_SIZED_LCRECORD old_copy_sized_lcrecord | |
| 97 #define COPY_LCRECORD old_copy_lcrecord | |
| 98 #define LISPOBJ_STORAGE_SIZE malloced_storage_size | |
| 99 #define ZERO_LCRECORD old_zero_lcrecord | |
| 100 #define LCRECORD_HEADER old_lcrecord_header | |
| 101 #define BASIC_ALLOC_LCRECORD old_basic_alloc_lcrecord | |
| 102 #define FREE_LCRECORD old_free_lcrecord | |
| 3263 | 103 #endif /* not NEW_GC */ |
| 3024 | 104 |
| 1743 | 105 BEGIN_C_DECLS |
| 1650 | 106 |
| 428 | 107 struct lrecord_header |
| 108 { | |
| 1204 | 109 /* Index into lrecord_implementations_table[]. Objects that have been |
| 110 explicitly freed using e.g. free_cons() have lrecord_type_free in this | |
| 111 field. */ | |
| 442 | 112 unsigned int type :8; |
| 113 | |
| 3263 | 114 #ifdef NEW_GC |
| 2720 | 115 /* 1 if the object is readonly from lisp */ |
| 116 unsigned int lisp_readonly :1; | |
| 117 | |
| 118 /* The `free' field is a flag that indicates whether this lrecord | |
| 119 is currently free or not. This is used for error checking and | |
| 120 debugging. */ | |
| 121 unsigned int free :1; | |
| 122 | |
| 3063 | 123 /* The `uid' field is just for debugging/printing convenience. Having |
| 124 this slot doesn't hurt us spacewise, since the bits are unused | |
| 125 anyway. (The bits are used for strings, though.) */ | |
| 2720 | 126 unsigned int uid :22; |
| 127 | |
| 3263 | 128 #else /* not NEW_GC */ |
| 442 | 129 /* If `mark' is 0 after the GC mark phase, the object will be freed |
| 130 during the GC sweep phase. There are 2 ways that `mark' can be 1: | |
| 131 - by being referenced from other objects during the GC mark phase | |
| 132 - because it is permanently on, for c_readonly objects */ | |
| 133 unsigned int mark :1; | |
| 134 | |
| 135 /* 1 if the object resides in logically read-only space, and does not | |
| 136 reference other non-c_readonly objects. | |
| 137 Invariant: if (c_readonly == 1), then (mark == 1 && lisp_readonly == 1) */ | |
| 138 unsigned int c_readonly :1; | |
| 139 | |
| 428 | 140 /* 1 if the object is readonly from lisp */ |
| 442 | 141 unsigned int lisp_readonly :1; |
| 771 | 142 |
| 3063 | 143 /* The `uid' field is just for debugging/printing convenience. Having |
| 144 this slot doesn't hurt us spacewise, since the bits are unused | |
| 145 anyway. (The bits are used for strings, though.) */ | |
| 146 unsigned int uid :21; | |
| 934 | 147 |
| 3263 | 148 #endif /* not NEW_GC */ |
| 428 | 149 }; |
| 150 | |
| 151 struct lrecord_implementation; | |
| 442 | 152 int lrecord_type_index (const struct lrecord_implementation *implementation); |
| 3063 | 153 extern int lrecord_uid_counter; |
| 428 | 154 |
| 3263 | 155 #ifdef NEW_GC |
| 2720 | 156 #define set_lheader_implementation(header,imp) do { \ |
| 157 struct lrecord_header* SLI_header = (header); \ | |
| 158 SLI_header->type = (imp)->lrecord_type_index; \ | |
| 159 SLI_header->lisp_readonly = 0; \ | |
| 160 SLI_header->free = 0; \ | |
| 3063 | 161 SLI_header->uid = lrecord_uid_counter++; \ |
| 2720 | 162 } while (0) |
| 3263 | 163 #else /* not NEW_GC */ |
| 430 | 164 #define set_lheader_implementation(header,imp) do { \ |
| 428 | 165 struct lrecord_header* SLI_header = (header); \ |
| 442 | 166 SLI_header->type = (imp)->lrecord_type_index; \ |
| 430 | 167 SLI_header->mark = 0; \ |
| 168 SLI_header->c_readonly = 0; \ | |
| 169 SLI_header->lisp_readonly = 0; \ | |
| 3063 | 170 SLI_header->uid = lrecord_uid_counter++; \ |
| 428 | 171 } while (0) |
| 3263 | 172 #endif /* not NEW_GC */ |
| 428 | 173 |
| 3263 | 174 #ifndef NEW_GC |
| 3024 | 175 struct old_lcrecord_header |
| 428 | 176 { |
| 177 struct lrecord_header lheader; | |
| 178 | |
| 442 | 179 /* The `next' field is normally used to chain all lcrecords together |
| 428 | 180 so that the GC can find (and free) all of them. |
| 3024 | 181 `old_basic_alloc_lcrecord' threads lcrecords together. |
| 428 | 182 |
| 183 The `next' field may be used for other purposes as long as some | |
| 184 other mechanism is provided for letting the GC do its work. | |
| 185 | |
| 186 For example, the event and marker object types allocate members | |
| 187 out of memory chunks, and are able to find all unmarked members | |
| 188 by sweeping through the elements of the list of chunks. */ | |
| 3024 | 189 struct old_lcrecord_header *next; |
| 428 | 190 |
| 191 /* The `uid' field is just for debugging/printing convenience. | |
| 192 Having this slot doesn't hurt us much spacewise, since an | |
| 193 lcrecord already has the above slots plus malloc overhead. */ | |
| 194 unsigned int uid :31; | |
| 195 | |
| 196 /* The `free' field is a flag that indicates whether this lcrecord | |
| 197 is on a "free list". Free lists are used to minimize the number | |
| 198 of calls to malloc() when we're repeatedly allocating and freeing | |
| 199 a number of the same sort of lcrecord. Lcrecords on a free list | |
| 200 always get marked in a different fashion, so we can use this flag | |
| 201 as a sanity check to make sure that free lists only have freed | |
| 202 lcrecords and there are no freed lcrecords elsewhere. */ | |
| 203 unsigned int free :1; | |
| 204 }; | |
| 205 | |
| 206 /* Used for lcrecords in an lcrecord-list. */ | |
| 207 struct free_lcrecord_header | |
| 208 { | |
| 3024 | 209 struct old_lcrecord_header lcheader; |
| 428 | 210 Lisp_Object chain; |
| 211 }; | |
| 3263 | 212 #endif /* not NEW_GC */ |
| 428 | 213 |
| 3931 | 214 /* DON'T FORGET to update .gdbinit.in if you change this list. */ |
| 442 | 215 enum lrecord_type |
| 216 { | |
| 217 /* Symbol value magic types come first to make SYMBOL_VALUE_MAGIC_P fast. | |
| 218 #### This should be replaced by a symbol_value_magic_p flag | |
| 219 in the Lisp_Symbol lrecord_header. */ | |
| 2720 | 220 lrecord_type_symbol_value_forward, /* 0 */ |
| 3092 | 221 lrecord_type_symbol_value_varalias, |
| 222 lrecord_type_symbol_value_lisp_magic, | |
| 223 lrecord_type_symbol_value_buffer_local, | |
| 442 | 224 lrecord_type_max_symbol_value_magic = lrecord_type_symbol_value_buffer_local, |
| 3092 | 225 lrecord_type_symbol, |
| 226 lrecord_type_subr, | |
|
4677
8f1ee2d15784
Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3931
diff
changeset
|
227 lrecord_type_multiple_value, |
| 3092 | 228 lrecord_type_cons, |
| 229 lrecord_type_vector, | |
| 230 lrecord_type_string, | |
| 3263 | 231 #ifndef NEW_GC |
| 442 | 232 lrecord_type_lcrecord_list, |
| 3263 | 233 #endif /* not NEW_GC */ |
| 3092 | 234 lrecord_type_compiled_function, |
| 235 lrecord_type_weak_list, | |
| 236 lrecord_type_bit_vector, | |
| 237 lrecord_type_float, | |
| 238 lrecord_type_hash_table, | |
| 239 lrecord_type_lstream, | |
| 240 lrecord_type_process, | |
| 241 lrecord_type_charset, | |
| 242 lrecord_type_coding_system, | |
| 243 lrecord_type_char_table, | |
| 244 lrecord_type_char_table_entry, | |
| 245 lrecord_type_range_table, | |
| 246 lrecord_type_opaque, | |
| 247 lrecord_type_opaque_ptr, | |
| 248 lrecord_type_buffer, | |
| 249 lrecord_type_extent, | |
| 250 lrecord_type_extent_info, | |
| 251 lrecord_type_extent_auxiliary, | |
| 252 lrecord_type_marker, | |
| 253 lrecord_type_event, | |
| 2720 | 254 #ifdef EVENT_DATA_AS_OBJECTS /* not defined */ |
| 934 | 255 lrecord_type_key_data, |
| 256 lrecord_type_button_data, | |
| 257 lrecord_type_motion_data, | |
| 258 lrecord_type_process_data, | |
| 259 lrecord_type_timeout_data, | |
| 260 lrecord_type_eval_data, | |
| 261 lrecord_type_misc_user_data, | |
| 262 lrecord_type_magic_eval_data, | |
| 263 lrecord_type_magic_data, | |
| 1204 | 264 #endif /* EVENT_DATA_AS_OBJECTS */ |
| 3092 | 265 lrecord_type_keymap, |
| 266 lrecord_type_command_builder, | |
| 267 lrecord_type_timeout, | |
| 268 lrecord_type_specifier, | |
| 269 lrecord_type_console, | |
| 270 lrecord_type_device, | |
| 271 lrecord_type_frame, | |
| 272 lrecord_type_window, | |
| 273 lrecord_type_window_mirror, | |
| 274 lrecord_type_window_configuration, | |
| 275 lrecord_type_gui_item, | |
| 276 lrecord_type_popup_data, | |
| 277 lrecord_type_toolbar_button, | |
| 278 lrecord_type_scrollbar_instance, | |
| 279 lrecord_type_color_instance, | |
| 280 lrecord_type_font_instance, | |
| 281 lrecord_type_image_instance, | |
| 282 lrecord_type_glyph, | |
| 283 lrecord_type_face, | |
| 3931 | 284 lrecord_type_fc_config, |
| 3094 | 285 lrecord_type_fc_pattern, |
| 3092 | 286 lrecord_type_database, |
| 287 lrecord_type_tooltalk_message, | |
| 288 lrecord_type_tooltalk_pattern, | |
| 289 lrecord_type_ldap, | |
| 290 lrecord_type_pgconn, | |
| 291 lrecord_type_pgresult, | |
| 292 lrecord_type_devmode, | |
| 293 lrecord_type_mswindows_dialog_id, | |
| 294 lrecord_type_case_table, | |
| 295 lrecord_type_emacs_ffi, | |
| 296 lrecord_type_emacs_gtk_object, | |
| 297 lrecord_type_emacs_gtk_boxed, | |
| 298 lrecord_type_weak_box, | |
| 299 lrecord_type_ephemeron, | |
| 300 lrecord_type_bignum, | |
| 301 lrecord_type_ratio, | |
| 302 lrecord_type_bigfloat, | |
| 3263 | 303 #ifndef NEW_GC |
| 454 | 304 lrecord_type_free, /* only used for "free" lrecords */ |
| 305 lrecord_type_undefined, /* only used for debugging */ | |
| 3263 | 306 #endif /* not NEW_GC */ |
| 3092 | 307 #ifdef NEW_GC |
| 308 lrecord_type_string_indirect_data, | |
| 309 lrecord_type_string_direct_data, | |
| 310 lrecord_type_hash_table_entry, | |
| 311 lrecord_type_syntax_cache, | |
| 312 lrecord_type_buffer_text, | |
| 313 lrecord_type_compiled_function_args, | |
| 314 lrecord_type_tty_console, | |
| 315 lrecord_type_stream_console, | |
| 316 lrecord_type_dynarr, | |
| 317 lrecord_type_face_cachel, | |
| 318 lrecord_type_face_cachel_dynarr, | |
| 319 lrecord_type_glyph_cachel, | |
| 320 lrecord_type_glyph_cachel_dynarr, | |
| 321 lrecord_type_x_device, | |
| 322 lrecord_type_gtk_device, | |
| 323 lrecord_type_tty_device, | |
| 324 lrecord_type_mswindows_device, | |
| 325 lrecord_type_msprinter_device, | |
| 326 lrecord_type_x_frame, | |
| 327 lrecord_type_gtk_frame, | |
| 328 lrecord_type_mswindows_frame, | |
| 329 lrecord_type_gap_array_marker, | |
| 330 lrecord_type_gap_array, | |
| 331 lrecord_type_extent_list_marker, | |
| 332 lrecord_type_extent_list, | |
| 333 lrecord_type_stack_of_extents, | |
| 334 lrecord_type_tty_color_instance_data, | |
| 335 lrecord_type_tty_font_instance_data, | |
| 336 lrecord_type_specifier_caching, | |
| 337 lrecord_type_expose_ignore, | |
| 338 #endif /* NEW_GC */ | |
| 339 lrecord_type_last_built_in_type /* must be last */ | |
| 442 | 340 }; |
| 341 | |
| 1632 | 342 extern MODULE_API int lrecord_type_count; |
| 428 | 343 |
| 344 struct lrecord_implementation | |
| 345 { | |
| 2367 | 346 const Ascbyte *name; |
| 442 | 347 |
| 934 | 348 /* information for the dumper: is the object dumpable and should it |
| 349 be dumped. */ | |
| 350 unsigned int dumpable :1; | |
| 351 | |
| 442 | 352 /* `marker' is called at GC time, to make sure that all Lisp_Objects |
| 428 | 353 pointed to by this object get properly marked. It should call |
| 354 the mark_object function on all Lisp_Objects in the object. If | |
| 355 the return value is non-nil, it should be a Lisp_Object to be | |
| 356 marked (don't call the mark_object function explicitly on it, | |
| 357 because the GC routines will do this). Doing it this way reduces | |
| 358 recursion, so the object returned should preferably be the one | |
| 359 with the deepest level of Lisp_Object pointers. This function | |
| 1204 | 360 can be NULL, meaning no GC marking is necessary. |
| 361 | |
| 362 NOTE NOTE NOTE: This is not used by KKCC (which uses the data | |
| 363 description below instead), unless the data description is missing. | |
| 364 Yes, this currently means there is logic duplication. Eventually the | |
| 365 mark methods will be removed. */ | |
| 428 | 366 Lisp_Object (*marker) (Lisp_Object); |
| 442 | 367 |
| 368 /* `printer' converts the object to a printed representation. | |
| 369 This can be NULL; in this case default_object_printer() will be | |
| 370 used instead. */ | |
| 428 | 371 void (*printer) (Lisp_Object, Lisp_Object printcharfun, int escapeflag); |
| 442 | 372 |
| 373 /* `finalizer' is called at GC time when the object is about to | |
| 428 | 374 be freed, and at dump time (FOR_DISKSAVE will be non-zero in this |
| 375 case). It should perform any necessary cleanup (e.g. freeing | |
| 442 | 376 malloc()ed memory). This can be NULL, meaning no special |
| 428 | 377 finalization is necessary. |
| 378 | |
| 442 | 379 WARNING: remember that `finalizer' is called at dump time even |
| 428 | 380 though the object is not being freed. */ |
| 381 void (*finalizer) (void *header, int for_disksave); | |
| 442 | 382 |
| 428 | 383 /* This can be NULL, meaning compare objects with EQ(). */ |
| 384 int (*equal) (Lisp_Object obj1, Lisp_Object obj2, int depth); | |
| 442 | 385 |
| 386 /* `hash' generates hash values for use with hash tables that have | |
| 387 `equal' as their test function. This can be NULL, meaning use | |
| 388 the Lisp_Object itself as the hash. But, you must still satisfy | |
| 389 the constraint that if two objects are `equal', then they *must* | |
| 390 hash to the same value in order for hash tables to work properly. | |
| 391 This means that `hash' can be NULL only if the `equal' method is | |
| 392 also NULL. */ | |
| 2515 | 393 Hashcode (*hash) (Lisp_Object, int); |
| 428 | 394 |
| 1204 | 395 /* Data layout description for your object. See long comment below. */ |
| 396 const struct memory_description *description; | |
| 428 | 397 |
| 442 | 398 /* These functions allow any object type to have builtin property |
| 399 lists that can be manipulated from the lisp level with | |
| 400 `get', `put', `remprop', and `object-plist'. */ | |
| 428 | 401 Lisp_Object (*getprop) (Lisp_Object obj, Lisp_Object prop); |
| 402 int (*putprop) (Lisp_Object obj, Lisp_Object prop, Lisp_Object val); | |
| 403 int (*remprop) (Lisp_Object obj, Lisp_Object prop); | |
| 404 Lisp_Object (*plist) (Lisp_Object obj); | |
| 405 | |
| 3263 | 406 #ifdef NEW_GC |
| 2720 | 407 /* Only one of `static_size' and `size_in_bytes_method' is non-0. */ |
| 3263 | 408 #else /* not NEW_GC */ |
| 442 | 409 /* Only one of `static_size' and `size_in_bytes_method' is non-0. |
| 3024 | 410 If both are 0, this type is not instantiable by |
| 411 old_basic_alloc_lcrecord(). */ | |
| 3263 | 412 #endif /* not NEW_GC */ |
| 665 | 413 Bytecount static_size; |
| 414 Bytecount (*size_in_bytes_method) (const void *header); | |
| 442 | 415 |
| 416 /* The (constant) index into lrecord_implementations_table */ | |
| 417 enum lrecord_type lrecord_type_index; | |
| 418 | |
| 3263 | 419 #ifndef NEW_GC |
| 428 | 420 /* A "basic" lrecord is any lrecord that's not an lcrecord, i.e. |
| 3024 | 421 one that does not have an old_lcrecord_header at the front and which |
| 1204 | 422 is (usually) allocated in frob blocks. */ |
| 442 | 423 unsigned int basic_p :1; |
| 3263 | 424 #endif /* not NEW_GC */ |
| 428 | 425 }; |
| 426 | |
| 617 | 427 /* All the built-in lisp object types are enumerated in `enum lrecord_type'. |
| 442 | 428 Additional ones may be defined by a module (none yet). We leave some |
| 429 room in `lrecord_implementations_table' for such new lisp object types. */ | |
| 430 #define MODULE_DEFINABLE_TYPE_COUNT 32 | |
| 431 | |
| 1632 | 432 extern MODULE_API const struct lrecord_implementation * |
| 433 lrecord_implementations_table[lrecord_type_last_built_in_type + MODULE_DEFINABLE_TYPE_COUNT]; | |
| 428 | 434 |
| 435 #define XRECORD_LHEADER_IMPLEMENTATION(obj) \ | |
| 442 | 436 LHEADER_IMPLEMENTATION (XRECORD_LHEADER (obj)) |
| 437 #define LHEADER_IMPLEMENTATION(lh) lrecord_implementations_table[(lh)->type] | |
| 428 | 438 |
| 3092 | 439 #include "gc.h" |
| 440 | |
| 441 #ifdef NEW_GC | |
| 442 #include "vdb.h" | |
| 443 #endif /* NEW_GC */ | |
| 444 | |
| 428 | 445 extern int gc_in_progress; |
| 446 | |
| 3263 | 447 #ifdef NEW_GC |
| 2720 | 448 #include "mc-alloc.h" |
| 449 | |
| 2994 | 450 #ifdef ALLOC_TYPE_STATS |
| 2720 | 451 void init_lrecord_stats (void); |
| 452 void inc_lrecord_stats (Bytecount size, const struct lrecord_header *h); | |
| 453 void dec_lrecord_stats (Bytecount size_including_overhead, | |
| 454 const struct lrecord_header *h); | |
| 3092 | 455 int lrecord_stats_heap_size (void); |
| 2994 | 456 #endif /* ALLOC_TYPE_STATS */ |
| 2720 | 457 |
| 458 /* Tell mc-alloc how to call a finalizer. */ | |
| 3092 | 459 #define MC_ALLOC_CALL_FINALIZER(ptr) \ |
| 460 { \ | |
| 461 Lisp_Object MCACF_obj = wrap_pointer_1 (ptr); \ | |
| 462 struct lrecord_header *MCACF_lheader = XRECORD_LHEADER (MCACF_obj); \ | |
| 463 if (XRECORD_LHEADER (MCACF_obj) && LRECORDP (MCACF_obj) \ | |
| 464 && !LRECORD_FREE_P (MCACF_lheader) ) \ | |
| 465 { \ | |
| 466 const struct lrecord_implementation *MCACF_implementation \ | |
| 467 = LHEADER_IMPLEMENTATION (MCACF_lheader); \ | |
| 468 if (MCACF_implementation && MCACF_implementation->finalizer) \ | |
| 469 { \ | |
| 470 GC_STAT_FINALIZED; \ | |
| 471 MCACF_implementation->finalizer (ptr, 0); \ | |
| 472 } \ | |
| 473 } \ | |
| 474 } while (0) | |
| 2720 | 475 |
| 476 /* Tell mc-alloc how to call a finalizer for disksave. */ | |
| 477 #define MC_ALLOC_CALL_FINALIZER_FOR_DISKSAVE(ptr) \ | |
| 478 { \ | |
| 479 Lisp_Object MCACF_obj = wrap_pointer_1 (ptr); \ | |
| 480 struct lrecord_header *MCACF_lheader = XRECORD_LHEADER (MCACF_obj); \ | |
| 481 if (XRECORD_LHEADER (MCACF_obj) && LRECORDP (MCACF_obj) \ | |
| 482 && !LRECORD_FREE_P (MCACF_lheader) ) \ | |
| 483 { \ | |
| 484 const struct lrecord_implementation *MCACF_implementation \ | |
| 485 = LHEADER_IMPLEMENTATION (MCACF_lheader); \ | |
| 486 if (MCACF_implementation && MCACF_implementation->finalizer) \ | |
| 487 MCACF_implementation->finalizer (ptr, 1); \ | |
| 488 } \ | |
| 489 } while (0) | |
| 490 | |
| 491 #define LRECORD_FREE_P(ptr) \ | |
| 492 (((struct lrecord_header *) ptr)->free) | |
| 493 | |
| 494 #define MARK_LRECORD_AS_FREE(ptr) \ | |
| 495 ((void) (((struct lrecord_header *) ptr)->free = 1)) | |
| 496 | |
| 497 #define MARK_LRECORD_AS_NOT_FREE(ptr) \ | |
| 498 ((void) (((struct lrecord_header *) ptr)->free = 0)) | |
| 499 | |
| 500 #define MARKED_RECORD_P(obj) MARKED_P (obj) | |
| 501 #define MARKED_RECORD_HEADER_P(lheader) MARKED_P (lheader) | |
| 502 #define MARK_RECORD_HEADER(lheader) MARK (lheader) | |
| 503 #define UNMARK_RECORD_HEADER(lheader) UNMARK (lheader) | |
| 504 | |
| 505 #define LISP_READONLY_RECORD_HEADER_P(lheader) ((lheader)->lisp_readonly) | |
| 506 #define SET_LISP_READONLY_RECORD_HEADER(lheader) \ | |
| 507 ((void) ((lheader)->lisp_readonly = 1)) | |
| 508 #define MARK_LRECORD_AS_LISP_READONLY(ptr) \ | |
| 509 ((void) (((struct lrecord_header *) ptr)->lisp_readonly = 1)) | |
| 510 | |
| 3263 | 511 #else /* not NEW_GC */ |
| 2720 | 512 |
| 513 #define LRECORD_FREE_P(ptr) \ | |
| 514 (((struct lrecord_header *) ptr)->type == lrecord_type_free) | |
| 515 | |
| 516 #define MARK_LRECORD_AS_FREE(ptr) \ | |
| 517 ((void) (((struct lrecord_header *) ptr)->type = lrecord_type_free)) | |
| 518 | |
| 442 | 519 #define MARKED_RECORD_P(obj) (XRECORD_LHEADER (obj)->mark) |
| 428 | 520 #define MARKED_RECORD_HEADER_P(lheader) ((lheader)->mark) |
| 521 #define MARK_RECORD_HEADER(lheader) ((void) ((lheader)->mark = 1)) | |
| 522 #define UNMARK_RECORD_HEADER(lheader) ((void) ((lheader)->mark = 0)) | |
| 523 | |
| 524 #define C_READONLY_RECORD_HEADER_P(lheader) ((lheader)->c_readonly) | |
| 525 #define LISP_READONLY_RECORD_HEADER_P(lheader) ((lheader)->lisp_readonly) | |
| 442 | 526 #define SET_C_READONLY_RECORD_HEADER(lheader) do { \ |
| 527 struct lrecord_header *SCRRH_lheader = (lheader); \ | |
| 528 SCRRH_lheader->c_readonly = 1; \ | |
| 529 SCRRH_lheader->lisp_readonly = 1; \ | |
| 530 SCRRH_lheader->mark = 1; \ | |
| 531 } while (0) | |
| 428 | 532 #define SET_LISP_READONLY_RECORD_HEADER(lheader) \ |
| 533 ((void) ((lheader)->lisp_readonly = 1)) | |
| 3263 | 534 #endif /* not NEW_GC */ |
| 1676 | 535 |
| 536 #ifdef USE_KKCC | |
| 537 #define RECORD_DESCRIPTION(lheader) lrecord_memory_descriptions[(lheader)->type] | |
| 538 #else /* not USE_KKCC */ | |
| 442 | 539 #define RECORD_MARKER(lheader) lrecord_markers[(lheader)->type] |
| 1676 | 540 #endif /* not USE_KKCC */ |
| 428 | 541 |
| 934 | 542 #define RECORD_DUMPABLE(lheader) (lrecord_implementations_table[(lheader)->type])->dumpable |
| 1204 | 543 |
| 544 /* Data description stuff | |
| 934 | 545 |
| 1204 | 546 Data layout descriptions describe blocks of memory (in particular, Lisp |
| 547 objects and other objects on the heap, and global objects with pointers | |
| 548 to such heap objects), including their size and a list of the elements | |
| 549 that need relocating, marking or other special handling. They are | |
| 550 currently used in two places: by pdump [the new, portable dumper] and | |
| 551 KKCC [the new garbage collector]. The two subsystems use the | |
| 552 descriptions in different ways, and as a result some of the descriptions | |
| 553 are appropriate only for one or the other, when it is known that only | |
| 554 that subsystem will use the description. (This is particularly the case | |
| 555 with objects that can't be dumped, because pdump needs more info than | |
| 556 KKCC.) However, properly written descriptions are appropriate for both, | |
| 557 and you should strive to write your descriptions that way, since the | |
| 558 dumpable status of an object may change and new uses for the | |
| 559 descriptions may be created. (An example that comes to mind is a | |
| 560 facility for determining the memory usage of XEmacs data structures -- | |
| 561 like `buffer-memory-usage', `window-memory-usage', etc. but more | |
| 562 general.) | |
| 563 | |
| 564 More specifically: | |
| 428 | 565 |
| 1204 | 566 Pdump (the portable dumper) needs to write out all objects in heap |
| 567 space, and later on (in another invocation of XEmacs) load them back | |
| 568 into the heap, relocating all pointers to the heap objects in the global | |
| 569 data space. ("Heap" means anything malloc()ed, including all Lisp | |
| 570 objects, and "global data" means anything declared globally or | |
| 571 `static'.) Pdump, then, needs to be told about the location of all | |
| 572 global pointers to heap objects, all the description of all such | |
| 573 objects, including their size and any pointers to other heap (aka | |
| 574 "relocatable") objects. (Pdump assumes that the heap may occur in | |
| 575 different places in different invocations -- therefore, it is not enough | |
| 576 simply to write out the entire heap and later reload it at the same | |
| 577 location -- but that global data is always in the same place, and hence | |
| 578 pointers to it do not need to be relocated. This assumption holds true | |
| 579 in general for modern operating systems, but would be broken, for | |
| 580 example, in a system without virtual memory, or when dealing with shared | |
| 581 libraries. Also, unlike unexec, pdump does not usually write out or | |
| 582 restore objects in the global data space, and thus they need to be | |
| 583 initialized every time XEmacs is loaded. This is the purpose of the | |
| 584 reinit_*() functions throughout XEmacs. [It's possible, however, to make | |
| 585 pdump restore global data. This must be done, of course, for heap | |
| 586 pointers, but is also done for other values that are not easy to | |
| 587 recompute -- in particular, values established by the Lisp code loaded | |
| 588 at dump time.]) Note that the data type `Lisp_Object' is basically just | |
| 589 a relocatable pointer disguised as a long, and in general pdump treats | |
| 590 the Lisp_Object values and pointers to Lisp objects (e.g. Lisp_Object | |
| 591 vs. `struct frame *') identically. (NOTE: This equivalence depends | |
| 592 crucially on the current "minimal tagbits" implementation of Lisp_Object | |
| 593 pointers.) | |
| 428 | 594 |
| 1204 | 595 Descriptions are used by pdump in three places: (a) descriptions of Lisp |
| 596 objects, referenced in the DEFINE_*LRECORD_*IMPLEMENTATION*() call; (b) | |
| 597 descriptions of global objects to be dumped, registered by | |
| 598 dump_add_root_block(); (c) descriptions of global pointers to | |
| 2367 | 599 non-Lisp_Object heap objects, registered by dump_add_root_block_ptr(). |
| 1204 | 600 The descriptions need to tell pdump which elements of your structure are |
| 601 Lisp_Objects or structure pointers, plus the descriptions in turn of the | |
| 602 non-Lisp_Object structures pointed to. If these structures are you own | |
| 603 private ones, you will have to write these recursive descriptions | |
| 604 yourself; otherwise, you are reusing a structure already in existence | |
| 605 elsewhere and there is probably already a description for it. | |
| 606 | |
| 607 Pdump does not care about Lisp objects that cannot be dumped (the | |
| 608 dumpable flag to DEFINE_*LRECORD_*IMPLEMENTATION*() is 0). | |
| 609 | |
| 610 KKCC also uses data layout descriptions, but differently. It cares | |
| 611 about all objects, dumpable or not, but specifically only wants to know | |
| 612 about Lisp_Objects in your object and in structures pointed to. Thus, | |
| 613 it doesn't care about things like pointers to structures ot other blocks | |
| 614 of memory with no Lisp Objects in them, which pdump would care a lot | |
| 615 about. | |
| 616 | |
| 617 Technically, then, you could write your description differently | |
| 618 depending on whether your object is dumpable -- the full pdump | |
| 619 description if so, the abbreviated KKCC description if not. In fact, | |
| 620 some descriptions are written this way. This is dangerous, though, | |
| 621 because another use might come along for the data descriptions, that | |
| 622 doesn't care about the dumper flag and makes use of some of the stuff | |
| 623 normally omitted from the "abbreviated" description -- see above. | |
| 624 | |
| 625 A memory_description is an array of values. (This is actually | |
| 771 | 626 misnamed, in that it does not just describe lrecords, but any |
| 627 blocks of memory.) The first value of each line is a type, the | |
| 628 second the offset in the lrecord structure. The third and | |
| 629 following elements are parameters; their presence, type and number | |
| 630 is type-dependent. | |
| 631 | |
| 1204 | 632 The description ends with an "XD_END" record. |
| 771 | 633 |
| 634 The top-level description of an lrecord or lcrecord does not need | |
| 635 to describe every element, just the ones that need to be relocated, | |
| 636 since the size of the lrecord is known. (The same goes for nested | |
| 637 structures, whenever the structure size is given, rather than being | |
| 638 defaulted by specifying 0 for the size.) | |
| 639 | |
| 1204 | 640 A sized_memory_description is a memory_description plus the size of the |
| 641 block of memory. The size field in a sized_memory_description can be | |
| 642 given as zero, i.e. unspecified, meaning that the last element in the | |
| 643 structure is described in the description and the size of the block can | |
| 644 therefore be computed from it. (This is useful for stretchy arrays.) | |
| 645 | |
| 646 memory_descriptions are used to describe lrecords (the size of the | |
| 647 lrecord is elsewhere in its description, attached to its methods, so it | |
| 648 does not need to be given here) and global objects, where the size is an | |
| 649 argument to the call to dump_add_root_block(). | |
| 650 sized_memory_descriptions are used for pointers and arrays in | |
| 2367 | 651 memory_descriptions and for calls to dump_add_root_block_ptr(). (#### |
| 1204 | 652 It is not obvious why this is so in the latter case. Probably, calls to |
| 2367 | 653 dump_add_root_block_ptr() should use plain memory_descriptions and have |
| 1204 | 654 the size be an argument to the call.) |
| 655 | |
| 656 NOTE: Anywhere that a sized_memory_description occurs inside of a plain | |
| 657 memory_description, a "description map" can be substituted. Rather than | |
| 658 being an actual description, this describes how to find the description | |
| 659 by looking inside of the object being described. This is a convenient | |
| 660 way to describe Lisp objects with subtypes and corresponding | |
| 661 type-specific data. | |
| 428 | 662 |
| 663 Some example descriptions : | |
| 440 | 664 |
| 814 | 665 struct Lisp_String |
| 666 { | |
| 667 struct lrecord_header lheader; | |
| 668 Bytecount size; | |
| 867 | 669 Ibyte *data; |
| 814 | 670 Lisp_Object plist; |
| 671 }; | |
| 672 | |
| 1204 | 673 static const struct memory_description cons_description[] = { |
| 440 | 674 { XD_LISP_OBJECT, offsetof (Lisp_Cons, car) }, |
| 675 { XD_LISP_OBJECT, offsetof (Lisp_Cons, cdr) }, | |
| 428 | 676 { XD_END } |
| 677 }; | |
| 678 | |
| 440 | 679 Which means "two lisp objects starting at the 'car' and 'cdr' elements" |
| 428 | 680 |
| 1204 | 681 static const struct memory_description string_description[] = { |
| 814 | 682 { XD_BYTECOUNT, offsetof (Lisp_String, size) }, |
| 1204 | 683 { XD_OPAQUE_DATA_PTR, offsetof (Lisp_String, data), XD_INDIRECT (0, 1) }, |
| 814 | 684 { XD_LISP_OBJECT, offsetof (Lisp_String, plist) }, |
| 685 { XD_END } | |
| 686 }; | |
| 687 | |
| 688 "A pointer to string data at 'data', the size of the pointed array being | |
| 689 the value of the size variable plus 1, and one lisp object at 'plist'" | |
| 690 | |
| 691 If your object has a pointer to an array of Lisp_Objects in it, something | |
| 692 like this: | |
| 693 | |
| 694 struct Lisp_Foo | |
| 695 { | |
| 696 ...; | |
| 697 int count; | |
| 698 Lisp_Object *objects; | |
| 699 ...; | |
| 700 } | |
| 701 | |
| 2367 | 702 You'd use XD_BLOCK_PTR, something like: |
| 814 | 703 |
| 1204 | 704 static const struct memory_description foo_description[] = { |
| 705 ... | |
| 706 { XD_INT, offsetof (Lisp_Foo, count) }, | |
| 2367 | 707 { XD_BLOCK_PTR, offsetof (Lisp_Foo, objects), |
| 2551 | 708 XD_INDIRECT (0, 0), { &lisp_object_description } }, |
| 1204 | 709 ... |
| 710 }; | |
| 711 | |
| 712 lisp_object_description is declared in alloc.c, like this: | |
| 713 | |
| 714 static const struct memory_description lisp_object_description_1[] = { | |
| 814 | 715 { XD_LISP_OBJECT, 0 }, |
| 716 { XD_END } | |
| 717 }; | |
| 718 | |
| 1204 | 719 const struct sized_memory_description lisp_object_description = { |
| 814 | 720 sizeof (Lisp_Object), |
| 1204 | 721 lisp_object_description_1 |
| 814 | 722 }; |
| 723 | |
| 2367 | 724 Another example of XD_BLOCK_PTR: |
| 428 | 725 |
| 1204 | 726 typedef struct htentry |
| 814 | 727 { |
| 728 Lisp_Object key; | |
| 729 Lisp_Object value; | |
| 1204 | 730 } htentry; |
| 814 | 731 |
| 732 struct Lisp_Hash_Table | |
| 733 { | |
| 3017 | 734 struct LCRECORD_HEADER header; |
| 814 | 735 Elemcount size; |
| 736 Elemcount count; | |
| 737 Elemcount rehash_count; | |
| 738 double rehash_size; | |
| 739 double rehash_threshold; | |
| 740 Elemcount golden_ratio; | |
| 741 hash_table_hash_function_t hash_function; | |
| 742 hash_table_test_function_t test_function; | |
| 1204 | 743 htentry *hentries; |
| 814 | 744 enum hash_table_weakness weakness; |
| 745 Lisp_Object next_weak; // Used to chain together all of the weak | |
| 746 // hash tables. Don't mark through this. | |
| 747 }; | |
| 748 | |
| 1204 | 749 static const struct memory_description htentry_description_1[] = { |
| 750 { XD_LISP_OBJECT, offsetof (htentry, key) }, | |
| 751 { XD_LISP_OBJECT, offsetof (htentry, value) }, | |
| 814 | 752 { XD_END } |
| 753 }; | |
| 754 | |
| 1204 | 755 static const struct sized_memory_description htentry_description = { |
| 756 sizeof (htentry), | |
| 757 htentry_description_1 | |
| 814 | 758 }; |
| 759 | |
| 1204 | 760 const struct memory_description hash_table_description[] = { |
| 814 | 761 { XD_ELEMCOUNT, offsetof (Lisp_Hash_Table, size) }, |
| 2367 | 762 { XD_BLOCK_PTR, offsetof (Lisp_Hash_Table, hentries), XD_INDIRECT (0, 1), |
| 2551 | 763 { &htentry_description } }, |
| 814 | 764 { XD_LO_LINK, offsetof (Lisp_Hash_Table, next_weak) }, |
| 765 { XD_END } | |
| 766 }; | |
| 767 | |
| 768 Note that we don't need to declare all the elements in the structure, just | |
| 769 the ones that need to be relocated (Lisp_Objects and structures) or that | |
| 770 need to be referenced as counts for relocated objects. | |
| 771 | |
| 1204 | 772 A description map looks like this: |
| 773 | |
| 774 static const struct sized_memory_description specifier_extra_description_map [] = { | |
| 775 { offsetof (Lisp_Specifier, methods) }, | |
| 776 { offsetof (struct specifier_methods, extra_description) }, | |
| 777 { -1 } | |
| 778 }; | |
| 779 | |
| 780 const struct memory_description specifier_description[] = { | |
| 781 ... | |
| 2367 | 782 { XD_BLOCK_ARRAY, offset (Lisp_Specifier, data), 1, |
| 2551 | 783 { specifier_extra_description_map } }, |
| 1204 | 784 ... |
| 785 { XD_END } | |
| 786 }; | |
| 787 | |
| 788 This would be appropriate for an object that looks like this: | |
| 789 | |
| 790 struct specifier_methods | |
| 791 { | |
| 792 ... | |
| 793 const struct sized_memory_description *extra_description; | |
| 794 ... | |
| 795 }; | |
| 796 | |
| 797 struct Lisp_Specifier | |
| 798 { | |
| 3017 | 799 struct LCRECORD_HEADER header; |
| 1204 | 800 struct specifier_methods *methods; |
| 801 | |
| 802 ... | |
| 803 // type-specific extra data attached to a specifier | |
| 804 max_align_t data[1]; | |
| 805 }; | |
| 806 | |
| 807 The description map means "retrieve a pointer into the object at offset | |
| 808 `offsetof (Lisp_Specifier, methods)' , then in turn retrieve a pointer | |
| 809 into that object at offset `offsetof (struct specifier_methods, | |
| 810 extra_description)', and that is the sized_memory_description to use." | |
| 811 There can be any number of indirections, which can be either into | |
| 812 straight pointers or Lisp_Objects. The way that description maps are | |
| 813 distinguished from normal sized_memory_descriptions is that in the | |
| 814 former, the memory_description pointer is NULL. | |
| 815 | |
| 816 --ben | |
| 817 | |
| 814 | 818 |
| 819 The existing types : | |
| 820 | |
| 821 | |
| 428 | 822 XD_LISP_OBJECT |
| 1204 | 823 |
| 824 A Lisp object. This is also the type to use for pointers to other lrecords | |
| 825 (e.g. struct frame *). | |
| 428 | 826 |
| 440 | 827 XD_LISP_OBJECT_ARRAY |
| 1204 | 828 |
| 771 | 829 An array of Lisp objects or (equivalently) pointers to lrecords. |
| 830 The parameter (i.e. third element) is the count. This would be declared | |
| 831 as Lisp_Object foo[666]. For something declared as Lisp_Object *foo, | |
| 2367 | 832 use XD_BLOCK_PTR, whose description parameter is a sized_memory_description |
| 771 | 833 consisting of only XD_LISP_OBJECT and XD_END. |
| 440 | 834 |
| 428 | 835 XD_LO_LINK |
| 1204 | 836 |
| 771 | 837 Weak link in a linked list of objects of the same type. This is a |
| 838 link that does NOT generate a GC reference. Thus the pdumper will | |
| 839 not automatically add the referenced object to the table of all | |
| 840 objects to be dumped, and when storing and loading the dumped data | |
| 841 will automatically prune unreferenced objects in the chain and link | |
| 842 each referenced object to the next referenced object, even if it's | |
| 843 many links away. We also need to special handling of a similar | |
| 844 nature for the root of the chain, which will be a staticpro()ed | |
| 845 object. | |
| 432 | 846 |
| 428 | 847 XD_OPAQUE_PTR |
| 1204 | 848 |
| 428 | 849 Pointer to undumpable data. Must be NULL when dumping. |
| 850 | |
| 2551 | 851 XD_OPAQUE_PTR_CONVERTIBLE |
| 852 | |
| 853 Pointer to data which is not directly dumpable but can be converted | |
| 854 to a dumpable, opaque external representation. The parameter is | |
| 855 a pointer to an opaque_convert_functions struct. | |
| 856 | |
| 857 XD_OPAQUE_DATA_CONVERTIBLE | |
| 858 | |
| 859 Data which is not directly dumpable but can be converted to a | |
| 860 dumpable, opaque external representation. The parameter is a | |
| 861 pointer to an opaque_convert_functions struct. | |
| 862 | |
| 2367 | 863 XD_BLOCK_PTR |
| 1204 | 864 |
| 771 | 865 Pointer to block of described memory. (This is misnamed: It is NOT |
| 866 necessarily a pointer to a struct foo.) Parameters are number of | |
| 1204 | 867 contiguous blocks and sized_memory_description. |
| 771 | 868 |
| 2367 | 869 XD_BLOCK_ARRAY |
| 1204 | 870 |
| 771 | 871 Array of blocks of described memory. Parameters are number of |
| 2367 | 872 structures and sized_memory_description. This differs from XD_BLOCK_PTR |
| 771 | 873 in that the parameter is declared as struct foo[666] instead of |
| 874 struct *foo. In other words, the block of memory holding the | |
| 875 structures is within the containing structure, rather than being | |
| 876 elsewhere, with a pointer in the containing structure. | |
| 428 | 877 |
| 1204 | 878 NOTE NOTE NOTE: Be sure that you understand the difference between |
| 2367 | 879 XD_BLOCK_PTR and XD_BLOCK_ARRAY: |
| 1204 | 880 - struct foo bar[666], i.e. 666 inline struct foos |
| 2367 | 881 --> XD_BLOCK_ARRAY, argument 666, pointing to a description of |
| 1204 | 882 struct foo |
| 883 - struct foo *bar, i.e. pointer to a block of 666 struct foos | |
| 2367 | 884 --> XD_BLOCK_PTR, argument 666, pointing to a description of |
| 1204 | 885 struct foo |
| 886 - struct foo *bar[666], i.e. 666 pointers to separate blocks of struct foos | |
| 2367 | 887 --> XD_BLOCK_ARRAY, argument 666, pointing to a description of |
| 1204 | 888 a single pointer to struct foo; the description is a single |
| 2367 | 889 XD_BLOCK_PTR, argument 1, which in turn points to a description |
| 1204 | 890 of struct foo. |
| 891 | |
| 2367 | 892 NOTE also that an XD_BLOCK_PTR of 666 foos is equivalent to an |
| 893 XD_BLOCK_PTR of 1 bar, where the description of `bar' is an | |
| 894 XD_BLOCK_ARRAY of 666 foos. | |
| 895 | |
| 428 | 896 XD_OPAQUE_DATA_PTR |
| 1204 | 897 |
| 428 | 898 Pointer to dumpable opaque data. Parameter is the size of the data. |
| 899 Pointed data must be relocatable without changes. | |
| 900 | |
| 771 | 901 XD_UNION |
| 1204 | 902 |
| 903 Union of two or more different types of data. Parameters are a constant | |
| 904 which determines which type the data is (this is usually an XD_INDIRECT, | |
| 905 referring to one of the fields in the structure), and a "sizing lobby" (a | |
| 906 sized_memory_description, which points to a memory_description and | |
| 907 indicates its size). The size field in the sizing lobby describes the | |
| 908 size of the union field in the object, and the memory_description in it | |
| 909 is referred to as a "union map" and has a special interpretation: The | |
| 910 offset field is replaced by a constant, which is compared to the first | |
| 911 parameter of the XD_UNION descriptor to determine if this description | |
| 912 applies to the union data, and XD_INDIRECT references refer to the | |
| 913 containing object and description. Note that the description applies | |
| 2367 | 914 "inline" to the union data, like XD_BLOCK_ARRAY and not XD_BLOCK_PTR. |
| 1204 | 915 If the union data is a pointer to different types of structures, each |
| 2367 | 916 element in the memory_description should be an XD_BLOCK_PTR. See |
| 1204 | 917 unicode.c, redisplay.c and objects.c for examples of XD_UNION. |
| 918 | |
| 919 XD_UNION_DYNAMIC_SIZE | |
| 920 | |
| 921 Same as XD_UNION except that this is used for objects where the size of | |
| 922 the object containing the union varies depending on the particular value | |
| 923 of the union constant. That is, an object with plain XD_UNION typically | |
| 924 has the union declared as `union foo' or as `void *', where an object | |
| 925 with XD_UNION_DYNAMIC_SIZE typically has the union as the last element, | |
| 2367 | 926 and declared as something like Rawbyte foo[1]. With plain XD_UNION, the |
| 1204 | 927 object is (usually) of fixed size and always contains enough space for |
| 928 the data associated with all possible union constants, and thus the union | |
| 929 constant can potentially change during the lifetime of the object. With | |
| 930 XD_UNION_DYNAMIC_SIZE, however, the union constant is fixed at the time | |
| 931 of creation of the object, and the size of the object is computed | |
| 932 dynamically at creation time based on the size of the data associated | |
| 933 with the union constant. Currently, the only difference between XD_UNION | |
| 934 and XD_UNION_DYNAMIC_SIZE is how the size of the union data is | |
| 935 calculated, when (a) the structure containing the union has no size | |
| 936 given; (b) the union occurs as the last element in the structure; and (c) | |
| 937 the union has no size given (in the first-level sized_memory_description | |
| 938 pointed to). In this circumstance, the size of XD_UNION comes from the | |
| 939 max size of the data associated with all possible union constants, | |
| 940 whereas the size of XD_UNION_DYNAMIC_SIZE comes from the size of the data | |
| 941 associated with the currently specified (and unchangeable) union | |
| 942 constant. | |
| 771 | 943 |
| 2367 | 944 XD_ASCII_STRING |
| 1204 | 945 |
| 2367 | 946 Pointer to a C string, purely ASCII. |
| 428 | 947 |
| 948 XD_DOC_STRING | |
| 1204 | 949 |
| 2367 | 950 Pointer to a doc string (C string in pure ASCII if positive, |
| 951 opaque value if negative) | |
| 428 | 952 |
| 953 XD_INT_RESET | |
| 1204 | 954 |
| 428 | 955 An integer which will be reset to a given value in the dump file. |
| 956 | |
| 1204 | 957 XD_ELEMCOUNT |
| 771 | 958 |
| 665 | 959 Elemcount value. Used for counts. |
| 647 | 960 |
| 665 | 961 XD_BYTECOUNT |
| 1204 | 962 |
| 665 | 963 Bytecount value. Used for counts. |
| 647 | 964 |
| 665 | 965 XD_HASHCODE |
| 1204 | 966 |
| 665 | 967 Hashcode value. Used for the results of hashing functions. |
| 428 | 968 |
| 969 XD_INT | |
| 1204 | 970 |
| 428 | 971 int value. Used for counts. |
| 972 | |
| 973 XD_LONG | |
| 1204 | 974 |
| 428 | 975 long value. Used for counts. |
| 976 | |
| 771 | 977 XD_BYTECOUNT |
| 1204 | 978 |
| 771 | 979 bytecount value. Used for counts. |
| 980 | |
| 428 | 981 XD_END |
| 1204 | 982 |
| 428 | 983 Special type indicating the end of the array. |
| 984 | |
| 985 | |
| 986 Special macros: | |
| 1204 | 987 |
| 988 XD_INDIRECT (line, delta) | |
| 989 Usable where a count, size, offset or union constant is requested. Gives | |
| 990 the value of the element which is at line number 'line' in the | |
| 991 description (count starts at zero) and adds delta to it, which must | |
| 992 (currently) be positive. | |
| 428 | 993 */ |
| 994 | |
| 1204 | 995 enum memory_description_type |
| 647 | 996 { |
| 440 | 997 XD_LISP_OBJECT_ARRAY, |
| 428 | 998 XD_LISP_OBJECT, |
| 3092 | 999 #ifdef NEW_GC |
| 1000 XD_LISP_OBJECT_BLOCK_PTR, | |
| 1001 #endif /* NEW_GC */ | |
| 428 | 1002 XD_LO_LINK, |
| 1003 XD_OPAQUE_PTR, | |
| 2551 | 1004 XD_OPAQUE_PTR_CONVERTIBLE, |
| 1005 XD_OPAQUE_DATA_CONVERTIBLE, | |
| 1006 XD_OPAQUE_DATA_PTR, | |
| 2367 | 1007 XD_BLOCK_PTR, |
| 1008 XD_BLOCK_ARRAY, | |
| 771 | 1009 XD_UNION, |
| 1204 | 1010 XD_UNION_DYNAMIC_SIZE, |
| 2367 | 1011 XD_ASCII_STRING, |
| 428 | 1012 XD_DOC_STRING, |
| 1013 XD_INT_RESET, | |
| 665 | 1014 XD_BYTECOUNT, |
| 1015 XD_ELEMCOUNT, | |
| 1016 XD_HASHCODE, | |
| 428 | 1017 XD_INT, |
| 1018 XD_LONG, | |
| 1204 | 1019 XD_END |
| 428 | 1020 }; |
| 1021 | |
| 1204 | 1022 enum data_description_entry_flags |
| 647 | 1023 { |
| 1204 | 1024 /* If set, KKCC does not process this entry. |
| 1025 | |
| 1026 (1) One obvious use is with things that pdump saves but which do not get | |
| 1027 marked normally -- for example the next and prev fields in a marker. The | |
| 1028 marker chain is weak, with its entries removed when they are finalized. | |
| 1029 | |
| 1030 (2) This can be set on structures not containing any Lisp objects, or (more | |
| 1031 usefully) on structures that contain Lisp objects but where the objects | |
| 1032 always occur in another structure as well. For example, the extent lists | |
| 1033 kept by a buffer keep the extents in two lists, one sorted by the start | |
| 1034 of the extent and the other by the end. There's no point in marking | |
| 1035 both, since each contains the same objects as the other; but when dumping | |
| 1036 (if we were to dump such a structure), when computing memory size, etc., | |
| 1037 it's crucial to tag both sides. | |
| 1038 */ | |
| 1039 XD_FLAG_NO_KKCC = 1, | |
| 1040 /* If set, pdump does not process this entry. */ | |
| 1041 XD_FLAG_NO_PDUMP = 2, | |
| 1042 /* Indicates that this is a "default" entry in a union map. */ | |
| 1043 XD_FLAG_UNION_DEFAULT_ENTRY = 4, | |
| 3263 | 1044 #ifndef NEW_GC |
| 1204 | 1045 /* Indicates that this is a free Lisp object we're marking. |
| 1046 Only relevant for ERROR_CHECK_GC. This occurs when we're marking | |
| 1047 lcrecord-lists, where the objects have had their type changed to | |
| 1048 lrecord_type_free and also have had their free bit set, but we mark | |
| 1049 them as normal. */ | |
| 1429 | 1050 XD_FLAG_FREE_LISP_OBJECT = 8 |
| 3263 | 1051 #endif /* not NEW_GC */ |
| 1204 | 1052 #if 0 |
| 1429 | 1053 , |
| 1204 | 1054 /* Suggestions for other possible flags: */ |
| 1055 | |
| 1056 /* Eliminate XD_UNION_DYNAMIC_SIZE and replace it with a flag, like this. */ | |
| 1057 XD_FLAG_UNION_DYNAMIC_SIZE = 16, | |
| 1058 /* Require that everyone who uses a description map has to flag it, so | |
| 1059 that it's easy to tell, when looking through the code, where the | |
| 1060 description maps are and who's using them. This might also become | |
| 1061 necessary if for some reason the format of the description map is | |
| 1062 expanded and we need to stick a pointer in the second slot (although | |
| 1063 we could still ensure that the second slot in the first entry was NULL | |
| 1064 or <0). */ | |
| 1429 | 1065 XD_FLAG_DESCRIPTION_MAP = 32 |
| 1204 | 1066 #endif |
| 428 | 1067 }; |
| 1068 | |
| 2551 | 1069 union memory_contents_description |
| 1070 { | |
| 1071 /* The first element is used by static initializers only. We always read | |
| 1072 from one of the other two pointers. */ | |
| 1073 const void *write_only; | |
| 1074 const struct sized_memory_description *descr; | |
| 1075 const struct opaque_convert_functions *funcs; | |
| 1076 }; | |
| 1077 | |
| 1204 | 1078 struct memory_description |
| 1079 { | |
| 1080 enum memory_description_type type; | |
| 1081 Bytecount offset; | |
| 1082 EMACS_INT data1; | |
| 2551 | 1083 union memory_contents_description data2; |
| 1204 | 1084 /* Indicates which subsystems process this entry, plus (potentially) other |
| 1085 flags that apply to this entry. */ | |
| 1086 int flags; | |
| 1087 }; | |
| 428 | 1088 |
| 1204 | 1089 struct sized_memory_description |
| 1090 { | |
| 1091 Bytecount size; | |
| 1092 const struct memory_description *description; | |
| 1093 }; | |
| 1094 | |
| 2551 | 1095 |
| 1096 struct opaque_convert_functions | |
| 1097 { | |
| 1098 /* Used by XD_OPAQUE_PTR_CONVERTIBLE and | |
| 1099 XD_OPAQUE_DATA_CONVERTIBLE */ | |
| 1100 | |
| 1101 /* Converter to external representation, for those objects from | |
| 1102 external libraries that can't be directly dumped as opaque data | |
| 1103 because they contain pointers. This is called at dump time to | |
| 1104 convert to an opaque, pointer-less representation. | |
| 1105 | |
| 1106 This function must put a pointer to the opaque result in *data | |
| 1107 and its size in *size. */ | |
| 1108 void (*convert)(const void *object, void **data, Bytecount *size); | |
| 1109 | |
| 1110 /* Post-conversion cleanup. Optional (null if not provided). | |
| 1111 | |
| 1112 When provided it will be called post-dumping to free any storage | |
| 1113 allocated for the conversion results. */ | |
| 1114 void (*convert_free)(const void *object, void *data, Bytecount size); | |
| 1115 | |
| 1116 /* De-conversion. | |
| 1117 | |
| 1118 At reload time, rebuilds the object from the converted form. | |
| 1119 "object" is 0 for the PTR case, return is ignored in the DATA | |
| 1120 case. */ | |
| 1121 void *(*deconvert)(void *object, void *data, Bytecount size); | |
| 1122 | |
| 1123 }; | |
| 1124 | |
| 1204 | 1125 extern const struct sized_memory_description lisp_object_description; |
| 1126 | |
| 1127 #define XD_INDIRECT(val, delta) (-1 - (Bytecount) ((val) | ((delta) << 8))) | |
| 428 | 1128 |
| 1204 | 1129 #define XD_IS_INDIRECT(code) ((code) < 0) |
| 1130 #define XD_INDIRECT_VAL(code) ((-1 - (code)) & 255) | |
| 1131 #define XD_INDIRECT_DELTA(code) ((-1 - (code)) >> 8) | |
| 1132 | |
| 1133 #define XD_DYNARR_DESC(base_type, sub_desc) \ | |
| 2551 | 1134 { XD_BLOCK_PTR, offsetof (base_type, base), XD_INDIRECT(1, 0), {sub_desc} },\ |
| 1204 | 1135 { XD_INT, offsetof (base_type, cur) }, \ |
| 1136 { XD_INT_RESET, offsetof (base_type, max), XD_INDIRECT(1, 0) } \ | |
| 1137 | |
| 3092 | 1138 #ifdef NEW_GC |
| 1139 #define XD_LISP_DYNARR_DESC(base_type, sub_desc) \ | |
| 1140 { XD_LISP_OBJECT_BLOCK_PTR, offsetof (base_type, base), \ | |
| 1141 XD_INDIRECT(1, 0), {sub_desc} }, \ | |
| 1142 { XD_INT, offsetof (base_type, cur) }, \ | |
| 1143 { XD_INT_RESET, offsetof (base_type, max), XD_INDIRECT(1, 0) } | |
| 1144 #endif /* not NEW_GC */ | |
| 1145 | |
| 428 | 1146 /* DEFINE_LRECORD_IMPLEMENTATION is for objects with constant size. |
| 1147 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION is for objects whose size varies. | |
| 1148 */ | |
| 1149 | |
| 800 | 1150 #if defined (ERROR_CHECK_TYPES) |
| 1151 # define DECLARE_ERROR_CHECK_TYPES(c_name, structtype) | |
| 428 | 1152 #else |
| 800 | 1153 # define DECLARE_ERROR_CHECK_TYPES(c_name, structtype) |
| 428 | 1154 #endif |
| 1155 | |
| 934 | 1156 |
| 1157 #define DEFINE_BASIC_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,structtype) \ | |
| 1158 DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype) | |
| 1159 | |
| 1160 #define DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \ | |
| 1161 MAKE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof(structtype),0,1,structtype) | |
| 1162 | |
| 1163 #define DEFINE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,structtype) \ | |
| 1164 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype) | |
| 1165 | |
| 1166 #define DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \ | |
| 1167 MAKE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof (structtype),0,0,structtype) | |
| 1168 | |
| 1169 #define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,sizer,structtype) \ | |
| 1170 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,sizer,structtype) | |
| 1171 | |
| 1172 #define DEFINE_BASIC_LRECORD_SEQUENCE_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,sizer,structtype) \ | |
| 1173 MAKE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,sizer,1,structtype) | |
| 1174 | |
| 1175 #define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizer,structtype) \ | |
| 1176 MAKE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,0,sizer,0,structtype) | |
| 1177 | |
| 3263 | 1178 #ifdef NEW_GC |
| 2720 | 1179 #define MAKE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \ |
| 1180 DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \ | |
| 1181 const struct lrecord_implementation lrecord_##c_name = \ | |
| 1182 { name, dumpable, marker, printer, nuker, equal, hash, desc, \ | |
| 1183 getprop, putprop, remprop, plist, size, sizer, \ | |
| 1184 lrecord_type_##c_name } | |
| 3263 | 1185 #else /* not NEW_GC */ |
| 934 | 1186 #define MAKE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \ |
| 1204 | 1187 DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \ |
| 934 | 1188 const struct lrecord_implementation lrecord_##c_name = \ |
| 1189 { name, dumpable, marker, printer, nuker, equal, hash, desc, \ | |
| 1190 getprop, putprop, remprop, plist, size, sizer, \ | |
| 1191 lrecord_type_##c_name, basic_p } | |
| 3263 | 1192 #endif /* not NEW_GC */ |
| 934 | 1193 |
| 1194 #define DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,structtype) \ | |
| 1195 DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype) | |
| 1196 | |
| 1197 #define DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \ | |
| 1198 MAKE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof (structtype),0,0,structtype) | |
| 1199 | |
| 1200 #define DEFINE_EXTERNAL_LRECORD_SEQUENCE_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,sizer,structtype) \ | |
| 1201 DEFINE_EXTERNAL_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,sizer,structtype) | |
| 1202 | |
| 1203 #define DEFINE_EXTERNAL_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizer,structtype) \ | |
| 1204 MAKE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,0,sizer,0,structtype) | |
| 1205 | |
| 3263 | 1206 #ifdef NEW_GC |
| 2720 | 1207 #define MAKE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \ |
| 1208 DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \ | |
| 1209 int lrecord_type_##c_name; \ | |
| 1210 struct lrecord_implementation lrecord_##c_name = \ | |
| 1211 { name, dumpable, marker, printer, nuker, equal, hash, desc, \ | |
| 1212 getprop, putprop, remprop, plist, size, sizer, \ | |
| 1213 lrecord_type_last_built_in_type } | |
| 3263 | 1214 #else /* not NEW_GC */ |
| 934 | 1215 #define MAKE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \ |
| 1204 | 1216 DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \ |
| 934 | 1217 int lrecord_type_##c_name; \ |
| 1218 struct lrecord_implementation lrecord_##c_name = \ | |
| 1219 { name, dumpable, marker, printer, nuker, equal, hash, desc, \ | |
| 1220 getprop, putprop, remprop, plist, size, sizer, \ | |
| 1221 lrecord_type_last_built_in_type, basic_p } | |
| 3263 | 1222 #endif /* not NEW_GC */ |
| 934 | 1223 |
| 1676 | 1224 #ifdef USE_KKCC |
| 1225 extern MODULE_API const struct memory_description *lrecord_memory_descriptions[]; | |
| 1226 | |
| 1227 #define INIT_LRECORD_IMPLEMENTATION(type) do { \ | |
| 1228 lrecord_implementations_table[lrecord_type_##type] = &lrecord_##type; \ | |
| 1229 lrecord_memory_descriptions[lrecord_type_##type] = \ | |
| 1230 lrecord_implementations_table[lrecord_type_##type]->description; \ | |
| 1231 } while (0) | |
| 1232 #else /* not USE_KKCC */ | |
| 1632 | 1233 extern MODULE_API Lisp_Object (*lrecord_markers[]) (Lisp_Object); |
| 442 | 1234 |
| 1235 #define INIT_LRECORD_IMPLEMENTATION(type) do { \ | |
| 1236 lrecord_implementations_table[lrecord_type_##type] = &lrecord_##type; \ | |
| 1237 lrecord_markers[lrecord_type_##type] = \ | |
| 1238 lrecord_implementations_table[lrecord_type_##type]->marker; \ | |
| 1239 } while (0) | |
| 1676 | 1240 #endif /* not USE_KKCC */ |
| 428 | 1241 |
| 444 | 1242 #define INIT_EXTERNAL_LRECORD_IMPLEMENTATION(type) do { \ |
| 1243 lrecord_type_##type = lrecord_type_count++; \ | |
| 1244 lrecord_##type.lrecord_type_index = lrecord_type_##type; \ | |
| 1245 INIT_LRECORD_IMPLEMENTATION(type); \ | |
| 1246 } while (0) | |
| 1247 | |
| 996 | 1248 #ifdef HAVE_SHLIB |
| 1249 /* Allow undefining types in order to support module unloading. */ | |
| 1250 | |
| 1676 | 1251 #ifdef USE_KKCC |
| 1252 #define UNDEF_LRECORD_IMPLEMENTATION(type) do { \ | |
| 1253 lrecord_implementations_table[lrecord_type_##type] = NULL; \ | |
| 1254 lrecord_memory_descriptions[lrecord_type_##type] = NULL; \ | |
| 1255 } while (0) | |
| 1256 #else /* not USE_KKCC */ | |
| 996 | 1257 #define UNDEF_LRECORD_IMPLEMENTATION(type) do { \ |
| 1258 lrecord_implementations_table[lrecord_type_##type] = NULL; \ | |
| 1259 lrecord_markers[lrecord_type_##type] = NULL; \ | |
| 1260 } while (0) | |
| 1676 | 1261 #endif /* not USE_KKCC */ |
| 996 | 1262 |
| 1263 #define UNDEF_EXTERNAL_LRECORD_IMPLEMENTATION(type) do { \ | |
| 1264 if (lrecord_##type.lrecord_type_index == lrecord_type_count - 1) { \ | |
| 1265 /* This is the most recently defined type. Clean up nicely. */ \ | |
| 1266 lrecord_type_##type = lrecord_type_count--; \ | |
| 1267 } /* Else we can't help leaving a hole with this implementation. */ \ | |
| 1268 UNDEF_LRECORD_IMPLEMENTATION(type); \ | |
| 1269 } while (0) | |
| 1270 | |
| 1271 #endif /* HAVE_SHLIB */ | |
| 1272 | |
| 428 | 1273 #define LRECORDP(a) (XTYPE (a) == Lisp_Type_Record) |
| 1274 #define XRECORD_LHEADER(a) ((struct lrecord_header *) XPNTR (a)) | |
| 1275 | |
| 1276 #define RECORD_TYPEP(x, ty) \ | |
| 647 | 1277 (LRECORDP (x) && (XRECORD_LHEADER (x)->type == (unsigned int) (ty))) |
| 442 | 1278 |
| 1279 /* Steps to create a new object: | |
| 1280 | |
| 1281 1. Declare the struct for your object in a header file somewhere. | |
| 1282 Remember that it must begin with | |
| 1283 | |
| 3017 | 1284 struct LCRECORD_HEADER header; |
| 442 | 1285 |
| 793 | 1286 2. Put the "standard junk" (DECLARE_RECORD()/XFOO/etc.) below the |
| 617 | 1287 struct definition -- see below. |
| 442 | 1288 |
| 1289 3. Add this header file to inline.c. | |
| 1290 | |
| 1291 4. Create the methods for your object. Note that technically you don't | |
| 1292 need any, but you will almost always want at least a mark method. | |
| 1293 | |
| 1204 | 1294 4. Create the data layout description for your object. See |
| 1295 toolbar_button_description below; the comment above in `struct lrecord', | |
| 1296 describing the purpose of the descriptions; and comments elsewhere in | |
| 1297 this file describing the exact syntax of the description structures. | |
| 1298 | |
| 1299 6. Define your object with DEFINE_LRECORD_IMPLEMENTATION() or some | |
| 442 | 1300 variant. |
| 1301 | |
| 1204 | 1302 7. Include the header file in the .c file where you defined the object. |
| 442 | 1303 |
| 1204 | 1304 8. Put a call to INIT_LRECORD_IMPLEMENTATION() for the object in the |
| 442 | 1305 .c file's syms_of_foo() function. |
| 1306 | |
| 1204 | 1307 9. Add a type enum for the object to enum lrecord_type, earlier in this |
| 442 | 1308 file. |
| 1309 | |
| 1204 | 1310 --ben |
| 1311 | |
| 442 | 1312 An example: |
| 428 | 1313 |
| 442 | 1314 ------------------------------ in toolbar.h ----------------------------- |
| 1315 | |
| 1316 struct toolbar_button | |
| 1317 { | |
| 3017 | 1318 struct LCRECORD_HEADER header; |
| 442 | 1319 |
| 1320 Lisp_Object next; | |
| 1321 Lisp_Object frame; | |
| 1322 | |
| 1323 Lisp_Object up_glyph; | |
| 1324 Lisp_Object down_glyph; | |
| 1325 Lisp_Object disabled_glyph; | |
| 1326 | |
| 1327 Lisp_Object cap_up_glyph; | |
| 1328 Lisp_Object cap_down_glyph; | |
| 1329 Lisp_Object cap_disabled_glyph; | |
| 1330 | |
| 1331 Lisp_Object callback; | |
| 1332 Lisp_Object enabled_p; | |
| 1333 Lisp_Object help_string; | |
| 1334 | |
| 1335 char enabled; | |
| 1336 char down; | |
| 1337 char pushright; | |
| 1338 char blank; | |
| 1339 | |
| 1340 int x, y; | |
| 1341 int width, height; | |
| 1342 int dirty; | |
| 1343 int vertical; | |
| 1344 int border_width; | |
| 1345 }; | |
| 428 | 1346 |
| 617 | 1347 [[ the standard junk: ]] |
| 1348 | |
| 442 | 1349 DECLARE_LRECORD (toolbar_button, struct toolbar_button); |
| 1350 #define XTOOLBAR_BUTTON(x) XRECORD (x, toolbar_button, struct toolbar_button) | |
| 617 | 1351 #define wrap_toolbar_button(p) wrap_record (p, toolbar_button) |
| 442 | 1352 #define TOOLBAR_BUTTONP(x) RECORDP (x, toolbar_button) |
| 1353 #define CHECK_TOOLBAR_BUTTON(x) CHECK_RECORD (x, toolbar_button) | |
| 1354 #define CONCHECK_TOOLBAR_BUTTON(x) CONCHECK_RECORD (x, toolbar_button) | |
| 1355 | |
| 1356 ------------------------------ in toolbar.c ----------------------------- | |
| 1357 | |
| 1358 #include "toolbar.h" | |
| 1359 | |
| 1360 ... | |
| 1361 | |
| 1204 | 1362 static const struct memory_description toolbar_button_description [] = { |
| 1363 { XD_LISP_OBJECT, offsetof (struct toolbar_button, next) }, | |
| 1364 { XD_LISP_OBJECT, offsetof (struct toolbar_button, frame) }, | |
| 1365 { XD_LISP_OBJECT, offsetof (struct toolbar_button, up_glyph) }, | |
| 1366 { XD_LISP_OBJECT, offsetof (struct toolbar_button, down_glyph) }, | |
| 1367 { XD_LISP_OBJECT, offsetof (struct toolbar_button, disabled_glyph) }, | |
| 1368 { XD_LISP_OBJECT, offsetof (struct toolbar_button, cap_up_glyph) }, | |
| 1369 { XD_LISP_OBJECT, offsetof (struct toolbar_button, cap_down_glyph) }, | |
| 1370 { XD_LISP_OBJECT, offsetof (struct toolbar_button, cap_disabled_glyph) }, | |
| 1371 { XD_LISP_OBJECT, offsetof (struct toolbar_button, callback) }, | |
| 1372 { XD_LISP_OBJECT, offsetof (struct toolbar_button, enabled_p) }, | |
| 1373 { XD_LISP_OBJECT, offsetof (struct toolbar_button, help_string) }, | |
| 1374 { XD_END } | |
| 1375 }; | |
| 1376 | |
| 442 | 1377 static Lisp_Object |
| 1378 mark_toolbar_button (Lisp_Object obj) | |
| 1204 | 1379 \{ |
| 442 | 1380 struct toolbar_button *data = XTOOLBAR_BUTTON (obj); |
| 1381 mark_object (data->next); | |
| 1382 mark_object (data->frame); | |
| 1383 mark_object (data->up_glyph); | |
| 1384 mark_object (data->down_glyph); | |
| 1385 mark_object (data->disabled_glyph); | |
| 1386 mark_object (data->cap_up_glyph); | |
| 1387 mark_object (data->cap_down_glyph); | |
| 1388 mark_object (data->cap_disabled_glyph); | |
| 1389 mark_object (data->callback); | |
| 1390 mark_object (data->enabled_p); | |
| 1391 return data->help_string; | |
| 1392 } | |
| 1393 | |
| 617 | 1394 [[ If your object should never escape to Lisp, declare its print method |
| 1395 as internal_object_printer instead of 0. ]] | |
| 1396 | |
| 442 | 1397 DEFINE_LRECORD_IMPLEMENTATION ("toolbar-button", toolbar_button, |
| 1204 | 1398 0, mark_toolbar_button, 0, 0, 0, 0, |
| 1399 toolbar_button_description, | |
| 1400 struct toolbar_button); | |
| 442 | 1401 |
| 1402 ... | |
| 1403 | |
| 1404 void | |
| 1405 syms_of_toolbar (void) | |
| 1406 { | |
| 1407 INIT_LRECORD_IMPLEMENTATION (toolbar_button); | |
| 1408 | |
| 1409 ...; | |
| 1410 } | |
| 1411 | |
| 1412 ------------------------------ in inline.c ----------------------------- | |
| 1413 | |
| 1414 #ifdef HAVE_TOOLBARS | |
| 1415 #include "toolbar.h" | |
| 1416 #endif | |
| 1417 | |
| 1418 ------------------------------ in lrecord.h ----------------------------- | |
| 1419 | |
| 1420 enum lrecord_type | |
| 1421 { | |
| 1422 ... | |
| 1423 lrecord_type_toolbar_button, | |
| 1424 ... | |
| 1425 }; | |
| 1426 | |
| 1204 | 1427 |
| 1428 --ben | |
| 1429 | |
| 442 | 1430 */ |
| 1431 | |
| 1432 /* | |
| 1433 | |
| 1434 Note: Object types defined in external dynamically-loaded modules (not | |
| 1435 part of the XEmacs main source code) should use DECLARE_EXTERNAL_LRECORD | |
| 1436 and DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION rather than DECLARE_LRECORD | |
| 3029 | 1437 and DEFINE_LRECORD_IMPLEMENTATION. The EXTERNAL versions declare and |
| 1438 allocate an enumerator for the type being defined. | |
| 442 | 1439 |
| 1440 */ | |
| 1441 | |
| 428 | 1442 |
| 800 | 1443 #ifdef ERROR_CHECK_TYPES |
| 428 | 1444 |
| 788 | 1445 # define DECLARE_LRECORD(c_name, structtype) \ |
| 1446 extern const struct lrecord_implementation lrecord_##c_name; \ | |
| 826 | 1447 DECLARE_INLINE_HEADER ( \ |
| 1448 structtype * \ | |
| 2367 | 1449 error_check_##c_name (Lisp_Object obj, const Ascbyte *file, int line) \ |
| 826 | 1450 ) \ |
| 788 | 1451 { \ |
| 1452 assert_at_line (RECORD_TYPEP (obj, lrecord_type_##c_name), file, line); \ | |
| 1453 return (structtype *) XPNTR (obj); \ | |
| 1454 } \ | |
| 428 | 1455 extern Lisp_Object Q##c_name##p |
| 1456 | |
| 1632 | 1457 # define DECLARE_MODULE_API_LRECORD(c_name, structtype) \ |
| 1458 extern MODULE_API const struct lrecord_implementation lrecord_##c_name; \ | |
| 1459 DECLARE_INLINE_HEADER ( \ | |
| 1460 structtype * \ | |
| 2367 | 1461 error_check_##c_name (Lisp_Object obj, const Ascbyte *file, int line) \ |
| 1632 | 1462 ) \ |
| 1463 { \ | |
| 1464 assert_at_line (RECORD_TYPEP (obj, lrecord_type_##c_name), file, line); \ | |
| 1465 return (structtype *) XPNTR (obj); \ | |
| 1466 } \ | |
| 1467 extern MODULE_API Lisp_Object Q##c_name##p | |
| 1468 | |
| 788 | 1469 # define DECLARE_EXTERNAL_LRECORD(c_name, structtype) \ |
| 1470 extern int lrecord_type_##c_name; \ | |
| 1471 extern struct lrecord_implementation lrecord_##c_name; \ | |
| 826 | 1472 DECLARE_INLINE_HEADER ( \ |
| 1473 structtype * \ | |
| 2367 | 1474 error_check_##c_name (Lisp_Object obj, const Ascbyte *file, int line) \ |
| 826 | 1475 ) \ |
| 788 | 1476 { \ |
| 1477 assert_at_line (RECORD_TYPEP (obj, lrecord_type_##c_name), file, line); \ | |
| 1478 return (structtype *) XPNTR (obj); \ | |
| 1479 } \ | |
| 444 | 1480 extern Lisp_Object Q##c_name##p |
| 442 | 1481 |
| 788 | 1482 # define DECLARE_NONRECORD(c_name, type_enum, structtype) \ |
| 826 | 1483 DECLARE_INLINE_HEADER ( \ |
| 1484 structtype * \ | |
| 2367 | 1485 error_check_##c_name (Lisp_Object obj, const Ascbyte *file, int line) \ |
| 826 | 1486 ) \ |
| 788 | 1487 { \ |
| 1488 assert_at_line (XTYPE (obj) == type_enum, file, line); \ | |
| 1489 return (structtype *) XPNTR (obj); \ | |
| 1490 } \ | |
| 428 | 1491 extern Lisp_Object Q##c_name##p |
| 1492 | |
| 788 | 1493 # define XRECORD(x, c_name, structtype) \ |
| 1494 error_check_##c_name (x, __FILE__, __LINE__) | |
| 1495 # define XNONRECORD(x, c_name, type_enum, structtype) \ | |
| 1496 error_check_##c_name (x, __FILE__, __LINE__) | |
| 428 | 1497 |
| 826 | 1498 DECLARE_INLINE_HEADER ( |
| 1499 Lisp_Object | |
| 2367 | 1500 wrap_record_1 (const void *ptr, enum lrecord_type ty, const Ascbyte *file, |
| 800 | 1501 int line) |
| 826 | 1502 ) |
| 617 | 1503 { |
| 793 | 1504 Lisp_Object obj = wrap_pointer_1 (ptr); |
| 1505 | |
| 788 | 1506 assert_at_line (RECORD_TYPEP (obj, ty), file, line); |
| 617 | 1507 return obj; |
| 1508 } | |
| 1509 | |
| 788 | 1510 #define wrap_record(ptr, ty) \ |
| 1511 wrap_record_1 (ptr, lrecord_type_##ty, __FILE__, __LINE__) | |
| 617 | 1512 |
| 800 | 1513 #else /* not ERROR_CHECK_TYPES */ |
| 428 | 1514 |
| 1515 # define DECLARE_LRECORD(c_name, structtype) \ | |
| 1516 extern Lisp_Object Q##c_name##p; \ | |
| 442 | 1517 extern const struct lrecord_implementation lrecord_##c_name |
| 1638 | 1518 # define DECLARE_MODULE_API_LRECORD(c_name, structtype) \ |
| 1519 extern MODULE_API Lisp_Object Q##c_name##p; \ | |
| 1520 extern MODULE_API const struct lrecord_implementation lrecord_##c_name | |
| 442 | 1521 # define DECLARE_EXTERNAL_LRECORD(c_name, structtype) \ |
| 1522 extern Lisp_Object Q##c_name##p; \ | |
| 647 | 1523 extern int lrecord_type_##c_name; \ |
| 444 | 1524 extern struct lrecord_implementation lrecord_##c_name |
| 428 | 1525 # define DECLARE_NONRECORD(c_name, type_enum, structtype) \ |
| 1526 extern Lisp_Object Q##c_name##p | |
| 1527 # define XRECORD(x, c_name, structtype) ((structtype *) XPNTR (x)) | |
| 1528 # define XNONRECORD(x, c_name, type_enum, structtype) \ | |
| 1529 ((structtype *) XPNTR (x)) | |
| 617 | 1530 /* wrap_pointer_1 is so named as a suggestion not to use it unless you |
| 1531 know what you're doing. */ | |
| 1532 #define wrap_record(ptr, ty) wrap_pointer_1 (ptr) | |
| 428 | 1533 |
| 800 | 1534 #endif /* not ERROR_CHECK_TYPES */ |
| 428 | 1535 |
| 442 | 1536 #define RECORDP(x, c_name) RECORD_TYPEP (x, lrecord_type_##c_name) |
| 428 | 1537 |
| 1538 /* Note: we now have two different kinds of type-checking macros. | |
| 1539 The "old" kind has now been renamed CONCHECK_foo. The reason for | |
| 1540 this is that the CONCHECK_foo macros signal a continuable error, | |
| 1541 allowing the user (through debug-on-error) to substitute a different | |
| 1542 value and return from the signal, which causes the lvalue argument | |
| 1543 to get changed. Quite a lot of code would crash if that happened, | |
| 1544 because it did things like | |
| 1545 | |
| 1546 foo = XCAR (list); | |
| 1547 CHECK_STRING (foo); | |
| 1548 | |
| 1549 and later on did XSTRING (XCAR (list)), assuming that the type | |
| 1550 is correct (when it might be wrong, if the user substituted a | |
| 1551 correct value in the debugger). | |
| 1552 | |
| 1553 To get around this, I made all the CHECK_foo macros signal a | |
| 1554 non-continuable error. Places where a continuable error is OK | |
| 1555 (generally only when called directly on the argument of a Lisp | |
| 1556 primitive) should be changed to use CONCHECK(). | |
| 1557 | |
| 1558 FSF Emacs does not have this problem because RMS took the cheesy | |
| 1559 way out and disabled returning from a signal entirely. */ | |
| 1560 | |
| 1561 #define CONCHECK_RECORD(x, c_name) do { \ | |
| 442 | 1562 if (!RECORD_TYPEP (x, lrecord_type_##c_name)) \ |
| 428 | 1563 x = wrong_type_argument (Q##c_name##p, x); \ |
| 1564 } while (0) | |
| 1565 #define CONCHECK_NONRECORD(x, lisp_enum, predicate) do {\ | |
| 1566 if (XTYPE (x) != lisp_enum) \ | |
| 1567 x = wrong_type_argument (predicate, x); \ | |
| 1568 } while (0) | |
| 1569 #define CHECK_RECORD(x, c_name) do { \ | |
| 442 | 1570 if (!RECORD_TYPEP (x, lrecord_type_##c_name)) \ |
| 428 | 1571 dead_wrong_type_argument (Q##c_name##p, x); \ |
| 1572 } while (0) | |
| 1573 #define CHECK_NONRECORD(x, lisp_enum, predicate) do { \ | |
| 1574 if (XTYPE (x) != lisp_enum) \ | |
| 1575 dead_wrong_type_argument (predicate, x); \ | |
| 1576 } while (0) | |
| 1577 | |
| 3263 | 1578 #ifndef NEW_GC |
| 1204 | 1579 /*-------------------------- lcrecord-list -----------------------------*/ |
| 1580 | |
| 1581 struct lcrecord_list | |
| 1582 { | |
| 3024 | 1583 struct LCRECORD_HEADER header; |
| 1204 | 1584 Lisp_Object free; |
| 1585 Elemcount size; | |
| 1586 const struct lrecord_implementation *implementation; | |
| 1587 }; | |
| 1588 | |
| 1589 DECLARE_LRECORD (lcrecord_list, struct lcrecord_list); | |
| 1590 #define XLCRECORD_LIST(x) XRECORD (x, lcrecord_list, struct lcrecord_list) | |
| 1591 #define wrap_lcrecord_list(p) wrap_record (p, lcrecord_list) | |
| 1592 #define LCRECORD_LISTP(x) RECORDP (x, lcrecord_list) | |
| 1593 /* #define CHECK_LCRECORD_LIST(x) CHECK_RECORD (x, lcrecord_list) | |
| 1594 Lcrecord lists should never escape to the Lisp level, so | |
| 1595 functions should not be doing this. */ | |
| 1596 | |
| 826 | 1597 /* Various ways of allocating lcrecords. All bytes (except lcrecord |
| 1204 | 1598 header) are zeroed in returned structure. |
| 1599 | |
| 1600 See above for a discussion of the difference between plain lrecords and | |
| 1601 lrecords. lcrecords themselves are divided into three types: (1) | |
| 1602 auto-managed, (2) hand-managed, and (3) unmanaged. "Managed" refers to | |
| 1603 using a special object called an lcrecord-list to keep track of freed | |
| 3024 | 1604 lcrecords, which can freed with FREE_LCRECORD() or the like and later be |
| 1204 | 1605 recycled when a new lcrecord is required, rather than requiring new |
| 1606 malloc(). Thus, allocation of lcrecords can be very | |
| 1607 cheap. (Technically, the lcrecord-list manager could divide up large | |
| 1608 chunks of memory and allocate out of that, mimicking what happens with | |
| 1609 lrecords. At that point, however, we'd want to rethink the whole | |
| 1610 division between lrecords and lcrecords.) | |
| 1611 | |
| 1612 NOTE: There is a fundamental limitation of lcrecord-lists, which is that | |
| 1613 they only handle blocks of a particular, fixed size. Thus, objects that | |
| 1614 can be of varying sizes need to do various tricks. These considerations | |
| 1615 in particular dictate the various types of management: | |
| 1616 | |
| 1617 -- "Auto-managed" means that you just go ahead and allocate the lcrecord | |
| 3024 | 1618 whenever you want, using old_alloc_lcrecord_type(), and the appropriate |
| 1204 | 1619 lcrecord-list manager is automatically created. To free, you just call |
| 3024 | 1620 "FREE_LCRECORD()" and the appropriate lcrecord-list manager is |
| 1204 | 1621 automatically located and called. The limitation here of course is that |
| 1622 all your objects are of the same size. (#### Eventually we should have a | |
| 1623 more sophisticated system that tracks the sizes seen and creates one | |
| 1624 lcrecord list per size, indexed in a hash table. Usually there are only | |
| 1625 a limited number of sizes, so this works well.) | |
| 826 | 1626 |
| 1204 | 1627 -- "Hand-managed" exists because we haven't yet written the more |
| 1628 sophisticated scheme for auto-handling different-sized lcrecords, as | |
| 1629 described in the end of the last paragraph. In this model, you go ahead | |
| 1630 and create the lcrecord-list objects yourself for the sizes you will | |
| 1631 need, using make_lcrecord_list(). Then, create lcrecords using | |
| 1632 alloc_managed_lcrecord(), passing in the lcrecord-list you created, and | |
| 1633 free them with free_managed_lcrecord(). | |
| 1634 | |
| 1635 -- "Unmanaged" means you simply allocate lcrecords, period. No | |
| 1636 lcrecord-lists, no way to free them. This may be suitable when the | |
| 1637 lcrecords are variable-sized and (a) you're too lazy to write the code | |
| 1638 to hand-manage them, or (b) the objects you create are always or almost | |
| 1639 always Lisp-visible, and thus there's no point in freeing them (and it | |
| 1640 wouldn't be safe to do so). You just create them with | |
| 3024 | 1641 BASIC_ALLOC_LCRECORD(), and that's it. |
| 1204 | 1642 |
| 1643 --ben | |
| 1644 | |
| 1645 Here is an in-depth look at the steps required to create a allocate an | |
| 1646 lcrecord using the hand-managed style. Since this is the most | |
| 1647 complicated, you will learn a lot about the other styles as well. In | |
| 1648 addition, there is useful general information about what freeing an | |
| 1649 lcrecord really entails, and what are the precautions: | |
| 1650 | |
| 1651 1) Create an lcrecord-list object using make_lcrecord_list(). This is | |
| 1652 often done at initialization. Remember to staticpro_nodump() this | |
| 1653 object! The arguments to make_lcrecord_list() are the same as would be | |
| 3024 | 1654 passed to BASIC_ALLOC_LCRECORD(). |
| 428 | 1655 |
| 3024 | 1656 2) Instead of calling BASIC_ALLOC_LCRECORD(), call alloc_managed_lcrecord() |
| 1204 | 1657 and pass the lcrecord-list earlier created. |
| 1658 | |
| 1659 3) When done with the lcrecord, call free_managed_lcrecord(). The | |
| 1660 standard freeing caveats apply: ** make sure there are no pointers to | |
| 1661 the object anywhere! ** | |
| 1662 | |
| 1663 4) Calling free_managed_lcrecord() is just like kissing the | |
| 1664 lcrecord goodbye as if it were garbage-collected. This means: | |
| 1665 -- the contents of the freed lcrecord are undefined, and the | |
| 1666 contents of something produced by alloc_managed_lcrecord() | |
| 3024 | 1667 are undefined, just like for BASIC_ALLOC_LCRECORD(). |
| 1204 | 1668 -- the mark method for the lcrecord's type will *NEVER* be called |
| 1669 on freed lcrecords. | |
| 1670 -- the finalize method for the lcrecord's type will be called | |
| 1671 at the time that free_managed_lcrecord() is called. | |
| 1672 */ | |
| 1673 | |
| 1674 /* UNMANAGED MODEL: */ | |
| 3024 | 1675 void *old_basic_alloc_lcrecord (Bytecount size, |
| 1676 const struct lrecord_implementation *); | |
| 1204 | 1677 |
| 1678 /* HAND-MANAGED MODEL: */ | |
| 1679 Lisp_Object make_lcrecord_list (Elemcount size, | |
| 1680 const struct lrecord_implementation | |
| 1681 *implementation); | |
| 1682 Lisp_Object alloc_managed_lcrecord (Lisp_Object lcrecord_list); | |
| 1683 void free_managed_lcrecord (Lisp_Object lcrecord_list, Lisp_Object lcrecord); | |
| 1684 | |
| 1685 /* AUTO-MANAGED MODEL: */ | |
| 1632 | 1686 MODULE_API void * |
| 1687 alloc_automanaged_lcrecord (Bytecount size, | |
| 1688 const struct lrecord_implementation *); | |
| 3017 | 1689 |
| 3024 | 1690 #define old_alloc_lcrecord_type(type, lrecord_implementation) \ |
| 771 | 1691 ((type *) alloc_automanaged_lcrecord (sizeof (type), lrecord_implementation)) |
| 2720 | 1692 |
| 3024 | 1693 void old_free_lcrecord (Lisp_Object rec); |
| 771 | 1694 |
| 428 | 1695 |
| 1696 /* Copy the data from one lcrecord structure into another, but don't | |
| 1697 overwrite the header information. */ | |
| 1698 | |
| 3024 | 1699 #define old_copy_sized_lcrecord(dst, src, size) \ |
| 1700 memcpy ((Rawbyte *) (dst) + sizeof (struct old_lcrecord_header), \ | |
| 1701 (Rawbyte *) (src) + sizeof (struct old_lcrecord_header), \ | |
| 1702 (size) - sizeof (struct old_lcrecord_header)) | |
| 771 | 1703 |
| 3024 | 1704 #define old_copy_lcrecord(dst, src) \ |
| 1705 old_copy_sized_lcrecord (dst, src, sizeof (*(dst))) | |
| 428 | 1706 |
| 3024 | 1707 #define old_zero_sized_lcrecord(lcr, size) \ |
| 1708 memset ((Rawbyte *) (lcr) + sizeof (struct old_lcrecord_header), 0, \ | |
| 1709 (size) - sizeof (struct old_lcrecord_header)) | |
| 771 | 1710 |
| 3024 | 1711 #define old_zero_lcrecord(lcr) old_zero_sized_lcrecord (lcr, sizeof (*(lcr))) |
| 1204 | 1712 |
| 3263 | 1713 #else /* NEW_GC */ |
| 2720 | 1714 |
| 1715 /* How to allocate a lrecord: | |
| 1716 | |
| 1717 - If the size of the lrecord is fix, say it equals its size of its | |
| 1718 struct, then use alloc_lrecord_type. | |
| 1719 | |
| 1720 - If the size varies, i.e. it is not equal to the size of its | |
| 1721 struct, use alloc_lrecord and specify the amount of storage you | |
| 1722 need for the object. | |
| 1723 | |
| 1724 - Some lrecords, which are used totally internally, use the | |
| 1725 noseeum-* functions for the reason of debugging. | |
| 1726 | |
| 1727 - To free a Lisp_Object manually, use free_lrecord. */ | |
| 1728 | |
| 1729 void *alloc_lrecord (Bytecount size, | |
| 1730 const struct lrecord_implementation *); | |
| 1731 | |
| 3092 | 1732 void *alloc_lrecord_array (Bytecount size, int elemcount, |
| 1733 const struct lrecord_implementation *); | |
| 1734 | |
| 2720 | 1735 #define alloc_lrecord_type(type, lrecord_implementation) \ |
| 1736 ((type *) alloc_lrecord (sizeof (type), lrecord_implementation)) | |
| 1737 | |
| 1738 void *noseeum_alloc_lrecord (Bytecount size, | |
| 1739 const struct lrecord_implementation *); | |
| 1740 | |
| 1741 #define noseeum_alloc_lrecord_type(type, lrecord_implementation) \ | |
| 1742 ((type *) noseeum_alloc_lrecord (sizeof (type), lrecord_implementation)) | |
| 1743 | |
| 1744 void free_lrecord (Lisp_Object rec); | |
| 1745 | |
| 1746 | |
| 1747 /* Copy the data from one lrecord structure into another, but don't | |
| 1748 overwrite the header information. */ | |
| 1749 | |
| 1750 #define copy_sized_lrecord(dst, src, size) \ | |
| 1751 memcpy ((char *) (dst) + sizeof (struct lrecord_header), \ | |
| 1752 (char *) (src) + sizeof (struct lrecord_header), \ | |
| 1753 (size) - sizeof (struct lrecord_header)) | |
| 1754 | |
| 1755 #define copy_lrecord(dst, src) copy_sized_lrecord (dst, src, sizeof (*(dst))) | |
| 1756 | |
| 3263 | 1757 #endif /* NEW_GC */ |
| 3017 | 1758 |
| 2720 | 1759 #define zero_sized_lrecord(lcr, size) \ |
| 1760 memset ((char *) (lcr) + sizeof (struct lrecord_header), 0, \ | |
| 1761 (size) - sizeof (struct lrecord_header)) | |
| 1762 | |
| 1763 #define zero_lrecord(lcr) zero_sized_lrecord (lcr, sizeof (*(lcr))) | |
| 1764 | |
| 1204 | 1765 DECLARE_INLINE_HEADER ( |
| 1766 Bytecount | |
| 1767 detagged_lisp_object_size (const struct lrecord_header *h) | |
| 1768 ) | |
| 1769 { | |
| 1770 const struct lrecord_implementation *imp = LHEADER_IMPLEMENTATION (h); | |
| 1771 | |
| 1772 return (imp->size_in_bytes_method ? | |
| 1773 imp->size_in_bytes_method (h) : | |
| 1774 imp->static_size); | |
| 1775 } | |
| 1776 | |
| 1777 DECLARE_INLINE_HEADER ( | |
| 1778 Bytecount | |
| 1779 lisp_object_size (Lisp_Object o) | |
| 1780 ) | |
| 1781 { | |
| 1782 return detagged_lisp_object_size (XRECORD_LHEADER (o)); | |
| 1783 } | |
| 1784 | |
| 1785 | |
| 1786 /************************************************************************/ | |
| 1787 /* Dumping */ | |
| 1788 /************************************************************************/ | |
| 1789 | |
| 2367 | 1790 /* dump_add_root_block_ptr (&var, &desc) dumps the structure pointed to by |
| 1204 | 1791 `var'. This is for a single relocatable pointer located in the data |
| 2367 | 1792 segment (i.e. the block pointed to is in the heap). |
| 1793 | |
| 1794 If the structure pointed to is not a `struct' but an array, you should | |
| 1795 set the size field of the sized_memory_description to 0, and use | |
| 1796 XD_BLOCK_ARRAY in the inner memory_description. | |
| 1797 | |
| 1798 NOTE that a "root struct pointer" could also be described using | |
| 1799 dump_add_root_block(), with SIZE == sizeof (void *), and a description | |
| 1800 containing a single XD_BLOCK_PTR entry, offset 0, size 1, with a | |
| 1801 structure description the same as the value passed to | |
| 1802 dump_add_root_block_ptr(). That would require an extra level of | |
| 1803 description, though, as compared to using dump_add_root_block_ptr(), | |
| 1804 and thus this function is generally more convenient. | |
| 1805 */ | |
| 1204 | 1806 #ifdef PDUMP |
| 2367 | 1807 void dump_add_root_block_ptr (void *, const struct sized_memory_description *); |
| 1204 | 1808 #else |
| 2367 | 1809 #define dump_add_root_block_ptr(varaddr, descaddr) DO_NOTHING |
| 1204 | 1810 #endif |
| 1811 | |
| 1812 /* dump_add_opaque (&var, size) dumps the opaque static structure `var'. | |
| 1813 This is for a static block of memory (in the data segment, not the | |
| 1814 heap), with no relocatable pointers in it. */ | |
| 1815 #ifdef PDUMP | |
| 1816 #define dump_add_opaque(varaddr,size) dump_add_root_block (varaddr, size, NULL) | |
| 1817 #else | |
| 1818 #define dump_add_opaque(varaddr,size) DO_NOTHING | |
| 1819 #endif | |
| 1820 | |
| 1821 /* dump_add_root_block (ptr, size, desc) dumps the static structure | |
| 1822 located at `var' of size SIZE and described by DESC. This is for a | |
| 1823 static block of memory (in the data segment, not the heap), with | |
| 1824 relocatable pointers in it. */ | |
| 1825 #ifdef PDUMP | |
| 1826 void dump_add_root_block (const void *ptraddress, Bytecount size, | |
| 1827 const struct memory_description *desc); | |
| 1828 #else | |
| 2367 | 1829 #define dump_add_root_block(ptraddress, size, desc) DO_NOTHING |
| 1204 | 1830 #endif |
| 1831 | |
| 1832 /* Call dump_add_opaque_int (&int_var) to dump `int_var', of type `int'. */ | |
| 1833 #ifdef PDUMP | |
| 1834 #define dump_add_opaque_int(int_varaddr) do { \ | |
| 1835 int *dao_ = (int_varaddr); /* type check */ \ | |
| 1836 dump_add_opaque (dao_, sizeof (*dao_)); \ | |
| 1837 } while (0) | |
| 1838 #else | |
| 1839 #define dump_add_opaque_int(int_varaddr) DO_NOTHING | |
| 1840 #endif | |
| 1841 | |
| 1842 /* Call dump_add_opaque_fixnum (&fixnum_var) to dump `fixnum_var', of type | |
| 1843 `Fixnum'. */ | |
| 1844 #ifdef PDUMP | |
| 1845 #define dump_add_opaque_fixnum(fixnum_varaddr) do { \ | |
| 1846 Fixnum *dao_ = (fixnum_varaddr); /* type check */ \ | |
| 1847 dump_add_opaque (dao_, sizeof (*dao_)); \ | |
| 1848 } while (0) | |
| 1849 #else | |
| 1850 #define dump_add_opaque_fixnum(fixnum_varaddr) DO_NOTHING | |
| 1851 #endif | |
| 1852 | |
| 1853 /* Call dump_add_root_lisp_object (&var) to ensure that var is properly | |
| 1854 updated after pdump. */ | |
| 1855 #ifdef PDUMP | |
| 1856 void dump_add_root_lisp_object (Lisp_Object *); | |
| 1857 #else | |
| 1858 #define dump_add_root_lisp_object(varaddr) DO_NOTHING | |
| 1859 #endif | |
| 1860 | |
| 1861 /* Call dump_add_weak_lisp_object (&var) to ensure that var is properly | |
| 1862 updated after pdump. var must point to a linked list of objects out of | |
| 1863 which some may not be dumped */ | |
| 1864 #ifdef PDUMP | |
| 1865 void dump_add_weak_object_chain (Lisp_Object *); | |
| 1866 #else | |
| 1867 #define dump_add_weak_object_chain(varaddr) DO_NOTHING | |
| 1868 #endif | |
| 1869 | |
| 1870 /* Nonzero means Emacs has already been initialized. | |
| 1871 Used during startup to detect startup of dumped Emacs. */ | |
| 1632 | 1872 extern MODULE_API int initialized; |
| 1204 | 1873 |
| 1874 #ifdef PDUMP | |
| 1688 | 1875 #include "dumper.h" |
| 3263 | 1876 #ifdef NEW_GC |
| 2720 | 1877 #define DUMPEDP(adr) 0 |
| 3263 | 1878 #else /* not NEW_GC */ |
| 2367 | 1879 #define DUMPEDP(adr) ((((Rawbyte *) (adr)) < pdump_end) && \ |
| 1880 (((Rawbyte *) (adr)) >= pdump_start)) | |
| 3263 | 1881 #endif /* not NEW_GC */ |
| 1204 | 1882 #else |
| 1883 #define DUMPEDP(adr) 0 | |
| 1884 #endif | |
| 1885 | |
| 1330 | 1886 #define OBJECT_DUMPED_P(obj) DUMPEDP (XPNTR (obj)) |
| 1887 | |
| 1204 | 1888 /***********************************************************************/ |
| 1889 /* data descriptions */ | |
| 1890 /***********************************************************************/ | |
| 1891 | |
| 1892 | |
| 1893 #if defined (USE_KKCC) || defined (PDUMP) | |
| 1894 | |
| 1895 extern int in_pdump; | |
| 1896 | |
| 1897 EMACS_INT lispdesc_indirect_count_1 (EMACS_INT code, | |
| 1898 const struct memory_description *idesc, | |
| 1899 const void *idata); | |
| 1900 const struct sized_memory_description *lispdesc_indirect_description_1 | |
| 1901 (const void *obj, const struct sized_memory_description *sdesc); | |
| 2367 | 1902 Bytecount lispdesc_block_size_1 (const void *obj, Bytecount size, |
| 1903 const struct memory_description *desc); | |
| 1904 | |
| 1905 DECLARE_INLINE_HEADER ( | |
| 1906 Bytecount lispdesc_block_size (const void *obj, | |
| 1907 const struct sized_memory_description *sdesc)) | |
| 1908 { | |
| 1909 return lispdesc_block_size_1 (obj, sdesc->size, sdesc->description); | |
| 1910 } | |
| 1204 | 1911 |
| 1912 DECLARE_INLINE_HEADER ( | |
| 1913 EMACS_INT | |
| 1914 lispdesc_indirect_count (EMACS_INT code, | |
| 1915 const struct memory_description *idesc, | |
| 1916 const void *idata) | |
| 1917 ) | |
| 1918 { | |
| 1919 if (XD_IS_INDIRECT (code)) | |
| 1920 code = lispdesc_indirect_count_1 (code, idesc, idata); | |
| 1921 return code; | |
| 1922 } | |
| 1923 | |
| 1924 DECLARE_INLINE_HEADER ( | |
| 1925 const struct sized_memory_description * | |
| 1926 lispdesc_indirect_description (const void *obj, | |
| 1927 const struct sized_memory_description *sdesc) | |
| 1928 ) | |
| 1929 { | |
| 1930 if (sdesc->description) | |
| 1931 return sdesc; | |
| 1932 else | |
| 1933 return lispdesc_indirect_description_1 (obj, sdesc); | |
| 1934 } | |
| 1935 | |
| 1936 | |
| 1937 /* Do standard XD_UNION processing. DESC1 is an entry in DESC, which | |
| 1938 describes the entire data structure. Returns NULL (do nothing, nothing | |
| 1939 matched), or a new value for DESC1. In the latter case, assign to DESC1 | |
| 1940 in your function and goto union_switcheroo. */ | |
| 1941 | |
| 1942 DECLARE_INLINE_HEADER ( | |
| 1943 const struct memory_description * | |
| 1944 lispdesc_process_xd_union (const struct memory_description *desc1, | |
| 1945 const struct memory_description *desc, | |
| 1946 const void *data) | |
| 1947 ) | |
| 1948 { | |
| 1949 int count = 0; | |
| 1950 EMACS_INT variant = lispdesc_indirect_count (desc1->data1, desc, | |
| 1951 data); | |
| 1952 desc1 = | |
| 2551 | 1953 lispdesc_indirect_description (data, desc1->data2.descr)->description; |
| 1204 | 1954 |
| 1955 for (count = 0; desc1[count].type != XD_END; count++) | |
| 1956 { | |
| 1957 if ((desc1[count].flags & XD_FLAG_UNION_DEFAULT_ENTRY) || | |
| 1958 desc1[count].offset == variant) | |
| 1959 { | |
| 1960 return &desc1[count]; | |
| 1961 } | |
| 1962 } | |
| 1963 | |
| 1964 return NULL; | |
| 1965 } | |
| 1966 | |
| 1967 #endif /* defined (USE_KKCC) || defined (PDUMP) */ | |
| 428 | 1968 |
| 1743 | 1969 END_C_DECLS |
| 1650 | 1970 |
| 440 | 1971 #endif /* INCLUDED_lrecord_h_ */ |