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