1 /* The "lrecord" structure (header of a compound lisp object).
2 Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
3 Copyright (C) 1996 Ben Wing.
5 This file is part of XEmacs.
7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 2, or (at your option) any
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
17 You should have received a copy of the GNU General Public License
18 along with XEmacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 /* Synched up with: Not in FSF. */
24 #ifndef _XEMACS_LRECORD_H_
25 #define _XEMACS_LRECORD_H_
27 /* The "lrecord" type of Lisp object is used for all object types
28 other than a few simple ones. This allows many types to be
29 implemented but only a few bits required in a Lisp object for
30 type information. (The tradeoff is that each object has its
31 type marked in it, thereby increasing its size.) The first
32 four bytes of all lrecords is either a pointer to a struct
33 lrecord_implementation, which contains methods describing how
34 to process this object, or an index into an array of pointers
35 to struct lrecord_implementations plus some other data bits.
37 Lrecords are of two types: straight lrecords, and lcrecords.
38 Straight lrecords are used for those types of objects that have
39 their own allocation routines (typically allocated out of 2K chunks
40 of memory called `frob blocks'). These objects have a `struct
41 lrecord_header' at the top, containing only the bits needed to find
42 the lrecord_implementation for the object. There are special
43 routines in alloc.c to deal with each such object type.
45 Lcrecords are used for less common sorts of objects that don't
46 do their own allocation. Each such object is malloc()ed
47 individually, and the objects are chained together through
48 a `next' pointer. Lcrecords have a `struct lcrecord_header'
49 at the top, which contains a `struct lrecord_header' and
50 a `next' pointer, and are allocated using alloc_lcrecord().
52 Creating a new lcrecord type is fairly easy; just follow the
53 lead of some existing type (e.g. hashtables). Note that you
54 do not need to supply all the methods (see below); reasonable
55 defaults are provided for many of them. Alternatively, if you're
56 just looking for a way of encapsulating data (which possibly
57 could contain Lisp_Objects in it), you may well be able to use
62 /* It would be better to put the mark-bit together with the
63 following datatype identification field in an 8- or 16-bit
64 integer rather than playing funny games with changing
65 header->implementation and "wasting" 32 bits on the below
66 pointer. The type-id would then be a 7 or 15 bit index into a
67 table of lrecord-implementations rather than a direct pointer.
68 There would be 24 (or 16) bits left over for datatype-specific
71 The below is the simplest thing to do for the present,
72 and doesn't incur that much overhead as most Emacs records
73 are of such a size that the overhead isn't too bad.
74 (The marker datatype is the worst case.)
76 It also has the very very very slight advantage that type-checking
77 involves one memory read (of the "implementation" slot) and a
78 comparison against a link-time constant address rather than a
79 read and a comparison against a variable value. (Variable since
80 it is a very good idea to assign the indices into the hypothetical
81 type-code table dynamically rather that pre-defining them.)
82 I think I remember that Elk Lisp does something like this.
83 Gee, I wonder if some cretin has patented it? */
86 * If USE_INDEXED_LRECORD_IMPLEMENTATION is defined, we are
87 * implementing the scheme described in the 'It would be better
88 * ...' paragraph above.
90 #ifdef USE_INDEXED_LRECORD_IMPLEMENTATION
91 /* index into lrecord_implementations_table[] */
93 /* 1 if the object is marked during GC, 0 otherwise. */
95 /* 1 if the object resides in pure (read-only) space */
98 CONST struct lrecord_implementation *implementation;
102 struct lrecord_implementation;
103 int lrecord_type_index (CONST struct lrecord_implementation *implementation);
105 #ifdef USE_INDEXED_LRECORD_IMPLEMENTATION
106 # define set_lheader_implementation(header,imp) do \
108 (header)->type = lrecord_type_index (imp); \
109 (header)->mark = 0; \
110 (header)->pure = 0; \
113 # define set_lheader_implementation(header,imp) \
114 ((void) ((header)->implementation = (imp)))
117 struct lcrecord_header
119 struct lrecord_header lheader;
120 /* The "next" field is normally used to chain all lrecords together
121 so that the GC can find (and free) all of them.
122 "alloc_lcrecord" threads records together.
124 The "next" field may be used for other purposes as long as some
125 other mechanism is provided for letting the GC do its work. (For
126 example, the event and marker datatypes allocate members out of
127 memory chunks, and are able to find all unmarked members by
128 sweeping through the elements of the list of chunks) */
129 struct lcrecord_header *next;
130 /* This is just for debugging/printing convenience.
131 Having this slot doesn't hurt us much spacewise, since an lcrecord
132 already has the above slots together with malloc overhead. */
133 unsigned int uid :31;
134 /* A flag that indicates whether this lcrecord is on a "free list".
135 Free lists are used to minimize the number of calls to malloc()
136 when we're repeatedly allocating and freeing a number of the
137 same sort of lcrecord. Lcrecords on a free list always get
138 marked in a different fashion, so we can use this flag as a
139 sanity check to make sure that free lists only have freed lcrecords
140 and there are no freed lcrecords elsewhere. */
141 unsigned int free :1;
144 /* Used for lcrecords in an lcrecord-list. */
145 struct free_lcrecord_header
147 struct lcrecord_header lcheader;
151 /* This as the value of lheader->implementation->finalizer
152 * means that this record is already marked */
153 void this_marks_a_marked_record (void *, int);
155 /* see alloc.c for an explanation */
156 Lisp_Object this_one_is_unmarkable (Lisp_Object obj,
157 void (*markobj) (Lisp_Object));
159 struct lrecord_implementation
162 /* This function is called at GC time, to make sure that all Lisp_Objects
163 pointed to by this object get properly marked. It should call
164 the mark_object function on all Lisp_Objects in the object. If
165 the return value is non-nil, it should be a Lisp_Object to be
166 marked (don't call the mark_object function explicitly on it,
167 because the GC routines will do this). Doing it this way reduces
168 recursion, so the object returned should preferably be the one
169 with the deepest level of Lisp_Object pointers. This function
170 can be NULL, meaning no GC marking is necessary. */
171 Lisp_Object (*marker) (Lisp_Object, void (*mark_object) (Lisp_Object));
172 /* This can be NULL if the object is an lcrecord; the
173 default_object_printer() in print.c will be used. */
174 void (*printer) (Lisp_Object, Lisp_Object printcharfun, int escapeflag);
175 /* This function is called at GC time when the object is about to
176 be freed, and at dump time (FOR_DISKSAVE will be non-zero in this
177 case). It should perform any necessary cleanup (e.g. freeing
178 malloc()ed memory. This can be NULL, meaning no special
179 finalization is necessary.
181 WARNING: remember that the finalizer is called at dump time even
182 though the object is not being freed. */
183 void (*finalizer) (void *header, int for_disksave);
184 /* This can be NULL, meaning compare objects with EQ(). */
185 int (*equal) (Lisp_Object obj1, Lisp_Object obj2, int depth);
186 /* This can be NULL, meaning use the Lisp_Object itself as the hash;
187 but *only* if the `equal' function is EQ (if two objects are
188 `equal', they *must* hash to the same value or the hashing won't
190 unsigned long (*hash) (Lisp_Object, int);
191 Lisp_Object (*getprop) (Lisp_Object obj, Lisp_Object prop);
192 int (*putprop) (Lisp_Object obj, Lisp_Object prop, Lisp_Object val);
193 int (*remprop) (Lisp_Object obj, Lisp_Object prop);
194 Lisp_Object (*plist) (Lisp_Object obj);
196 /* Only one of these is non-0. If both are 0, it means that this type
197 is not instantiable by alloc_lcrecord(). */
199 size_t (*size_in_bytes_method) (CONST void *header);
200 /* A unique subtag-code (dynamically) assigned to this datatype. */
201 /* (This is a pointer so the rest of this structure can be read-only.) */
202 int *lrecord_type_index;
203 /* A "basic" lrecord is any lrecord that's not an lcrecord, i.e.
204 one that does not have an lcrecord_header at the front and which
205 is (usually) allocated in frob blocks. We only use this flag for
206 some consistency checking, and that only when error-checking is
211 #ifdef USE_INDEXED_LRECORD_IMPLEMENTATION
212 extern CONST struct lrecord_implementation *lrecord_implementations_table[];
214 # define XRECORD_LHEADER_IMPLEMENTATION(obj) \
215 (lrecord_implementations_table[XRECORD_LHEADER (obj)->type])
216 # define LHEADER_IMPLEMENTATION(lh) (lrecord_implementations_table[(lh)->type])
218 # define XRECORD_LHEADER_IMPLEMENTATION(obj) \
219 (XRECORD_LHEADER (obj)->implementation)
220 # define LHEADER_IMPLEMENTATION(lh) ((lh)->implementation)
223 extern int gc_in_progress;
225 #ifdef USE_INDEXED_LRECORD_IMPLEMENTATION
226 # define MARKED_RECORD_P(obj) (gc_in_progress && XRECORD_LHEADER (obj)->mark)
228 # define MARKED_RECORD_P(obj) (gc_in_progress && \
229 XRECORD_LHEADER (obj)->implementation->finalizer == \
230 this_marks_a_marked_record)
233 #ifdef USE_INDEXED_LRECORD_IMPLEMENTATION
235 # define MARKED_RECORD_HEADER_P(lheader) (lheader)->mark
236 # define MARK_RECORD_HEADER(lheader) (lheader)->mark = 1
237 # define UNMARK_RECORD_HEADER(lheader) (lheader)->mark = 0
239 #else /* ! USE_INDEXED_LRECORD_IMPLEMENTATION */
241 # define MARKED_RECORD_HEADER_P(lheader) \
242 (((lheader)->implementation->finalizer) == this_marks_a_marked_record)
243 # define MARK_RECORD_HEADER(lheader) \
244 do { (((lheader)->implementation)++); } while (0)
245 # define UNMARK_RECORD_HEADER(lheader) \
246 do { (((lheader)->implementation)--); } while (0)
248 #endif /* ! USE_INDEXED_LRECORD_IMPLEMENTATION */
250 #define UNMARKABLE_RECORD_HEADER_P(lheader) \
251 ((LHEADER_IMPLEMENTATION (lheader)->marker) \
252 == this_one_is_unmarkable)
254 /* Declaring the following structures as const puts them in the
255 text (read-only) segment, which makes debugging inconvenient
256 because this segment is not mapped when processing a core-
260 #define CONST_IF_NOT_DEBUG
262 #define CONST_IF_NOT_DEBUG CONST
265 /* DEFINE_LRECORD_IMPLEMENTATION is for objects with constant size.
266 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION is for objects whose size varies.
269 #if defined (ERROR_CHECK_TYPECHECK)
270 # define DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype)
272 # define DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype)
275 #define DEFINE_BASIC_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,structtype) \
276 DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,0,0,0,0,structtype)
278 #define DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,structtype) \
279 MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,sizeof(structtype),0,1,structtype)
281 #define DEFINE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,structtype) \
282 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,0,0,0,0,structtype)
284 #define DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,structtype) \
285 MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,sizeof (structtype),0,0,structtype)
287 #define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,sizer,structtype) \
288 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,0,0,0,0,sizer,structtype)
290 #define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,sizer,structtype) \
291 MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,0,sizer,0,structtype) \
293 #define MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,size,sizer,basic_p,structtype) \
294 DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype) \
295 static int lrecord_##c_name##_lrecord_type_index; \
296 CONST_IF_NOT_DEBUG struct lrecord_implementation lrecord_##c_name[2] = \
297 { { name, marker, printer, nuker, equal, hash, \
298 getprop, putprop, remprop, props, size, sizer, \
299 &(lrecord_##c_name##_lrecord_type_index), basic_p }, \
300 { 0, 0, 0, this_marks_a_marked_record, 0, 0, 0, 0, 0, 0, 0, 0, 0, basic_p } }
302 #define LRECORDP(a) (XTYPE ((a)) == Lisp_Type_Record)
303 #define XRECORD_LHEADER(a) ((struct lrecord_header *) XPNTR (a))
305 #ifdef USE_INDEXED_LRECORD_IMPLEMENTATION
306 # define RECORD_TYPEP(x, ty) \
308 lrecord_implementations_table[XRECORD_LHEADER (x)->type] == (ty))
310 # define RECORD_TYPEP(x, ty) \
311 (LRECORDP (x) && XRECORD_LHEADER (x)->implementation == (ty))
314 /* NOTE: the DECLARE_LRECORD() must come before the associated
315 DEFINE_LRECORD_*() or you will get compile errors.
317 Furthermore, you always need to put the DECLARE_LRECORD() in a header
318 file, and make sure the header file is included in inline.c, even
319 if the type is private to a particular file. Otherwise, you will
320 get undefined references for the error_check_foo() inline function
323 #ifdef ERROR_CHECK_TYPECHECK
325 # define DECLARE_LRECORD(c_name, structtype) \
326 extern CONST_IF_NOT_DEBUG struct lrecord_implementation \
327 lrecord_##c_name[]; \
328 INLINE structtype *error_check_##c_name (Lisp_Object _obj); \
329 INLINE structtype * \
330 error_check_##c_name (Lisp_Object _obj) \
333 assert (RECORD_TYPEP (_obj, lrecord_##c_name) || \
334 MARKED_RECORD_P (_obj)); \
335 return (structtype *) XPNTR (_obj); \
337 extern Lisp_Object Q##c_name##p
339 # define DECLARE_NONRECORD(c_name, type_enum, structtype) \
340 INLINE structtype *error_check_##c_name (Lisp_Object _obj); \
341 INLINE structtype * \
342 error_check_##c_name (Lisp_Object _obj) \
345 assert (XGCTYPE (_obj) == type_enum); \
346 return (structtype *) XPNTR (_obj); \
348 extern Lisp_Object Q##c_name##p
350 # define XRECORD(x, c_name, structtype) error_check_##c_name (x)
351 # define XNONRECORD(x, c_name, type_enum, structtype) error_check_##c_name (x)
353 # define XSETRECORD(var, p, c_name) do \
355 XSETOBJ (var, Lisp_Type_Record, p); \
356 assert (RECORD_TYPEP (var, lrecord_##c_name) || \
357 MARKED_RECORD_P (var)); \
360 #else /* not ERROR_CHECK_TYPECHECK */
362 # define DECLARE_LRECORD(c_name, structtype) \
363 extern Lisp_Object Q##c_name##p; \
364 extern CONST_IF_NOT_DEBUG struct lrecord_implementation \
366 # define DECLARE_NONRECORD(c_name, type_enum, structtype) \
367 extern Lisp_Object Q##c_name##p
368 # define XRECORD(x, c_name, structtype) ((structtype *) XPNTR (x))
369 # define XNONRECORD(x, c_name, type_enum, structtype) \
370 ((structtype *) XPNTR (x))
371 # define XSETRECORD(var, p, c_name) XSETOBJ (var, Lisp_Type_Record, p)
373 #endif /* not ERROR_CHECK_TYPECHECK */
375 #define RECORDP(x, c_name) RECORD_TYPEP (x, lrecord_##c_name)
376 #define GC_RECORDP(x, c_name) gc_record_type_p (x, lrecord_##c_name)
378 /* Note: we now have two different kinds of type-checking macros.
379 The "old" kind has now been renamed CONCHECK_foo. The reason for
380 this is that the CONCHECK_foo macros signal a continuable error,
381 allowing the user (through debug-on-error) to substitute a different
382 value and return from the signal, which causes the lvalue argument
383 to get changed. Quite a lot of code would crash if that happened,
384 because it did things like
389 and later on did XSTRING (XCAR (list)), assuming that the type
390 is correct (when it might be wrong, if the user substituted a
391 correct value in the debugger).
393 To get around this, I made all the CHECK_foo macros signal a
394 non-continuable error. Places where a continuable error is OK
395 (generally only when called directly on the argument of a Lisp
396 primitive) should be changed to use CONCHECK().
398 FSF Emacs does not have this problem because RMS took the cheesy
399 way out and disabled returning from a signal entirely. */
401 #define CONCHECK_RECORD(x, c_name) do { \
402 if (!RECORD_TYPEP (x, lrecord_##c_name)) \
403 x = wrong_type_argument (Q##c_name##p, x); \
405 #define CONCHECK_NONRECORD(x, lisp_enum, predicate) do {\
406 if (XTYPE (x) != lisp_enum) \
407 x = wrong_type_argument (predicate, x); \
409 #define CHECK_RECORD(x, c_name) do { \
410 if (!RECORD_TYPEP (x, lrecord_##c_name)) \
411 dead_wrong_type_argument (Q##c_name##p, x); \
413 #define CHECK_NONRECORD(x, lisp_enum, predicate) do { \
414 if (XTYPE (x) != lisp_enum) \
415 dead_wrong_type_argument (predicate, x); \
418 void *alloc_lcrecord (size_t size, CONST struct lrecord_implementation *);
420 #define alloc_lcrecord_type(type, lrecord_implementation) \
421 ((type *) alloc_lcrecord (sizeof (type), lrecord_implementation))
423 int gc_record_type_p (Lisp_Object frob,
424 CONST struct lrecord_implementation *type);
426 /* Copy the data from one lcrecord structure into another, but don't
427 overwrite the header information. */
429 #define copy_lcrecord(dst, src) \
430 memcpy ((char *) dst + sizeof (struct lcrecord_header), \
431 (char *) src + sizeof (struct lcrecord_header), \
432 sizeof (*dst) - sizeof (struct lcrecord_header))
434 #define zero_lcrecord(lcr) \
435 memset ((char *) lcr + sizeof (struct lcrecord_header), 0, \
436 sizeof (*lcr) - sizeof (struct lcrecord_header))
438 #endif /* _XEMACS_LRECORD_H_ */