Mercurial > hg > xemacs-beta

comparison src/lrecord.h @ 400:a86b2b5e0111 r21-2-30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-30
author cvs
date Mon, 13 Aug 2007 11:14:34 +0200
parents 74fd4e045ea6
children 2f8bb876ab1d
comparison
equal deleted inserted replaced
399:376370fb5946 400:a86b2b5e0111
59 59
60 struct lrecord_header 60 struct lrecord_header
61 { 61 {
62 /* index into lrecord_implementations_table[] */ 62 /* index into lrecord_implementations_table[] */
63 unsigned int type :8; 63 unsigned int type :8;
64 /* 1 if the object is marked during GC. */ 64
65 /* If `mark' is 0 after the GC mark phase, the object will be freed
66 during the GC sweep phase. There are 2 ways that `mark' can be 1:
67 - by being referenced from other objects during the GC mark phase
68 - because it is permanently on, for c_readonly objects */
65 unsigned int mark :1; 69 unsigned int mark :1;
66 /* 1 if the object resides in read-only space */ 70
71 /* 1 if the object resides in logically read-only space, and does not
72 reference other non-c_readonly objects.
73 Invariant: if (c_readonly == 1), then (mark == 1 && lisp_readonly == 1) */
67 unsigned int c_readonly :1; 74 unsigned int c_readonly :1;
75
68 /* 1 if the object is readonly from lisp */ 76 /* 1 if the object is readonly from lisp */
69 unsigned int lisp_readonly :1; 77 unsigned int lisp_readonly :1;
70 }; 78 };
71 79
72 struct lrecord_implementation; 80 struct lrecord_implementation;
73 int lrecord_type_index (const struct lrecord_implementation *implementation); 81 int lrecord_type_index (const struct lrecord_implementation *implementation);
74 82
75 #define set_lheader_implementation(header,imp) do { \ 83 #define set_lheader_implementation(header,imp) do { \
76 struct lrecord_header* SLI_header = (header); \ 84 struct lrecord_header* SLI_header = (header); \
77 SLI_header->type = lrecord_type_index (imp); \ 85 SLI_header->type = (imp)->lrecord_type_index; \
78 SLI_header->mark = 0; \ 86 SLI_header->mark = 0; \
79 SLI_header->c_readonly = 0; \ 87 SLI_header->c_readonly = 0; \
80 SLI_header->lisp_readonly = 0; \ 88 SLI_header->lisp_readonly = 0; \
81 } while (0) 89 } while (0)
82 90
116 { 124 {
117 struct lcrecord_header lcheader; 125 struct lcrecord_header lcheader;
118 Lisp_Object chain; 126 Lisp_Object chain;
119 }; 127 };
120 128
121 /* see alloc.c for an explanation */ 129 enum lrecord_type
122 Lisp_Object this_one_is_unmarkable (Lisp_Object obj); 130 {
131 /* Symbol value magic types come first to make SYMBOL_VALUE_MAGIC_P fast.
132 #### This should be replaced by a symbol_value_magic_p flag
133 in the Lisp_Symbol lrecord_header. */
134 lrecord_type_symbol_value_forward,
135 lrecord_type_symbol_value_varalias,
136 lrecord_type_symbol_value_lisp_magic,
137 lrecord_type_symbol_value_buffer_local,
138 lrecord_type_max_symbol_value_magic = lrecord_type_symbol_value_buffer_local,
139
140 lrecord_type_symbol,
141 lrecord_type_subr,
142 lrecord_type_cons,
143 lrecord_type_vector,
144 lrecord_type_string,
145 lrecord_type_lcrecord_list,
146 lrecord_type_compiled_function,
147 lrecord_type_weak_list,
148 lrecord_type_bit_vector,
149 lrecord_type_float,
150 lrecord_type_hash_table,
151 lrecord_type_lstream,
152 lrecord_type_process,
153 lrecord_type_charset,
154 lrecord_type_coding_system,
155 lrecord_type_char_table,
156 lrecord_type_char_table_entry,
157 lrecord_type_range_table,
158 lrecord_type_opaque,
159 lrecord_type_opaque_ptr,
160 lrecord_type_buffer,
161 lrecord_type_extent,
162 lrecord_type_extent_info,
163 lrecord_type_extent_auxiliary,
164 lrecord_type_marker,
165 lrecord_type_event,
166 lrecord_type_keymap,
167 lrecord_type_command_builder,
168 lrecord_type_timeout,
169 lrecord_type_specifier,
170 lrecord_type_console,
171 lrecord_type_device,
172 lrecord_type_frame,
173 lrecord_type_window,
174 lrecord_type_window_configuration,
175 lrecord_type_gui_item,
176 lrecord_type_popup_data,
177 lrecord_type_toolbar_button,
178 lrecord_type_color_instance,
179 lrecord_type_font_instance,
180 lrecord_type_image_instance,
181 lrecord_type_glyph,
182 lrecord_type_face,
183 lrecord_type_database,
184 lrecord_type_tooltalk_message,
185 lrecord_type_tooltalk_pattern,
186 lrecord_type_ldap,
187 lrecord_type_count
188 };
123 189
124 struct lrecord_implementation 190 struct lrecord_implementation
125 { 191 {
126 const char *name; 192 const char *name;
127 193
177 /* Only one of `static_size' and `size_in_bytes_method' is non-0. 243 /* Only one of `static_size' and `size_in_bytes_method' is non-0.
178 If both are 0, this type is not instantiable by alloc_lcrecord(). */ 244 If both are 0, this type is not instantiable by alloc_lcrecord(). */
179 size_t static_size; 245 size_t static_size;
180 size_t (*size_in_bytes_method) (const void *header); 246 size_t (*size_in_bytes_method) (const void *header);
181 247
182 /* A unique subtag-code (dynamically) assigned to this datatype. */ 248 /* The (constant) index into lrecord_implementations_table */
183 /* (This is a pointer so the rest of this structure can be read-only.) */ 249 enum lrecord_type lrecord_type_index;
184 int *lrecord_type_index;
185 250
186 /* A "basic" lrecord is any lrecord that's not an lcrecord, i.e. 251 /* A "basic" lrecord is any lrecord that's not an lcrecord, i.e.
187 one that does not have an lcrecord_header at the front and which 252 one that does not have an lcrecord_header at the front and which
188 is (usually) allocated in frob blocks. We only use this flag for 253 is (usually) allocated in frob blocks. We only use this flag for
189 some consistency checking, and that only when error-checking is 254 some consistency checking, and that only when error-checking is
192 }; 257 };
193 258
194 extern const struct lrecord_implementation *lrecord_implementations_table[]; 259 extern const struct lrecord_implementation *lrecord_implementations_table[];
195 260
196 #define XRECORD_LHEADER_IMPLEMENTATION(obj) \ 261 #define XRECORD_LHEADER_IMPLEMENTATION(obj) \
197 (lrecord_implementations_table[XRECORD_LHEADER (obj)->type]) 262 LHEADER_IMPLEMENTATION (XRECORD_LHEADER (obj))
198 #define LHEADER_IMPLEMENTATION(lh) (lrecord_implementations_table[(lh)->type]) 263 #define LHEADER_IMPLEMENTATION(lh) lrecord_implementations_table[(lh)->type]
199 264
200 extern int gc_in_progress; 265 extern int gc_in_progress;
201 266
202 #define MARKED_RECORD_P(obj) (gc_in_progress && XRECORD_LHEADER (obj)->mark) 267 #define MARKED_RECORD_P(obj) (XRECORD_LHEADER (obj)->mark)
203 #define MARKED_RECORD_HEADER_P(lheader) ((lheader)->mark) 268 #define MARKED_RECORD_HEADER_P(lheader) ((lheader)->mark)
204 #define MARK_RECORD_HEADER(lheader) ((void) ((lheader)->mark = 1)) 269 #define MARK_RECORD_HEADER(lheader) ((void) ((lheader)->mark = 1))
205 #define UNMARK_RECORD_HEADER(lheader) ((void) ((lheader)->mark = 0)) 270 #define UNMARK_RECORD_HEADER(lheader) ((void) ((lheader)->mark = 0))
206 271
207 #define UNMARKABLE_RECORD_HEADER_P(lheader) \
208 (LHEADER_IMPLEMENTATION (lheader)->marker == this_one_is_unmarkable)
209
210 #define C_READONLY_RECORD_HEADER_P(lheader) ((lheader)->c_readonly) 272 #define C_READONLY_RECORD_HEADER_P(lheader) ((lheader)->c_readonly)
211 #define LISP_READONLY_RECORD_HEADER_P(lheader) ((lheader)->lisp_readonly) 273 #define LISP_READONLY_RECORD_HEADER_P(lheader) ((lheader)->lisp_readonly)
212 #define SET_C_READONLY_RECORD_HEADER(lheader) \ 274 #define SET_C_READONLY_RECORD_HEADER(lheader) do { \
213 ((void) ((lheader)->c_readonly = (lheader)->lisp_readonly = 1)) 275 struct lrecord_header *SCRRH_lheader = (lheader); \
276 SCRRH_lheader->c_readonly = 1; \
277 SCRRH_lheader->lisp_readonly = 1; \
278 SCRRH_lheader->mark = 1; \
279 } while (0)
214 #define SET_LISP_READONLY_RECORD_HEADER(lheader) \ 280 #define SET_LISP_READONLY_RECORD_HEADER(lheader) \
215 ((void) ((lheader)->lisp_readonly = 1)) 281 ((void) ((lheader)->lisp_readonly = 1))
282 #define RECORD_MARKER(lheader) lrecord_markers[(lheader)->type]
216 283
217 /* External description stuff 284 /* External description stuff
218 285
219 A lrecord external description is an array of values. The first 286 A lrecord external description is an array of values. The first
220 value of each line is a type, the second the offset in the lrecord 287 value of each line is a type, the second the offset in the lrecord
345 #define XD_DYNARR_DESC(base_type, sub_desc) \ 412 #define XD_DYNARR_DESC(base_type, sub_desc) \
346 { XD_STRUCT_PTR, offsetof (base_type, base), XD_INDIRECT(1, 0), sub_desc }, \ 413 { XD_STRUCT_PTR, offsetof (base_type, base), XD_INDIRECT(1, 0), sub_desc }, \
347 { XD_INT, offsetof (base_type, cur) }, \ 414 { XD_INT, offsetof (base_type, cur) }, \
348 { XD_INT_RESET, offsetof (base_type, max), XD_INDIRECT(1, 0) } 415 { XD_INT_RESET, offsetof (base_type, max), XD_INDIRECT(1, 0) }
349 416
350 /* Declaring the following structures as const puts them in the
351 text (read-only) segment, which makes debugging inconvenient
352 because this segment is not mapped when processing a core-
353 dump file */
354
355 #ifdef DEBUG_XEMACS
356 #define CONST_IF_NOT_DEBUG
357 #else
358 #define CONST_IF_NOT_DEBUG const
359 #endif
360
361 /* DEFINE_LRECORD_IMPLEMENTATION is for objects with constant size. 417 /* DEFINE_LRECORD_IMPLEMENTATION is for objects with constant size.
362 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION is for objects whose size varies. 418 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION is for objects whose size varies.
363 */ 419 */
364 420
365 #if defined (ERROR_CHECK_TYPECHECK) 421 #if defined (ERROR_CHECK_TYPECHECK)
389 #define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizer,structtype) \ 445 #define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizer,structtype) \
390 MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,0,sizer,0,structtype) \ 446 MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,0,sizer,0,structtype) \
391 447
392 #define MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \ 448 #define MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \
393 DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype) \ 449 DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype) \
394 static int lrecord_##c_name##_lrecord_type_index; \ 450 const struct lrecord_implementation lrecord_##c_name = \
395 CONST_IF_NOT_DEBUG struct lrecord_implementation lrecord_##c_name = \
396 { name, marker, printer, nuker, equal, hash, desc, \ 451 { name, marker, printer, nuker, equal, hash, desc, \
397 getprop, putprop, remprop, plist, size, sizer, \ 452 getprop, putprop, remprop, plist, size, sizer, \
398 &(lrecord_##c_name##_lrecord_type_index), basic_p } \ 453 lrecord_type_##c_name, basic_p }
454
455 extern Lisp_Object (*lrecord_markers[]) (Lisp_Object);
456
457 #define INIT_LRECORD_IMPLEMENTATION(type) do { \
458 lrecord_implementations_table[lrecord_type_##type] = &lrecord_##type; \
459 lrecord_markers[lrecord_type_##type] = \
460 lrecord_implementations_table[lrecord_type_##type]->marker; \
461 } while (0)
399 462
400 #define LRECORDP(a) (XTYPE (a) == Lisp_Type_Record) 463 #define LRECORDP(a) (XTYPE (a) == Lisp_Type_Record)
401 #define XRECORD_LHEADER(a) ((struct lrecord_header *) XPNTR (a)) 464 #define XRECORD_LHEADER(a) ((struct lrecord_header *) XPNTR (a))
402 465
403 #define RECORD_TYPEP(x, ty) \ 466 #define RECORD_TYPEP(x, ty) \
404 (LRECORDP (x) && \ 467 (LRECORDP (x) && XRECORD_LHEADER (x)->type == (ty))
405 lrecord_implementations_table[XRECORD_LHEADER (x)->type] == (ty))
406 468
407 /* NOTE: the DECLARE_LRECORD() must come before the associated 469 /* NOTE: the DECLARE_LRECORD() must come before the associated
408 DEFINE_LRECORD_*() or you will get compile errors. 470 DEFINE_LRECORD_*() or you will get compile errors.
409 471
410 Furthermore, you always need to put the DECLARE_LRECORD() in a header 472 Furthermore, you always need to put the DECLARE_LRECORD() in a header
414 under GCC. */ 476 under GCC. */
415 477
416 #ifdef ERROR_CHECK_TYPECHECK 478 #ifdef ERROR_CHECK_TYPECHECK
417 479
418 # define DECLARE_LRECORD(c_name, structtype) \ 480 # define DECLARE_LRECORD(c_name, structtype) \
419 extern CONST_IF_NOT_DEBUG struct lrecord_implementation \ 481 extern const struct lrecord_implementation lrecord_##c_name; \
420 lrecord_##c_name; \
421 INLINE structtype *error_check_##c_name (Lisp_Object obj); \ 482 INLINE structtype *error_check_##c_name (Lisp_Object obj); \
422 INLINE structtype * \ 483 INLINE structtype * \
423 error_check_##c_name (Lisp_Object obj) \ 484 error_check_##c_name (Lisp_Object obj) \
424 { \ 485 { \
425 assert (RECORD_TYPEP (obj, &lrecord_##c_name)); \ 486 assert (RECORD_TYPEP (obj, lrecord_type_##c_name)); \
426 return (structtype *) XPNTR (obj); \ 487 return (structtype *) XPNTR (obj); \
427 } \ 488 } \
428 extern Lisp_Object Q##c_name##p 489 extern Lisp_Object Q##c_name##p
429 490
430 # define DECLARE_NONRECORD(c_name, type_enum, structtype) \ 491 # define DECLARE_NONRECORD(c_name, type_enum, structtype) \
441 # define XNONRECORD(x, c_name, type_enum, structtype) error_check_##c_name (x) 502 # define XNONRECORD(x, c_name, type_enum, structtype) error_check_##c_name (x)
442 503
443 # define XSETRECORD(var, p, c_name) do \ 504 # define XSETRECORD(var, p, c_name) do \
444 { \ 505 { \
445 XSETOBJ (var, Lisp_Type_Record, p); \ 506 XSETOBJ (var, Lisp_Type_Record, p); \
446 assert (RECORD_TYPEP (var, &lrecord_##c_name)); \ 507 assert (RECORD_TYPEP (var, lrecord_type_##c_name)); \
447 } while (0) 508 } while (0)
448 509
449 #else /* not ERROR_CHECK_TYPECHECK */ 510 #else /* not ERROR_CHECK_TYPECHECK */
450 511
451 # define DECLARE_LRECORD(c_name, structtype) \ 512 # define DECLARE_LRECORD(c_name, structtype) \
452 extern Lisp_Object Q##c_name##p; \ 513 extern Lisp_Object Q##c_name##p; \
453 extern CONST_IF_NOT_DEBUG struct lrecord_implementation \ 514 extern const struct lrecord_implementation lrecord_##c_name
454 lrecord_##c_name
455 # define DECLARE_NONRECORD(c_name, type_enum, structtype) \ 515 # define DECLARE_NONRECORD(c_name, type_enum, structtype) \
456 extern Lisp_Object Q##c_name##p 516 extern Lisp_Object Q##c_name##p
457 # define XRECORD(x, c_name, structtype) ((structtype *) XPNTR (x)) 517 # define XRECORD(x, c_name, structtype) ((structtype *) XPNTR (x))
458 # define XNONRECORD(x, c_name, type_enum, structtype) \ 518 # define XNONRECORD(x, c_name, type_enum, structtype) \
459 ((structtype *) XPNTR (x)) 519 ((structtype *) XPNTR (x))
460 # define XSETRECORD(var, p, c_name) XSETOBJ (var, Lisp_Type_Record, p) 520 # define XSETRECORD(var, p, c_name) XSETOBJ (var, Lisp_Type_Record, p)
461 521
462 #endif /* not ERROR_CHECK_TYPECHECK */ 522 #endif /* not ERROR_CHECK_TYPECHECK */
463 523
464 #define RECORDP(x, c_name) RECORD_TYPEP (x, &lrecord_##c_name) 524 #define RECORDP(x, c_name) RECORD_TYPEP (x, lrecord_type_##c_name)
465 525
466 /* Note: we now have two different kinds of type-checking macros. 526 /* Note: we now have two different kinds of type-checking macros.
467 The "old" kind has now been renamed CONCHECK_foo. The reason for 527 The "old" kind has now been renamed CONCHECK_foo. The reason for
468 this is that the CONCHECK_foo macros signal a continuable error, 528 this is that the CONCHECK_foo macros signal a continuable error,
469 allowing the user (through debug-on-error) to substitute a different 529 allowing the user (through debug-on-error) to substitute a different
485 545
486 FSF Emacs does not have this problem because RMS took the cheesy 546 FSF Emacs does not have this problem because RMS took the cheesy
487 way out and disabled returning from a signal entirely. */ 547 way out and disabled returning from a signal entirely. */
488 548
489 #define CONCHECK_RECORD(x, c_name) do { \ 549 #define CONCHECK_RECORD(x, c_name) do { \
490 if (!RECORD_TYPEP (x, &lrecord_##c_name)) \ 550 if (!RECORD_TYPEP (x, lrecord_type_##c_name)) \
491 x = wrong_type_argument (Q##c_name##p, x); \ 551 x = wrong_type_argument (Q##c_name##p, x); \
492 } while (0) 552 } while (0)
493 #define CONCHECK_NONRECORD(x, lisp_enum, predicate) do {\ 553 #define CONCHECK_NONRECORD(x, lisp_enum, predicate) do {\
494 if (XTYPE (x) != lisp_enum) \ 554 if (XTYPE (x) != lisp_enum) \
495 x = wrong_type_argument (predicate, x); \ 555 x = wrong_type_argument (predicate, x); \
496 } while (0) 556 } while (0)
497 #define CHECK_RECORD(x, c_name) do { \ 557 #define CHECK_RECORD(x, c_name) do { \
498 if (!RECORD_TYPEP (x, &lrecord_##c_name)) \ 558 if (!RECORD_TYPEP (x, lrecord_type_##c_name)) \
499 dead_wrong_type_argument (Q##c_name##p, x); \ 559 dead_wrong_type_argument (Q##c_name##p, x); \
500 } while (0) 560 } while (0)
501 #define CHECK_NONRECORD(x, lisp_enum, predicate) do { \ 561 #define CHECK_NONRECORD(x, lisp_enum, predicate) do { \
502 if (XTYPE (x) != lisp_enum) \ 562 if (XTYPE (x) != lisp_enum) \
503 dead_wrong_type_argument (predicate, x); \ 563 dead_wrong_type_argument (predicate, x); \