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