Mercurial > hg > xemacs-beta

comparison src/lrecord.h @ 272:c5d627a313b1 r21-0b34

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b34
author cvs
date Mon, 13 Aug 2007 10:28:48 +0200
parents f220cc83d72e
children 8626e4521993
comparison
equal deleted inserted replaced
271:c7b7086b0a39 272:c5d627a313b1
32 four bytes of all lrecords is either a pointer to a struct 32 four bytes of all lrecords is either a pointer to a struct
33 lrecord_implementation, which contains methods describing how 33 lrecord_implementation, which contains methods describing how
34 to process this object, or an index into an array of pointers 34 to process this object, or an index into an array of pointers
35 to struct lrecord_implementations plus some other data bits. 35 to struct lrecord_implementations plus some other data bits.
36 36
37 lrecords are of two types: straight lrecords, and lcrecords. 37 Lrecords are of two types: straight lrecords, and lcrecords.
38 Straight lrecords are used for those types of objects that 38 Straight lrecords are used for those types of objects that have
39 have their own allocation routines (typically allocated out of 39 their own allocation routines (typically allocated out of 2K chunks
40 2K chunks of memory). These objects have a `struct 40 of memory called `frob blocks'). These objects have a `struct
41 lrecord_header' at the top, containing only the bits needed to 41 lrecord_header' at the top, containing only the bits needed to find
42 find the lrecord_implementation for the object. There are 42 the lrecord_implementation for the object. There are special
43 special routines in alloc.c to deal with each such object 43 routines in alloc.c to deal with each such object type.
44 type.
45 44
46 Lcrecords are used for less common sorts of objects that don't 45 Lcrecords are used for less common sorts of objects that don't
47 do their own allocation. Each such object is malloc()ed 46 do their own allocation. Each such object is malloc()ed
48 individually, and the objects are chained together through 47 individually, and the objects are chained together through
49 a `next' pointer. Lcrecords have a `struct lcrecord_header' 48 a `next' pointer. Lcrecords have a `struct lcrecord_header'
91 #ifdef USE_INDEXED_LRECORD_IMPLEMENTATION 90 #ifdef USE_INDEXED_LRECORD_IMPLEMENTATION
92 /* index into lrecord_implementations_table[] */ 91 /* index into lrecord_implementations_table[] */
93 unsigned type:8; 92 unsigned type:8;
94 /* 1 if the object is marked during GC, 0 otherwise. */ 93 /* 1 if the object is marked during GC, 0 otherwise. */
95 unsigned mark:1; 94 unsigned mark:1;
96 /* 1 if the object was resides in pure (read-only) space */ 95 /* 1 if the object resides in pure (read-only) space */
97 unsigned pure:1; 96 unsigned pure:1;
98 #else 97 #else
99 CONST struct lrecord_implementation *implementation; 98 CONST struct lrecord_implementation *implementation;
100 #endif 99 #endif
101 }; 100 };
102 101
103
104 #ifdef USE_INDEXED_LRECORD_IMPLEMENTATION
105 struct lrecord_implementation; 102 struct lrecord_implementation;
106 int lrecord_type_index (CONST struct lrecord_implementation *implementation); 103 int lrecord_type_index (CONST struct lrecord_implementation *implementation);
104
105 #ifdef USE_INDEXED_LRECORD_IMPLEMENTATION
106 # define set_lheader_implementation(header,imp) do \
107 { \
108 (header)->type = lrecord_type_index (imp); \
109 (header)->mark = 0; \
110 (header)->pure = 0; \
111 } while (0)
112 #else
107 # define set_lheader_implementation(header,imp) \ 113 # define set_lheader_implementation(header,imp) \
108 do { (header)->type = lrecord_type_index((imp)); \ 114 ((void) ((header)->implementation = (imp)))
109 (header)->mark = 0; \
110 (header)->pure = 0; \
111 } while (0)
112 #else
113 # define set_lheader_implementation(header,imp) (header)->implementation=(imp)
114 #endif 115 #endif
115 116
116 struct lcrecord_header 117 struct lcrecord_header
117 { 118 {
118 struct lrecord_header lheader; 119 struct lrecord_header lheader;
147 Lisp_Object chain; 148 Lisp_Object chain;
148 }; 149 };
149 150
150 /* This as the value of lheader->implementation->finalizer 151 /* This as the value of lheader->implementation->finalizer
151 * means that this record is already marked */ 152 * means that this record is already marked */
152 extern void this_marks_a_marked_record (void *, int); 153 void this_marks_a_marked_record (void *, int);
153 154
154 /* see alloc.c for an explanation */ 155 /* see alloc.c for an explanation */
155 extern Lisp_Object this_one_is_unmarkable (Lisp_Object obj, 156 Lisp_Object this_one_is_unmarkable (Lisp_Object obj,
156 void (*markobj) (Lisp_Object)); 157 void (*markobj) (Lisp_Object));
157 158
158 struct lrecord_implementation 159 struct lrecord_implementation
159 { 160 {
160 CONST char *name; 161 CONST char *name;
161 /* This function is called at GC time, to make sure that all Lisp_Objects 162 /* This function is called at GC time, to make sure that all Lisp_Objects
192 int (*remprop) (Lisp_Object obj, Lisp_Object prop); 193 int (*remprop) (Lisp_Object obj, Lisp_Object prop);
193 Lisp_Object (*plist) (Lisp_Object obj); 194 Lisp_Object (*plist) (Lisp_Object obj);
194 195
195 /* Only one of these is non-0. If both are 0, it means that this type 196 /* Only one of these is non-0. If both are 0, it means that this type
196 is not instantiable by alloc_lcrecord(). */ 197 is not instantiable by alloc_lcrecord(). */
197 unsigned int static_size; 198 size_t static_size;
198 unsigned int (*size_in_bytes_method) (CONST void *header); 199 size_t (*size_in_bytes_method) (CONST void *header);
199 /* A unique subtag-code (dynamically) assigned to this datatype. */ 200 /* A unique subtag-code (dynamically) assigned to this datatype. */
200 /* (This is a pointer so the rest of this structure can be read-only.) */ 201 /* (This is a pointer so the rest of this structure can be read-only.) */
201 int *lrecord_type_index; 202 int *lrecord_type_index;
202 /* A "basic" lrecord is any lrecord that's not an lcrecord, i.e. 203 /* A "basic" lrecord is any lrecord that's not an lcrecord, i.e.
203 one that does not have an lcrecord_header at the front and which 204 one that does not have an lcrecord_header at the front and which
205 some consistency checking, and that only when error-checking is 206 some consistency checking, and that only when error-checking is
206 enabled. */ 207 enabled. */
207 int basic_p; 208 int basic_p;
208 }; 209 };
209 210
211 #ifdef USE_INDEXED_LRECORD_IMPLEMENTATION
210 extern CONST struct lrecord_implementation *lrecord_implementations_table[]; 212 extern CONST struct lrecord_implementation *lrecord_implementations_table[];
211 213
212 #ifdef USE_INDEXED_LRECORD_IMPLEMENTATION
213 # define XRECORD_LHEADER_IMPLEMENTATION(obj) \ 214 # define XRECORD_LHEADER_IMPLEMENTATION(obj) \
214 (lrecord_implementations_table[XRECORD_LHEADER (obj)->type]) 215 (lrecord_implementations_table[XRECORD_LHEADER (obj)->type])
215 # define LHEADER_IMPLEMENTATION(lh) (lrecord_implementations_table[(lh)->type]) 216 # define LHEADER_IMPLEMENTATION(lh) (lrecord_implementations_table[(lh)->type])
216 #else 217 #else
217 # define XRECORD_LHEADER_IMPLEMENTATION(obj) \ 218 # define XRECORD_LHEADER_IMPLEMENTATION(obj) \
222 extern int gc_in_progress; 223 extern int gc_in_progress;
223 224
224 #ifdef USE_INDEXED_LRECORD_IMPLEMENTATION 225 #ifdef USE_INDEXED_LRECORD_IMPLEMENTATION
225 # define MARKED_RECORD_P(obj) (gc_in_progress && XRECORD_LHEADER (obj)->mark) 226 # define MARKED_RECORD_P(obj) (gc_in_progress && XRECORD_LHEADER (obj)->mark)
226 #else 227 #else
227 # define MARKED_RECORD_P(obj) (gc_in_progress && \ 228 # define MARKED_RECORD_P(obj) (gc_in_progress && \
228 XRECORD_LHEADER (obj)->implementation->finalizer == \ 229 XRECORD_LHEADER (obj)->implementation->finalizer == \
229 this_marks_a_marked_record) 230 this_marks_a_marked_record)
230 #endif 231 #endif
231 232
232 #ifdef USE_INDEXED_LRECORD_IMPLEMENTATION 233 #ifdef USE_INDEXED_LRECORD_IMPLEMENTATION
233 234
270 #else 271 #else
271 # define DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype) 272 # define DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype)
272 #endif 273 #endif
273 274
274 #define DEFINE_BASIC_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,structtype) \ 275 #define DEFINE_BASIC_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,structtype) \
275 DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype) \ 276 DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,0,0,0,0,structtype)
276 static int lrecord_##c_name##_lrecord_type_index; \
277 CONST_IF_NOT_DEBUG struct lrecord_implementation lrecord_##c_name[2] = \
278 { { name, marker, printer, nuker, equal, hash, \
279 0, 0, 0, 0, sizeof (structtype), 0, \
280 &(lrecord_##c_name##_lrecord_type_index), 1 }, \
281 { 0, 0, 0, this_marks_a_marked_record, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1 } }
282 277
283 #define DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,structtype) \ 278 #define DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,structtype) \
284 DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype) \ 279 MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,sizeof(structtype),0,1,structtype)
285 static int lrecord_##c_name##_lrecord_type_index; \
286 CONST_IF_NOT_DEBUG struct lrecord_implementation lrecord_##c_name[2] = \
287 { { name, marker, printer, nuker, equal, hash, \
288 getprop, putprop, remprop, props, sizeof (structtype), 0, \
289 &(lrecord_##c_name##_lrecord_type_index), 1 }, \
290 { 0, 0, 0, this_marks_a_marked_record, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1 } }
291 280
292 #define DEFINE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,structtype) \ 281 #define DEFINE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,structtype) \
293 DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype) \ 282 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,0,0,0,0,structtype)
294 static int lrecord_##c_name##_lrecord_type_index; \
295 CONST_IF_NOT_DEBUG struct lrecord_implementation lrecord_##c_name[2] = \
296 { { name, marker, printer, nuker, equal, hash, \
297 0, 0, 0, 0, sizeof (structtype), 0, \
298 &(lrecord_##c_name##_lrecord_type_index), 0 }, \
299 { 0, 0, 0, this_marks_a_marked_record, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 } }
300 283
301 #define DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,structtype) \ 284 #define DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,structtype) \
302 DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype) \ 285 MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,sizeof (structtype),0,0,structtype)
303 static int lrecord_##c_name##_lrecord_type_index; \
304 CONST_IF_NOT_DEBUG struct lrecord_implementation lrecord_##c_name[2] = \
305 { { name, marker, printer, nuker, equal, hash, \
306 getprop, putprop, remprop, props, sizeof (structtype), 0, \
307 &(lrecord_##c_name##_lrecord_type_index), 0 }, \
308 { 0, 0, 0, this_marks_a_marked_record, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 } }
309 286
310 #define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,sizer,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)
289
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) \
292
293 #define MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,size,sizer,basic_p,structtype) \
311 DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype) \ 294 DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype) \
312 static int lrecord_##c_name##_lrecord_type_index; \ 295 static int lrecord_##c_name##_lrecord_type_index; \
313 CONST_IF_NOT_DEBUG struct lrecord_implementation lrecord_##c_name[2] = \ 296 CONST_IF_NOT_DEBUG struct lrecord_implementation lrecord_##c_name[2] = \
314 { { name, marker, printer, nuker, equal, hash, \ 297 { { name, marker, printer, nuker, equal, hash, \
315 0, 0, 0, 0, 0, sizer, \ 298 getprop, putprop, remprop, props, size, sizer, \
316 &(lrecord_##c_name##_lrecord_type_index), 0 }, \ 299 &(lrecord_##c_name##_lrecord_type_index), basic_p }, \
317 { 0, 0, 0, this_marks_a_marked_record, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 } } 300 { 0, 0, 0, this_marks_a_marked_record, 0, 0, 0, 0, 0, 0, 0, 0, 0, basic_p } }
318
319 #define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,sizer,structtype) \
320 DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype) \
321 static int lrecord_##c_name##_lrecord_type_index; \
322 CONST_IF_NOT_DEBUG struct lrecord_implementation lrecord_##c_name[2] = \
323 { { name, marker, printer, nuker, equal, hash, \
324 getprop, putprop, remprop, props, 0, sizer, \
325 &(lrecord_##c_name##_lrecord_type_index), 0 }, \
326 { 0, 0, 0, this_marks_a_marked_record, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 } }
327 301
328 #define LRECORDP(a) (XTYPE ((a)) == Lisp_Type_Record) 302 #define LRECORDP(a) (XTYPE ((a)) == Lisp_Type_Record)
329 #define XRECORD_LHEADER(a) ((struct lrecord_header *) XPNTR (a)) 303 #define XRECORD_LHEADER(a) ((struct lrecord_header *) XPNTR (a))
330 304
331 #ifdef USE_INDEXED_LRECORD_IMPLEMENTATION 305 #ifdef USE_INDEXED_LRECORD_IMPLEMENTATION
439 #define CHECK_NONRECORD(x, lisp_enum, predicate) do { \ 413 #define CHECK_NONRECORD(x, lisp_enum, predicate) do { \
440 if (XTYPE (x) != lisp_enum) \ 414 if (XTYPE (x) != lisp_enum) \
441 dead_wrong_type_argument (predicate, x); \ 415 dead_wrong_type_argument (predicate, x); \
442 } while (0) 416 } while (0)
443 417
444 void *alloc_lcrecord (int size, CONST struct lrecord_implementation *); 418 void *alloc_lcrecord (size_t size, CONST struct lrecord_implementation *);
445 419
446 #define alloc_lcrecord_type(type, lrecord_implementation) \ 420 #define alloc_lcrecord_type(type, lrecord_implementation) \
447 ((type *) alloc_lcrecord (sizeof (type), lrecord_implementation)) 421 ((type *) alloc_lcrecord (sizeof (type), lrecord_implementation))
448 422
449 int gc_record_type_p (Lisp_Object frob, 423 int gc_record_type_p (Lisp_Object frob,