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