annotate src/lrecord.h @ 617:af57a77cbc92

[xemacs-hg @ 2001-06-18 07:09:50 by ben] --------------------------------------------------------------- DOCUMENTATION FIXES: --------------------------------------------------------------- eval.c: Correct documentation. elhash.c: Doc correction. --------------------------------------------------------------- LISP OBJECT CLEANUP: --------------------------------------------------------------- bytecode.h, buffer.h, casetab.h, chartab.h, console-msw.h, console.h, database.c, device.h, eldap.h, elhash.h, events.h, extents.h, faces.h, file-coding.h, frame.h, glyphs.h, gui-x.h, gui.h, keymap.h, lisp-disunion.h, lisp-union.h, lisp.h, lrecord.h, lstream.h, mule-charset.h, objects.h, opaque.h, postgresql.h, process.h, rangetab.h, specifier.h, toolbar.h, tooltalk.h, ui-gtk.h: Add wrap_* to all objects (it was already there for a few of them) -- an expression to encapsulate a pointer into a Lisp object, rather than the inconvenient XSET*. "wrap" was chosen because "make" as in make_int(), make_char() is not appropriate. (It implies allocation. The issue does not exist for ints and chars because they are not allocated.) Full error checking has been added to these expressions. When used without error checking, non-union build, use of these expressions will incur no loss of efficiency. (In fact, XSET* is now defined in terms of wrap_* in a non-union build.) In a union build, you will also get no loss of efficiency provided that you have a decent optimizing compiler, and a compiler that either understands inlines or automatically inlines those particular functions. (And since people don't normally do their production builds on union, it doesn't matter.) Update the sample Lisp object definition in lrecord.h accordingly. dumper.c: Fix places in dumper that referenced wrap_object to reference its new name, wrap_pointer_1. buffer.c, bufslots.h, conslots.h, console.c, console.h, devslots.h, device.c, device.h, frame.c, frame.h, frameslots.h, window.c, window.h, winslots.h: -- Extract out the Lisp objects of `struct device' into devslots.h, just like for the other structures. -- Extract out the remaining (not copied into the window config) Lisp objects in `struct window' into winslots.h; use different macros (WINDOW_SLOT vs. WINDOW_SAVED_SLOT) to differentiate them. -- Eliminate the `dead' flag of `struct frame', since it duplicates information already available in `framemeths', and fix FRAME_LIVE_P accordingly. (Devices and consoles already work this way.) -- In *slots.h, switch to system where MARKED_SLOT is automatically undef'd at the end of the file. (Follows what winslots.h already does.) -- Update the comments at the beginning of *slots.h to be accurate. -- When making any of the above objects dead, zero it out entirely and reset all Lisp object slots to Qnil. (We were already doing this somewhat, but not consistently.) This (1) Eliminates the possibility of extra objects hanging around that ought to be GC'd, (2) Causes an immediate crash if anyone tries to access a structure in one of these objects, (3) Ensures consistent behavior wrt dead objects. dialog-msw.c: Use internal_object_printer, since this object should not escape. --------------------------------------------------------------- FIXING A CRASH THAT I HIT ONCE (AND A RELATED BAD BEHAVIOR): --------------------------------------------------------------- eval.c: Fix up some comments about the FSF implementation. Fix two nasty bugs: (1) condition_case_unwind frees the conses sitting in the catch->tag slot too quickly, resulting in a crash that I hit. (2) catches need to be unwound one at a time when calling unwind-protect code, rather than all at once at the end; otherwise, incorrect behavior can result. (A comment shows exactly how.) backtrace.h: Improve comment about FSF differences in the handler stack. --------------------------------------------------------------- FIXING A CRASH THAT I REPEATEDLY HIT WHEN USING THE MOUSE WHEEL UNDER MSWINDOWS: --------------------------------------------------------------- Basic idea: My crash is due either to a dead, non-marked, GC-collected frame inside of a window mirror, or a prematurely freed window mirror. We need to mark the Lisp objects inside of window mirrors. Tracking the lifespan of window mirrors and scrollbar instances is extremely hard, and there may well be lurking bugs where such objects are freed too soon. The only safe way to fix these problems (and it fixes both problems at once) is to make both of these structures Lisp objects. lrecord.h, emacs.c, inline.c, scrollbar-gtk.c, scrollbar-msw.c, scrollbar-x.c, scrollbar.c, scrollbar.h, symsinit.h: Make scrollbar instances actual Lisp objects. Mark the window mirrors in them. inline.c needs to know about scrollbar.h now. Record the new type in lrecord.h. Fix up scrollbar-*.c appropriately. Create a hash table in scrollbar-msw.c so that the scrollbar instances stored in scrollbar HWND's are properly GC-protected. Create complex_vars_of_scrollbar_mswindows() to create the hash table at startup, and call it from emacs.c. Don't store the scrollbar instance as a property of the GTK scrollbar, as it's not used and if we did this, we'd have to separately GC-protect it in a hash table, like in MS Windows. lrecord.h, frame.h, frame.c, frameslots.h, redisplay.c, window.c, window.h: Move mark_window_mirror from redisplay.c to window.c. Make window mirrors actual Lisp objects. Tell lrecord.h about them. Change the window mirror member of struct frame from a pointer to a Lisp object, and add XWINDOW_MIRROR in appropriate places. Mark the scrollbar instances in the window mirror. redisplay.c, redisplay.h, alloc.c: Delete mark_redisplay. Don't call mark_redisplay. We now mark frame-specific structures in mark_frame. NOTE: I also deleted an extremely questionable call to update_frame_window_mirrors(). It was extremely questionable before, and now totally impossible, since it will create Lisp objects during redisplay. frame.c: Mark the scrollbar instances, which are now Lisp objects. Call mark_gutter() here, not in mark_redisplay(). gutter.c: Update comments about correct marking. --------------------------------------------------------------- ISSUES BROUGHT UP BY MARTIN: --------------------------------------------------------------- buffer.h: Put back these macros the way Steve T and I think they ought to be. I already explained in a previous changelog entry why I think these macros should be the way I'd defined them. Once again: We fix these macros so they don't care about the type of their lvalues. The non-C-string equivalents of these already function in the same way, and it's correct because it should be OK to pass in a CBufbyte *, a BufByte *, a Char_Binary *, an UChar_Binary *, etc. The whole reason for these different types is to work around errors caused by signed-vs-unsigned non-matching types. Any possible error that might be caught in a DFC macro would also be caught wherever the argument is used elsewhere. So creating multiple macro versions would add no useful error-checking and just further complicate an already complicated area. As for Martin's "ANSI aliasing" bug, XEmacs is not ANSI-aliasing clean and probably never will be. Unless the board agrees to change XEmacs in this way (and we really don't want to go down that road), this is not a bug. sound.h: Undo Martin's type change. signal.c: Fix problem identified by Martin with Linux and g++ due to non-standard declaration of setitimer(). systime.h: Update the docs for "qxe_" to point out why making the encapsulation explicit is always the right way to go. (setitimer() itself serves as an example.) For 21.4: update-elc-2.el: Correct misplaced parentheses, making lisp/mule not get recompiled.
author ben
date Mon, 18 Jun 2001 07:10:32 +0000
parents 0784d089fdc9
children b39c14581166
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 /* The "lrecord" structure (header of a compound lisp object).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 Copyright (C) 1996 Ben Wing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 /* Synched up with: Not in FSF. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
24 #ifndef INCLUDED_lrecord_h_
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
25 #define INCLUDED_lrecord_h_
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 /* The "lrecord" type of Lisp object is used for all object types
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 other than a few simple ones. This allows many types to be
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
29 implemented but only a few bits required in a Lisp object for type
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
30 information. (The tradeoff is that each object has its type marked
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
31 in it, thereby increasing its size.) All lrecords begin with a
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
32 `struct lrecord_header', which identifies the lisp object type, by
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
33 providing an index into a table of `struct lrecord_implementation',
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
34 which describes the behavior of the lisp object. It also contains
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
35 some other data bits.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 Lrecords are of two types: straight lrecords, and lcrecords.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 Straight lrecords are used for those types of objects that have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 their own allocation routines (typically allocated out of 2K chunks
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 of memory called `frob blocks'). These objects have a `struct
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 lrecord_header' at the top, containing only the bits needed to find
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 the lrecord_implementation for the object. There are special
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 routines in alloc.c to deal with each such object type.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
45 Lcrecords are used for less common sorts of objects that don't do
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
46 their own allocation. Each such object is malloc()ed individually,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
47 and the objects are chained together through a `next' pointer.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
48 Lcrecords have a `struct lcrecord_header' at the top, which
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
49 contains a `struct lrecord_header' and a `next' pointer, and are
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
50 allocated using alloc_lcrecord().
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 Creating a new lcrecord type is fairly easy; just follow the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 lead of some existing type (e.g. hash tables). Note that you
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 do not need to supply all the methods (see below); reasonable
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 defaults are provided for many of them. Alternatively, if you're
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 just looking for a way of encapsulating data (which possibly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 could contain Lisp_Objects in it), you may well be able to use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 the opaque type. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 struct lrecord_header
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 /* index into lrecord_implementations_table[] */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
63 unsigned int type :8;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
64
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
65 /* If `mark' is 0 after the GC mark phase, the object will be freed
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
66 during the GC sweep phase. There are 2 ways that `mark' can be 1:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
67 - by being referenced from other objects during the GC mark phase
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
68 - because it is permanently on, for c_readonly objects */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
69 unsigned int mark :1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
70
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
71 /* 1 if the object resides in logically read-only space, and does not
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
72 reference other non-c_readonly objects.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
73 Invariant: if (c_readonly == 1), then (mark == 1 && lisp_readonly == 1) */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
74 unsigned int c_readonly :1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
75
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 /* 1 if the object is readonly from lisp */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
77 unsigned int lisp_readonly :1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 struct lrecord_implementation;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
81 int lrecord_type_index (const struct lrecord_implementation *implementation);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
83 #define set_lheader_implementation(header,imp) do { \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 struct lrecord_header* SLI_header = (header); \
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
85 SLI_header->type = (imp)->lrecord_type_index; \
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
86 SLI_header->mark = 0; \
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
87 SLI_header->c_readonly = 0; \
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
88 SLI_header->lisp_readonly = 0; \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 struct lcrecord_header
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 struct lrecord_header lheader;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
95 /* The `next' field is normally used to chain all lcrecords together
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 so that the GC can find (and free) all of them.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
97 `alloc_lcrecord' threads lcrecords together.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 The `next' field may be used for other purposes as long as some
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 other mechanism is provided for letting the GC do its work.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 For example, the event and marker object types allocate members
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 out of memory chunks, and are able to find all unmarked members
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 by sweeping through the elements of the list of chunks. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 struct lcrecord_header *next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 /* The `uid' field is just for debugging/printing convenience.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 Having this slot doesn't hurt us much spacewise, since an
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 lcrecord already has the above slots plus malloc overhead. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 unsigned int uid :31;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 /* The `free' field is a flag that indicates whether this lcrecord
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 is on a "free list". Free lists are used to minimize the number
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 of calls to malloc() when we're repeatedly allocating and freeing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 a number of the same sort of lcrecord. Lcrecords on a free list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 always get marked in a different fashion, so we can use this flag
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 as a sanity check to make sure that free lists only have freed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 lcrecords and there are no freed lcrecords elsewhere. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 unsigned int free :1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 /* Used for lcrecords in an lcrecord-list. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 struct free_lcrecord_header
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 struct lcrecord_header lcheader;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 Lisp_Object chain;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
129 enum lrecord_type
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
130 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
131 /* Symbol value magic types come first to make SYMBOL_VALUE_MAGIC_P fast.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
132 #### This should be replaced by a symbol_value_magic_p flag
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
133 in the Lisp_Symbol lrecord_header. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
134 lrecord_type_symbol_value_forward,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
135 lrecord_type_symbol_value_varalias,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
136 lrecord_type_symbol_value_lisp_magic,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
137 lrecord_type_symbol_value_buffer_local,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
138 lrecord_type_max_symbol_value_magic = lrecord_type_symbol_value_buffer_local,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
139
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
140 lrecord_type_symbol,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
141 lrecord_type_subr,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
142 lrecord_type_cons,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
143 lrecord_type_vector,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
144 lrecord_type_string,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
145 lrecord_type_lcrecord_list,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
146 lrecord_type_compiled_function,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
147 lrecord_type_weak_list,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
148 lrecord_type_bit_vector,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
149 lrecord_type_float,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
150 lrecord_type_hash_table,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
151 lrecord_type_lstream,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
152 lrecord_type_process,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
153 lrecord_type_charset,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
154 lrecord_type_coding_system,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
155 lrecord_type_char_table,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
156 lrecord_type_char_table_entry,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
157 lrecord_type_range_table,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
158 lrecord_type_opaque,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
159 lrecord_type_opaque_ptr,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
160 lrecord_type_buffer,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
161 lrecord_type_extent,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
162 lrecord_type_extent_info,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
163 lrecord_type_extent_auxiliary,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
164 lrecord_type_marker,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
165 lrecord_type_event,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
166 lrecord_type_keymap,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
167 lrecord_type_command_builder,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
168 lrecord_type_timeout,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
169 lrecord_type_specifier,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
170 lrecord_type_console,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
171 lrecord_type_device,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
172 lrecord_type_frame,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
173 lrecord_type_window,
617
af57a77cbc92 [xemacs-hg @ 2001-06-18 07:09:50 by ben]
ben
parents: 462
diff changeset
174 lrecord_type_window_mirror,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
175 lrecord_type_window_configuration,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
176 lrecord_type_gui_item,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
177 lrecord_type_popup_data,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
178 lrecord_type_toolbar_button,
617
af57a77cbc92 [xemacs-hg @ 2001-06-18 07:09:50 by ben]
ben
parents: 462
diff changeset
179 lrecord_type_scrollbar_instance,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
180 lrecord_type_color_instance,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
181 lrecord_type_font_instance,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
182 lrecord_type_image_instance,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
183 lrecord_type_glyph,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
184 lrecord_type_face,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
185 lrecord_type_database,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
186 lrecord_type_tooltalk_message,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
187 lrecord_type_tooltalk_pattern,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
188 lrecord_type_ldap,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
189 lrecord_type_pgconn,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
190 lrecord_type_pgresult,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
191 lrecord_type_devmode,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
192 lrecord_type_mswindows_dialog_id,
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
193 lrecord_type_case_table,
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 454
diff changeset
194 lrecord_type_emacs_ffi,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 454
diff changeset
195 lrecord_type_emacs_gtk_object,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 454
diff changeset
196 lrecord_type_emacs_gtk_boxed,
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 446
diff changeset
197 lrecord_type_free, /* only used for "free" lrecords */
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 446
diff changeset
198 lrecord_type_undefined, /* only used for debugging */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
199 lrecord_type_last_built_in_type /* must be last */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
200 };
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
201
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
202 extern unsigned int lrecord_type_count;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 struct lrecord_implementation
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
206 const char *name;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
207
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
208 /* `marker' is called at GC time, to make sure that all Lisp_Objects
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 pointed to by this object get properly marked. It should call
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 the mark_object function on all Lisp_Objects in the object. If
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 the return value is non-nil, it should be a Lisp_Object to be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 marked (don't call the mark_object function explicitly on it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 because the GC routines will do this). Doing it this way reduces
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 recursion, so the object returned should preferably be the one
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 with the deepest level of Lisp_Object pointers. This function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 can be NULL, meaning no GC marking is necessary. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 Lisp_Object (*marker) (Lisp_Object);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
218
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
219 /* `printer' converts the object to a printed representation.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
220 This can be NULL; in this case default_object_printer() will be
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
221 used instead. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 void (*printer) (Lisp_Object, Lisp_Object printcharfun, int escapeflag);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
223
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
224 /* `finalizer' is called at GC time when the object is about to
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 be freed, and at dump time (FOR_DISKSAVE will be non-zero in this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 case). It should perform any necessary cleanup (e.g. freeing
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
227 malloc()ed memory). This can be NULL, meaning no special
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 finalization is necessary.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
230 WARNING: remember that `finalizer' is called at dump time even
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 though the object is not being freed. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 void (*finalizer) (void *header, int for_disksave);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
233
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 /* This can be NULL, meaning compare objects with EQ(). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 int (*equal) (Lisp_Object obj1, Lisp_Object obj2, int depth);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
236
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
237 /* `hash' generates hash values for use with hash tables that have
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
238 `equal' as their test function. This can be NULL, meaning use
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
239 the Lisp_Object itself as the hash. But, you must still satisfy
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
240 the constraint that if two objects are `equal', then they *must*
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
241 hash to the same value in order for hash tables to work properly.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
242 This means that `hash' can be NULL only if the `equal' method is
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
243 also NULL. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 unsigned long (*hash) (Lisp_Object, int);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 /* External data layout description */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 const struct lrecord_description *description;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
249 /* These functions allow any object type to have builtin property
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
250 lists that can be manipulated from the lisp level with
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
251 `get', `put', `remprop', and `object-plist'. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 Lisp_Object (*getprop) (Lisp_Object obj, Lisp_Object prop);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 int (*putprop) (Lisp_Object obj, Lisp_Object prop, Lisp_Object val);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 int (*remprop) (Lisp_Object obj, Lisp_Object prop);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 Lisp_Object (*plist) (Lisp_Object obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
257 /* Only one of `static_size' and `size_in_bytes_method' is non-0.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
258 If both are 0, this type is not instantiable by alloc_lcrecord(). */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 size_t static_size;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
260 size_t (*size_in_bytes_method) (const void *header);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
261
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
262 /* The (constant) index into lrecord_implementations_table */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
263 enum lrecord_type lrecord_type_index;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
264
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 /* A "basic" lrecord is any lrecord that's not an lcrecord, i.e.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 one that does not have an lcrecord_header at the front and which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 is (usually) allocated in frob blocks. We only use this flag for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 some consistency checking, and that only when error-checking is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 enabled. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
270 unsigned int basic_p :1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272
617
af57a77cbc92 [xemacs-hg @ 2001-06-18 07:09:50 by ben]
ben
parents: 462
diff changeset
273 /* All the built-in lisp object types are enumerated in `enum lrecord_type'.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
274 Additional ones may be defined by a module (none yet). We leave some
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
275 room in `lrecord_implementations_table' for such new lisp object types. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
276 #define MODULE_DEFINABLE_TYPE_COUNT 32
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
277
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
278 extern const struct lrecord_implementation *lrecord_implementations_table[(unsigned int)lrecord_type_last_built_in_type + MODULE_DEFINABLE_TYPE_COUNT];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 #define XRECORD_LHEADER_IMPLEMENTATION(obj) \
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
281 LHEADER_IMPLEMENTATION (XRECORD_LHEADER (obj))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
282 #define LHEADER_IMPLEMENTATION(lh) lrecord_implementations_table[(lh)->type]
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 extern int gc_in_progress;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
286 #define MARKED_RECORD_P(obj) (XRECORD_LHEADER (obj)->mark)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 #define MARKED_RECORD_HEADER_P(lheader) ((lheader)->mark)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 #define MARK_RECORD_HEADER(lheader) ((void) ((lheader)->mark = 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 #define UNMARK_RECORD_HEADER(lheader) ((void) ((lheader)->mark = 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 #define C_READONLY_RECORD_HEADER_P(lheader) ((lheader)->c_readonly)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 #define LISP_READONLY_RECORD_HEADER_P(lheader) ((lheader)->lisp_readonly)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
293 #define SET_C_READONLY_RECORD_HEADER(lheader) do { \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
294 struct lrecord_header *SCRRH_lheader = (lheader); \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
295 SCRRH_lheader->c_readonly = 1; \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
296 SCRRH_lheader->lisp_readonly = 1; \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
297 SCRRH_lheader->mark = 1; \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
298 } while (0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 #define SET_LISP_READONLY_RECORD_HEADER(lheader) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 ((void) ((lheader)->lisp_readonly = 1))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
301 #define RECORD_MARKER(lheader) lrecord_markers[(lheader)->type]
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 /* External description stuff
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 A lrecord external description is an array of values. The first
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 value of each line is a type, the second the offset in the lrecord
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 structure. Following values are parameters, their presence, type
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
308 and number is type-dependent.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 The description ends with a "XD_END" or "XD_SPECIFIER_END" record.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 Some example descriptions :
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
313
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 static const struct lrecord_description cons_description[] = {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
315 { XD_LISP_OBJECT, offsetof (Lisp_Cons, car) },
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
316 { XD_LISP_OBJECT, offsetof (Lisp_Cons, cdr) },
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 { XD_END }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
320 Which means "two lisp objects starting at the 'car' and 'cdr' elements"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 static const struct lrecord_description string_description[] = {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
323 { XD_BYTECOUNT, offsetof (Lisp_String, size) },
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
324 { XD_OPAQUE_DATA_PTR, offsetof (Lisp_String, data), XD_INDIRECT(0, 1) },
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
325 { XD_LISP_OBJECT, offsetof (Lisp_String, plist) },
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 { XD_END }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 "A pointer to string data at 'data', the size of the pointed array being the value
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 of the size variable plus 1, and one lisp object at 'plist'"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 The existing types :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 XD_LISP_OBJECT
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
333 A Lisp object. This is also the type to use for pointers to other lrecords.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
335 XD_LISP_OBJECT_ARRAY
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
336 An array of Lisp objects or pointers to lrecords.
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
337 The third element is the count.
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
338
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 XD_LO_LINK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 Link in a linked list of objects of the same type.
432
3a7e78e1142d Import from CVS: tag r21-2-24
cvs
parents: 430
diff changeset
341
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 XD_OPAQUE_PTR
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 Pointer to undumpable data. Must be NULL when dumping.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 XD_STRUCT_PTR
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 Pointer to described struct. Parameters are number of structures and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 struct_description.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 XD_OPAQUE_DATA_PTR
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 Pointer to dumpable opaque data. Parameter is the size of the data.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 Pointed data must be relocatable without changes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 XD_C_STRING
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 Pointer to a C string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 XD_DOC_STRING
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 Pointer to a doc string (C string if positive, opaque value if negative)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 XD_INT_RESET
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 An integer which will be reset to a given value in the dump file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 XD_SIZE_T
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 size_t value. Used for counts.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 XD_INT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 int value. Used for counts.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 XD_LONG
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 long value. Used for counts.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 XD_BYTECOUNT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 bytecount value. Used for counts.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 XD_END
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 Special type indicating the end of the array.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 XD_SPECIFIER_END
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 Special type indicating the end of the array for a specifier. Extra
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 description is going to be fetched from the specifier methods.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 Special macros:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 XD_INDIRECT(line, delta)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 Usable where a "count" or "size" is requested. Gives the value of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 the element which is at line number 'line' in the description (count
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 starts at zero) and adds delta to it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 enum lrecord_description_type {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
391 XD_LISP_OBJECT_ARRAY,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 XD_LISP_OBJECT,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 XD_LO_LINK,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 XD_OPAQUE_PTR,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 XD_STRUCT_PTR,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 XD_OPAQUE_DATA_PTR,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 XD_C_STRING,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 XD_DOC_STRING,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 XD_INT_RESET,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 XD_SIZE_T,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 XD_INT,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 XD_LONG,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 XD_BYTECOUNT,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 XD_END,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 XD_SPECIFIER_END
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 struct lrecord_description {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 enum lrecord_description_type type;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 int offset;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 EMACS_INT data1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 const struct struct_description *data2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 struct struct_description {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 size_t size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 const struct lrecord_description *description;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 #define XD_INDIRECT(val, delta) (-1-((val)|(delta<<8)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 #define XD_IS_INDIRECT(code) (code<0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 #define XD_INDIRECT_VAL(code) ((-1-code) & 255)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 #define XD_INDIRECT_DELTA(code) (((-1-code)>>8) & 255)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 #define XD_DYNARR_DESC(base_type, sub_desc) \
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
427 { XD_STRUCT_PTR, offsetof (base_type, base), XD_INDIRECT(1, 0), sub_desc }, \
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
428 { XD_INT, offsetof (base_type, cur) }, \
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
429 { XD_INT_RESET, offsetof (base_type, max), XD_INDIRECT(1, 0) }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 /* DEFINE_LRECORD_IMPLEMENTATION is for objects with constant size.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION is for objects whose size varies.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 #if defined (ERROR_CHECK_TYPECHECK)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 # define DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 # define DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 #define DEFINE_BASIC_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
444 #define DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
445 MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof(structtype),0,1,structtype)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 #define DEFINE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
450 #define DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
451 MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof (structtype),0,0,structtype)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 #define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,sizer,structtype)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
456 #define DEFINE_BASIC_LRECORD_SEQUENCE_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
457 MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,sizer,1,structtype)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
459 #define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizer,structtype) \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
460 MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,0,sizer,0,structtype) \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
461
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
462 #define MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype) \
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
464 const struct lrecord_implementation lrecord_##c_name = \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 { name, marker, printer, nuker, equal, hash, desc, \
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
466 getprop, putprop, remprop, plist, size, sizer, \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
467 lrecord_type_##c_name, basic_p }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
468
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
469 #define DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
470 DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
471
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
472 #define DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
473 MAKE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof (structtype),0,0,structtype)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
474
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
475 #define DEFINE_EXTERNAL_LRECORD_SEQUENCE_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
476 DEFINE_EXTERNAL_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,sizer,structtype)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
477
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
478 #define DEFINE_EXTERNAL_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizer,structtype) \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
479 MAKE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,0,sizer,0,structtype)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
480
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
481 #define MAKE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
482 DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype) \
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
483 unsigned int lrecord_type_##c_name; \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
484 struct lrecord_implementation lrecord_##c_name = \
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
485 { name, marker, printer, nuker, equal, hash, desc, \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
486 getprop, putprop, remprop, plist, size, sizer, \
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
487 lrecord_type_last_built_in_type, basic_p }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
488
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
489
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
490 extern Lisp_Object (*lrecord_markers[]) (Lisp_Object);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
491
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
492 #define INIT_LRECORD_IMPLEMENTATION(type) do { \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
493 lrecord_implementations_table[lrecord_type_##type] = &lrecord_##type; \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
494 lrecord_markers[lrecord_type_##type] = \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
495 lrecord_implementations_table[lrecord_type_##type]->marker; \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
496 } while (0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
498 #define INIT_EXTERNAL_LRECORD_IMPLEMENTATION(type) do { \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
499 lrecord_type_##type = lrecord_type_count++; \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
500 lrecord_##type.lrecord_type_index = lrecord_type_##type; \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
501 INIT_LRECORD_IMPLEMENTATION(type); \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
502 } while (0)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
503
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 #define LRECORDP(a) (XTYPE (a) == Lisp_Type_Record)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 #define XRECORD_LHEADER(a) ((struct lrecord_header *) XPNTR (a))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 #define RECORD_TYPEP(x, ty) \
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
508 (LRECORDP (x) && (((unsigned int)(XRECORD_LHEADER (x)->type)) == ((unsigned int)(ty))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
509
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
510 /* Steps to create a new object:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
511
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
512 1. Declare the struct for your object in a header file somewhere.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
513 Remember that it must begin with
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
514
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
515 struct lcrecord_header header;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
516
617
af57a77cbc92 [xemacs-hg @ 2001-06-18 07:09:50 by ben]
ben
parents: 462
diff changeset
517 2. Put the "standard junk" (DECLARE_RECORD()/XFOO/XSETFOO/etc.) below the
af57a77cbc92 [xemacs-hg @ 2001-06-18 07:09:50 by ben]
ben
parents: 462
diff changeset
518 struct definition -- see below.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
519
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
520 3. Add this header file to inline.c.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
521
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
522 4. Create the methods for your object. Note that technically you don't
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
523 need any, but you will almost always want at least a mark method.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
524
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
525 5. Define your object with DEFINE_LRECORD_IMPLEMENTATION() or some
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
526 variant.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
527
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
528 6. Include the header file in the .c file where you defined the object.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
529
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
530 7. Put a call to INIT_LRECORD_IMPLEMENTATION() for the object in the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
531 .c file's syms_of_foo() function.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
532
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
533 8. Add a type enum for the object to enum lrecord_type, earlier in this
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
534 file.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
535
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
536 An example:
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
538 ------------------------------ in toolbar.h -----------------------------
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
539
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
540 struct toolbar_button
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
541 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
542 struct lcrecord_header header;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
543
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
544 Lisp_Object next;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
545 Lisp_Object frame;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
546
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
547 Lisp_Object up_glyph;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
548 Lisp_Object down_glyph;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
549 Lisp_Object disabled_glyph;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
550
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
551 Lisp_Object cap_up_glyph;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
552 Lisp_Object cap_down_glyph;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
553 Lisp_Object cap_disabled_glyph;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
554
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
555 Lisp_Object callback;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
556 Lisp_Object enabled_p;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
557 Lisp_Object help_string;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
558
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
559 char enabled;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
560 char down;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
561 char pushright;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
562 char blank;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
563
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
564 int x, y;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
565 int width, height;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
566 int dirty;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
567 int vertical;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
568 int border_width;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
569 };
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570
617
af57a77cbc92 [xemacs-hg @ 2001-06-18 07:09:50 by ben]
ben
parents: 462
diff changeset
571 [[ the standard junk: ]]
af57a77cbc92 [xemacs-hg @ 2001-06-18 07:09:50 by ben]
ben
parents: 462
diff changeset
572
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
573 DECLARE_LRECORD (toolbar_button, struct toolbar_button);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
574 #define XTOOLBAR_BUTTON(x) XRECORD (x, toolbar_button, struct toolbar_button)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
575 #define XSETTOOLBAR_BUTTON(x, p) XSETRECORD (x, p, toolbar_button)
617
af57a77cbc92 [xemacs-hg @ 2001-06-18 07:09:50 by ben]
ben
parents: 462
diff changeset
576 #define wrap_toolbar_button(p) wrap_record (p, toolbar_button)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
577 #define TOOLBAR_BUTTONP(x) RECORDP (x, toolbar_button)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
578 #define CHECK_TOOLBAR_BUTTON(x) CHECK_RECORD (x, toolbar_button)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
579 #define CONCHECK_TOOLBAR_BUTTON(x) CONCHECK_RECORD (x, toolbar_button)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
580
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
581 ------------------------------ in toolbar.c -----------------------------
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
582
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
583 #include "toolbar.h"
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
584
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
585 ...
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
586
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
587 static Lisp_Object
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
588 mark_toolbar_button (Lisp_Object obj)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
589 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
590 struct toolbar_button *data = XTOOLBAR_BUTTON (obj);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
591 mark_object (data->next);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
592 mark_object (data->frame);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
593 mark_object (data->up_glyph);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
594 mark_object (data->down_glyph);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
595 mark_object (data->disabled_glyph);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
596 mark_object (data->cap_up_glyph);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
597 mark_object (data->cap_down_glyph);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
598 mark_object (data->cap_disabled_glyph);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
599 mark_object (data->callback);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
600 mark_object (data->enabled_p);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
601 return data->help_string;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
602 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
603
617
af57a77cbc92 [xemacs-hg @ 2001-06-18 07:09:50 by ben]
ben
parents: 462
diff changeset
604 [[ If your object should never escape to Lisp, declare its print method
af57a77cbc92 [xemacs-hg @ 2001-06-18 07:09:50 by ben]
ben
parents: 462
diff changeset
605 as internal_object_printer instead of 0. ]]
af57a77cbc92 [xemacs-hg @ 2001-06-18 07:09:50 by ben]
ben
parents: 462
diff changeset
606
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
607 DEFINE_LRECORD_IMPLEMENTATION ("toolbar-button", toolbar_button,
617
af57a77cbc92 [xemacs-hg @ 2001-06-18 07:09:50 by ben]
ben
parents: 462
diff changeset
608 mark_toolbar_button, 0,
af57a77cbc92 [xemacs-hg @ 2001-06-18 07:09:50 by ben]
ben
parents: 462
diff changeset
609 0, 0, 0, 0, struct toolbar_button);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
610
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
611 ...
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
612
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
613 void
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
614 syms_of_toolbar (void)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
615 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
616 INIT_LRECORD_IMPLEMENTATION (toolbar_button);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
617
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
618 ...;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
619 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
620
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
621 ------------------------------ in inline.c -----------------------------
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
622
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
623 #ifdef HAVE_TOOLBARS
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
624 #include "toolbar.h"
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
625 #endif
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
626
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
627 ------------------------------ in lrecord.h -----------------------------
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
628
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
629 enum lrecord_type
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
630 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
631 ...
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
632 lrecord_type_toolbar_button,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
633 ...
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
634 };
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
635
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
636 */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
637
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
638 /*
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
639
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
640 Note: Object types defined in external dynamically-loaded modules (not
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
641 part of the XEmacs main source code) should use DECLARE_EXTERNAL_LRECORD
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
642 and DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION rather than DECLARE_LRECORD
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
643 and DEFINE_LRECORD_IMPLEMENTATION.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
644
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
645 */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
646
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 #ifdef ERROR_CHECK_TYPECHECK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 # define DECLARE_LRECORD(c_name, structtype) \
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
651 extern const struct lrecord_implementation lrecord_##c_name; \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
652 INLINE_HEADER structtype * \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
653 error_check_##c_name (Lisp_Object obj); \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
654 INLINE_HEADER structtype * \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 error_check_##c_name (Lisp_Object obj) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 { \
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
657 assert (RECORD_TYPEP (obj, lrecord_type_##c_name)); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 return (structtype *) XPNTR (obj); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 extern Lisp_Object Q##c_name##p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
662 # define DECLARE_EXTERNAL_LRECORD(c_name, structtype) \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
663 extern unsigned int lrecord_type_##c_name; \
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
664 extern struct lrecord_implementation lrecord_##c_name; \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
665 INLINE_HEADER structtype * \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
666 error_check_##c_name (Lisp_Object obj); \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
667 INLINE_HEADER structtype * \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
668 error_check_##c_name (Lisp_Object obj) \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
669 { \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
670 assert (RECORD_TYPEP (obj, lrecord_type_##c_name)); \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
671 return (structtype *) XPNTR (obj); \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
672 } \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
673 extern Lisp_Object Q##c_name##p
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
674
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 # define DECLARE_NONRECORD(c_name, type_enum, structtype) \
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
676 INLINE_HEADER structtype * \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
677 error_check_##c_name (Lisp_Object obj); \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
678 INLINE_HEADER structtype * \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 error_check_##c_name (Lisp_Object obj) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 assert (XTYPE (obj) == type_enum); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 return (structtype *) XPNTR (obj); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 extern Lisp_Object Q##c_name##p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 # define XRECORD(x, c_name, structtype) error_check_##c_name (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 # define XNONRECORD(x, c_name, type_enum, structtype) error_check_##c_name (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 # define XSETRECORD(var, p, c_name) do \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 { \
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
691 XSETOBJ (var, p); \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
692 assert (RECORD_TYPEP (var, lrecord_type_##c_name)); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694
617
af57a77cbc92 [xemacs-hg @ 2001-06-18 07:09:50 by ben]
ben
parents: 462
diff changeset
695 INLINE_HEADER Lisp_Object wrap_record_1 (void *ptr, enum lrecord_type ty);
af57a77cbc92 [xemacs-hg @ 2001-06-18 07:09:50 by ben]
ben
parents: 462
diff changeset
696 INLINE_HEADER Lisp_Object
af57a77cbc92 [xemacs-hg @ 2001-06-18 07:09:50 by ben]
ben
parents: 462
diff changeset
697 wrap_record_1 (void *ptr, enum lrecord_type ty)
af57a77cbc92 [xemacs-hg @ 2001-06-18 07:09:50 by ben]
ben
parents: 462
diff changeset
698 {
af57a77cbc92 [xemacs-hg @ 2001-06-18 07:09:50 by ben]
ben
parents: 462
diff changeset
699 Lisp_Object obj;
af57a77cbc92 [xemacs-hg @ 2001-06-18 07:09:50 by ben]
ben
parents: 462
diff changeset
700 XSETOBJ (obj, ptr);
af57a77cbc92 [xemacs-hg @ 2001-06-18 07:09:50 by ben]
ben
parents: 462
diff changeset
701 assert (RECORD_TYPEP (obj, ty));
af57a77cbc92 [xemacs-hg @ 2001-06-18 07:09:50 by ben]
ben
parents: 462
diff changeset
702 return obj;
af57a77cbc92 [xemacs-hg @ 2001-06-18 07:09:50 by ben]
ben
parents: 462
diff changeset
703 }
af57a77cbc92 [xemacs-hg @ 2001-06-18 07:09:50 by ben]
ben
parents: 462
diff changeset
704
af57a77cbc92 [xemacs-hg @ 2001-06-18 07:09:50 by ben]
ben
parents: 462
diff changeset
705 #define wrap_record(ptr, ty) wrap_record_1 (ptr, lrecord_type_##ty)
af57a77cbc92 [xemacs-hg @ 2001-06-18 07:09:50 by ben]
ben
parents: 462
diff changeset
706
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 #else /* not ERROR_CHECK_TYPECHECK */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 # define DECLARE_LRECORD(c_name, structtype) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 extern Lisp_Object Q##c_name##p; \
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
711 extern const struct lrecord_implementation lrecord_##c_name
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
712 # define DECLARE_EXTERNAL_LRECORD(c_name, structtype) \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
713 extern Lisp_Object Q##c_name##p; \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
714 extern unsigned int lrecord_type_##c_name; \
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
715 extern struct lrecord_implementation lrecord_##c_name
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 # define DECLARE_NONRECORD(c_name, type_enum, structtype) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 extern Lisp_Object Q##c_name##p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 # define XRECORD(x, c_name, structtype) ((structtype *) XPNTR (x))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 # define XNONRECORD(x, c_name, type_enum, structtype) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 ((structtype *) XPNTR (x))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
721 # define XSETRECORD(var, p, c_name) XSETOBJ (var, p)
617
af57a77cbc92 [xemacs-hg @ 2001-06-18 07:09:50 by ben]
ben
parents: 462
diff changeset
722 /* wrap_pointer_1 is so named as a suggestion not to use it unless you
af57a77cbc92 [xemacs-hg @ 2001-06-18 07:09:50 by ben]
ben
parents: 462
diff changeset
723 know what you're doing. */
af57a77cbc92 [xemacs-hg @ 2001-06-18 07:09:50 by ben]
ben
parents: 462
diff changeset
724 #define wrap_record(ptr, ty) wrap_pointer_1 (ptr)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 #endif /* not ERROR_CHECK_TYPECHECK */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
728 #define RECORDP(x, c_name) RECORD_TYPEP (x, lrecord_type_##c_name)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 /* Note: we now have two different kinds of type-checking macros.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 The "old" kind has now been renamed CONCHECK_foo. The reason for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 this is that the CONCHECK_foo macros signal a continuable error,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 allowing the user (through debug-on-error) to substitute a different
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 value and return from the signal, which causes the lvalue argument
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 to get changed. Quite a lot of code would crash if that happened,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 because it did things like
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 foo = XCAR (list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 CHECK_STRING (foo);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 and later on did XSTRING (XCAR (list)), assuming that the type
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 is correct (when it might be wrong, if the user substituted a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 correct value in the debugger).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 To get around this, I made all the CHECK_foo macros signal a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 non-continuable error. Places where a continuable error is OK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 (generally only when called directly on the argument of a Lisp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 primitive) should be changed to use CONCHECK().
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 FSF Emacs does not have this problem because RMS took the cheesy
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 way out and disabled returning from a signal entirely. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 #define CONCHECK_RECORD(x, c_name) do { \
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
754 if (!RECORD_TYPEP (x, lrecord_type_##c_name)) \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 x = wrong_type_argument (Q##c_name##p, x); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 #define CONCHECK_NONRECORD(x, lisp_enum, predicate) do {\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 if (XTYPE (x) != lisp_enum) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 x = wrong_type_argument (predicate, x); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 #define CHECK_RECORD(x, c_name) do { \
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
762 if (!RECORD_TYPEP (x, lrecord_type_##c_name)) \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 dead_wrong_type_argument (Q##c_name##p, x); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 #define CHECK_NONRECORD(x, lisp_enum, predicate) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 if (XTYPE (x) != lisp_enum) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 dead_wrong_type_argument (predicate, x); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
770 void *alloc_lcrecord (size_t size, const struct lrecord_implementation *);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 #define alloc_lcrecord_type(type, lrecord_implementation) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 ((type *) alloc_lcrecord (sizeof (type), lrecord_implementation))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 /* Copy the data from one lcrecord structure into another, but don't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 overwrite the header information. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 #define copy_lcrecord(dst, src) \
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
779 memcpy ((char *) (dst) + sizeof (struct lcrecord_header), \
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
780 (char *) (src) + sizeof (struct lcrecord_header), \
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
781 sizeof (*(dst)) - sizeof (struct lcrecord_header))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 #define zero_lcrecord(lcr) \
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
784 memset ((char *) (lcr) + sizeof (struct lcrecord_header), 0, \
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
785 sizeof (*(lcr)) - sizeof (struct lcrecord_header))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 432
diff changeset
787 #endif /* INCLUDED_lrecord_h_ */