Mercurial > hg > xemacs-beta

comparison src/lrecord.h @ 5157:1fae11d56ad2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
redo memory-usage mechanism, add way of dynamically initializing Lisp objects -------------------- ChangeLog entries follow: -------------------- lisp/ChangeLog addition: 2010-03-18 Ben Wing <ben@xemacs.org> * diagnose.el (show-memory-usage): Rewrite to take into account API changes in memory-usage functions. src/ChangeLog addition: 2010-03-18 Ben Wing <ben@xemacs.org> * alloc.c: * alloc.c (disksave_object_finalization_1): * alloc.c (lisp_object_storage_size): * alloc.c (listu): * alloc.c (listn): * alloc.c (Fobject_memory_usage_stats): * alloc.c (compute_memusage_stats_length): * alloc.c (Fobject_memory_usage): * alloc.c (Ftotal_object_memory_usage): * alloc.c (malloced_storage_size): * alloc.c (common_init_alloc_early): * alloc.c (reinit_alloc_objects_early): * alloc.c (reinit_alloc_early): * alloc.c (init_alloc_once_early): * alloc.c (syms_of_alloc): * alloc.c (reinit_vars_of_alloc): * buffer.c: * buffer.c (struct buffer_stats): * buffer.c (compute_buffer_text_usage): * buffer.c (compute_buffer_usage): * buffer.c (buffer_memory_usage): * buffer.c (buffer_objects_create): * buffer.c (syms_of_buffer): * buffer.c (vars_of_buffer): * console-impl.h (struct console_methods): * dynarr.c (Dynarr_memory_usage): * emacs.c (main_1): * events.c (clear_event_resource): * extents.c: * extents.c (compute_buffer_extent_usage): * extents.c (extent_objects_create): * extents.h: * faces.c: * faces.c (compute_face_cachel_usage): * faces.c (face_objects_create): * faces.h: * general-slots.h: * glyphs.c: * glyphs.c (compute_glyph_cachel_usage): * glyphs.c (glyph_objects_create): * glyphs.h: * lisp.h: * lisp.h (struct usage_stats): * lrecord.h: * lrecord.h (enum lrecord_type): * lrecord.h (struct lrecord_implementation): * lrecord.h (MC_ALLOC_CALL_FINALIZER_FOR_DISKSAVE): * lrecord.h (DEFINE_DUMPABLE_LISP_OBJECT): * lrecord.h (DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT): * lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT): * lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_SIZABLE_LISP_OBJECT): * lrecord.h (DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT): * lrecord.h (DEFINE_DUMPABLE_SIZABLE_INTERNAL_LISP_OBJECT): * lrecord.h (DEFINE_NODUMP_LISP_OBJECT): * lrecord.h (DEFINE_NODUMP_SIZABLE_LISP_OBJECT): * lrecord.h (DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT): * lrecord.h (DEFINE_NODUMP_FROB_BLOCK_SIZABLE_LISP_OBJECT): * lrecord.h (DEFINE_NODUMP_INTERNAL_LISP_OBJECT): * lrecord.h (DEFINE_NODUMP_SIZABLE_INTERNAL_LISP_OBJECT): * lrecord.h (MAKE_LISP_OBJECT): * lrecord.h (DEFINE_DUMPABLE_MODULE_LISP_OBJECT): * lrecord.h (DEFINE_DUMPABLE_MODULE_SIZABLE_LISP_OBJECT): * lrecord.h (DEFINE_NODUMP_MODULE_LISP_OBJECT): * lrecord.h (DEFINE_NODUMP_MODULE_SIZABLE_LISP_OBJECT): * lrecord.h (MAKE_MODULE_LISP_OBJECT): * lrecord.h (INIT_LISP_OBJECT): * lrecord.h (INIT_MODULE_LISP_OBJECT): * lrecord.h (UNDEF_LISP_OBJECT): * lrecord.h (UNDEF_MODULE_LISP_OBJECT): * lrecord.h (DECLARE_LISP_OBJECT): * lrecord.h (DECLARE_MODULE_API_LISP_OBJECT): * lrecord.h (DECLARE_MODULE_LISP_OBJECT): * lstream.c: * lstream.c (syms_of_lstream): * lstream.c (vars_of_lstream): * marker.c: * marker.c (compute_buffer_marker_usage): * mc-alloc.c (mc_alloced_storage_size): * mc-alloc.h: * mule-charset.c: * mule-charset.c (struct charset_stats): * mule-charset.c (compute_charset_usage): * mule-charset.c (charset_memory_usage): * mule-charset.c (mule_charset_objects_create): * mule-charset.c (syms_of_mule_charset): * mule-charset.c (vars_of_mule_charset): * redisplay.c: * redisplay.c (compute_rune_dynarr_usage): * redisplay.c (compute_display_block_dynarr_usage): * redisplay.c (compute_glyph_block_dynarr_usage): * redisplay.c (compute_display_line_dynarr_usage): * redisplay.c (compute_line_start_cache_dynarr_usage): * redisplay.h: * scrollbar-gtk.c (gtk_compute_scrollbar_instance_usage): * scrollbar-msw.c (mswindows_compute_scrollbar_instance_usage): * scrollbar-x.c (x_compute_scrollbar_instance_usage): * scrollbar.c (compute_scrollbar_instance_usage): * scrollbar.h: * symbols.c: * symbols.c (reinit_symbol_objects_early): * symbols.c (init_symbols_once_early): * symbols.c (reinit_symbols_early): * symbols.c (defsymbol_massage_name_1): * symsinit.h: * ui-gtk.c: * ui-gtk.c (emacs_gtk_object_getprop): * ui-gtk.c (emacs_gtk_object_putprop): * ui-gtk.c (ui_gtk_objects_create): * unicode.c (compute_from_unicode_table_size_1): * unicode.c (compute_to_unicode_table_size_1): * unicode.c (compute_from_unicode_table_size): * unicode.c (compute_to_unicode_table_size): * window.c: * window.c (struct window_stats): * window.c (compute_window_mirror_usage): * window.c (compute_window_usage): * window.c (window_memory_usage): * window.c (window_objects_create): * window.c (syms_of_window): * window.c (vars_of_window): * window.h: Redo memory-usage mechanism, make it general; add way of dynamically initializing Lisp object types -- OBJECT_HAS_METHOD(), similar to CONSOLE_HAS_METHOD(). (1) Create OBJECT_HAS_METHOD(), OBJECT_HAS_PROPERTY() etc. for specifying that a Lisp object type has a particular method or property. Call such methods with OBJECT_METH, MAYBE_OBJECT_METH, OBJECT_METH_OR_GIVEN; retrieve properties with OBJECT_PROPERTY. Methods that formerly required a DEFINE_*GENERAL_LISP_OBJECT() to specify them (getprop, putprop, remprop, plist, disksave) now instead use the dynamic-method mechanism. The main benefit of this is that new methods or properties can be added without requiring that the declaration statements of all existing methods be modified. We have to make the `struct lrecord_implementation' non-const, but I don't think this should have any effect on speed -- the only possible method that's really speed-critical is the mark method, and we already extract those out into a separate (non-const) array for increased cache locality. Object methods need to be reinitialized after pdump, so we put them in separate functions such as face_objects_create(), extent_objects_create() and call them appropriately from emacs.c The only current object property (`memusage_stats_list') that objects can specify is a Lisp object and gets staticpro()ed so it only needs to be set during dump time, but because it references symbols that might not exist in a syms_of_() function, we initialize it in vars_of_(). There is also an object property (`num_extra_memusage_stats') that is automatically initialized based on `memusage_stats_list'; we do that in reinit_vars_of_alloc(), which is called after all vars_of_() functions are called. `disksaver' method was renamed `disksave' to correspond with the name normally given to the function (e.g. disksave_lstream()). (2) Generalize the memory-usage mechanism in `buffer-memory-usage', `window-memory-usage', `charset-memory-usage' into an object-type- specific mechanism called by a single function `object-memory-usage'. (Former function `object-memory-usage' renamed to `total-object-memory-usage'). Generalize the mechanism of different "slices" so that we can have different "classes" of memory described and different "slices" onto each class; `t' separates classes, `nil' separates slices. Currently we have three classes defined: the memory of an object itself, non-Lisp-object memory associated with the object (e.g. arrays or dynarrs stored as fields in the object), and Lisp-object memory associated with the object (other internal Lisp objects stored in the object). This isn't completely finished yet and we might need to further separate the "other internal Lisp objects" class into two classes. The memory-usage mechanism uses a `struct usage_stats' (renamed from `struct overhead_stats') to describe a malloc-view onto a set of allocated memory (listing how much was requested and various types of overhead) and a more general `struct generic_usage_stats' (with a `struct usage_stats' in it) to hold all statistics about object memory. `struct generic_usage_stats' contains an array of 32 Bytecounts, which are statistics of unspecified semantics. The intention is that individual types declare a corresponding struct (e.g. `struct window_stats') with the same structure but with specific fields in place of the array, corresponding to specific statistics. The number of such statistics is an object property computed from the list of tags (Lisp symbols describing the statistics) stored in `memusage_stats_list'. The idea here is to allow particular object types to customize the number and semantics of the statistics where completely avoiding consing. This doesn't matter so much yet, but the intention is to have the memory usage of all objects computed at the end of GC, at the same time as other statistics are currently computed. The values for all statistics for a single type would be added up to compute aggregate values for all objects of a specific type. To make this efficient, we can't allow any memory allocation at all. (3) Create some additional functions for creating lists that specify the elements directly as args rather than indirectly through an array: listn() (number of args given), listu() (list terminated by Qunbound). (4) Delete a bit of remaining unused C window_config stuff, also unused lrecord_type_popup_data.
author Ben Wing <ben@xemacs.org>
date Thu, 18 Mar 2010 10:50:06 -0500
parents 88bd4f3ef8e4
children 9e0b43d3095c
comparison
equal deleted inserted replaced
5156:6bff4f219697 5157:1fae11d56ad2
362 lrecord_type_console, 362 lrecord_type_console,
363 lrecord_type_device, 363 lrecord_type_device,
364 lrecord_type_frame, 364 lrecord_type_frame,
365 lrecord_type_window, 365 lrecord_type_window,
366 lrecord_type_window_mirror, 366 lrecord_type_window_mirror,
367 lrecord_type_window_configuration,
368 lrecord_type_gui_item, 367 lrecord_type_gui_item,
369 lrecord_type_popup_data,
370 lrecord_type_toolbar_button, 368 lrecord_type_toolbar_button,
371 lrecord_type_scrollbar_instance, 369 lrecord_type_scrollbar_instance,
372 lrecord_type_color_instance, 370 lrecord_type_color_instance,
373 lrecord_type_font_instance, 371 lrecord_type_font_instance,
374 lrecord_type_image_instance, 372 lrecord_type_image_instance,
488 Hashcode (*hash) (Lisp_Object, int); 486 Hashcode (*hash) (Lisp_Object, int);
489 487
490 /* Data layout description for your object. See long comment below. */ 488 /* Data layout description for your object. See long comment below. */
491 const struct memory_description *description; 489 const struct memory_description *description;
492 490
491 /* Only one of `static_size' and `size_in_bytes_method' is non-0. If
492 `static_size' is 0, this type is not instantiable by
493 ALLOC_NORMAL_LISP_OBJECT(). If both are 0 (this should never happen),
494 this object cannot be instantiated; you will get an abort() if you
495 try.*/
496 Bytecount static_size;
497 Bytecount (*size_in_bytes_method) (Lisp_Object);
498
499 /* The (constant) index into lrecord_implementations_table */
500 enum lrecord_type lrecord_type_index;
501
502 #ifndef NEW_GC
503 /* A "frob-block" lrecord is any lrecord that's not an lcrecord, i.e.
504 one that does not have an old_lcrecord_header at the front and which
505 is (usually) allocated in frob blocks. */
506 unsigned int frob_block_p :1;
507 #endif /* not NEW_GC */
508
509 /**********************************************************************/
510 /* Remaining stuff is not assignable statically using
511 DEFINE_*_LISP_OBJECT, but must be assigned with OBJECT_HAS_METHOD
512 or the like. */
513
493 /* These functions allow any object type to have builtin property 514 /* These functions allow any object type to have builtin property
494 lists that can be manipulated from the lisp level with 515 lists that can be manipulated from the lisp level with
495 `get', `put', `remprop', and `object-plist'. */ 516 `get', `put', `remprop', and `object-plist'. */
496 Lisp_Object (*getprop) (Lisp_Object obj, Lisp_Object prop); 517 Lisp_Object (*getprop) (Lisp_Object obj, Lisp_Object prop);
497 int (*putprop) (Lisp_Object obj, Lisp_Object prop, Lisp_Object val); 518 int (*putprop) (Lisp_Object obj, Lisp_Object prop, Lisp_Object val);
498 int (*remprop) (Lisp_Object obj, Lisp_Object prop); 519 int (*remprop) (Lisp_Object obj, Lisp_Object prop);
499 Lisp_Object (*plist) (Lisp_Object obj); 520 Lisp_Object (*plist) (Lisp_Object obj);
500 521
501 /* `disksaver' is called at dump time. It is used for objects that 522 /* `disksave' is called at dump time. It is used for objects that
502 contain pointers or handles to objects created in external libraries, 523 contain pointers or handles to objects created in external libraries,
503 such as window-system windows or file handles. Such external objects 524 such as window-system windows or file handles. Such external objects
504 cannot be dumped, so it is necessary to release them at dump time and 525 cannot be dumped, so it is necessary to release them at dump time and
505 arrange somehow or other for them to be resurrected if necessary later 526 arrange somehow or other for them to be resurrected if necessary later
506 on. 527 on.
507 528
508 It seems that even non-dumpable objects may be around at dump time, 529 It seems that even non-dumpable objects may be around at dump time,
509 and a disksaver may be provided. (In fact, the only object currently 530 and a disksave may be provided. (In fact, the only object currently
510 with a disksaver, lstream, is non-dumpable.) 531 with a disksave, lstream, is non-dumpable.)
511 532
512 Objects rarely need to provide this method; most of the time it will 533 Objects rarely need to provide this method; most of the time it will
513 be NULL. */ 534 be NULL. */
514 void (*disksaver) (Lisp_Object); 535 void (*disksave) (Lisp_Object);
515 536
516 /* Only one of `static_size' and `size_in_bytes_method' is non-0. If 537 #ifdef MEMORY_USAGE_STATS
517 `static_size' is 0, this type is not instantiable by 538 /* Return memory-usage information about the object in question, stored
518 ALLOC_NORMAL_LISP_OBJECT(). If both are 0 (this should never happen), 539 into STATS. */
519 this object cannot be instantiated; you will get an abort() if you 540 void (*memory_usage) (Lisp_Object obj, struct generic_usage_stats *stats);
520 try.*/ 541
521 Bytecount static_size; 542 /* Number of additional type-specific statistics related to memory usage.
522 Bytecount (*size_in_bytes_method) (Lisp_Object); 543 Automatically calculated (see compute_memusage_stats_length()) based
523 544 on the value placed in `memusage_stats_list'. */
524 /* The (constant) index into lrecord_implementations_table */ 545 Elemcount num_extra_memusage_stats;
525 enum lrecord_type lrecord_type_index; 546
526 547 /* List of tags to be given to the extra statistics, one per statistic.
527 #ifndef NEW_GC 548 Qnil or Qt can be present to separate off different slices. Qnil
528 /* A "frob-block" lrecord is any lrecord that's not an lcrecord, i.e. 549 separates different slices within the same type of statistics.
529 one that does not have an old_lcrecord_header at the front and which 550 Qt separates slices corresponding to different types of statistics.
530 is (usually) allocated in frob blocks. */ 551 If Qt is not present, all slices describe extra non-Lisp-Object memory
531 unsigned int frob_block_p :1; 552 associated with a Lisp object. If Qt is present, slices after Qt
532 #endif /* not NEW_GC */ 553 describe non-Lisp-Object memory and slices before Qt describe
554 Lisp-Object memory logically associated with the object. For example,
555 if the object is a table, then Lisp-Object memory might be the entries
556 in the table. This info is only advisory since it will duplicate
557 memory described elsewhere and since it may not be possible to be
558 completely accurate if the same object occurs multiple times in the
559 table. */
560 Lisp_Object memusage_stats_list;
561 #endif /* MEMORY_USAGE_STATS */
533 }; 562 };
534 563
535 /* All the built-in lisp object types are enumerated in `enum lrecord_type'. 564 /* All the built-in lisp object types are enumerated in `enum lrecord_type'.
536 Additional ones may be defined by a module (none yet). We leave some 565 Additional ones may be defined by a module (none yet). We leave some
537 room in `lrecord_implementations_table' for such new lisp object types. */ 566 room in `lrecord_implementations_table' for such new lisp object types. */
538 #define MODULE_DEFINABLE_TYPE_COUNT 32 567 #define MODULE_DEFINABLE_TYPE_COUNT 32
539 568
540 extern MODULE_API const struct lrecord_implementation * 569 extern MODULE_API struct lrecord_implementation *
541 lrecord_implementations_table[lrecord_type_last_built_in_type + MODULE_DEFINABLE_TYPE_COUNT]; 570 lrecord_implementations_table[lrecord_type_last_built_in_type + MODULE_DEFINABLE_TYPE_COUNT];
542 571
543 /* Given a Lisp object, return its implementation 572 /* Given a Lisp object, return its implementation
544 (struct lrecord_implementation) */ 573 (struct lrecord_implementation) */
545 #define XRECORD_LHEADER_IMPLEMENTATION(obj) \ 574 #define XRECORD_LHEADER_IMPLEMENTATION(obj) \
591 if (XRECORD_LHEADER (MCACF_obj) && LRECORDP (MCACF_obj) \ 620 if (XRECORD_LHEADER (MCACF_obj) && LRECORDP (MCACF_obj) \
592 && !LRECORD_FREE_P (MCACF_lheader) ) \ 621 && !LRECORD_FREE_P (MCACF_lheader) ) \
593 { \ 622 { \
594 const struct lrecord_implementation *MCACF_implementation \ 623 const struct lrecord_implementation *MCACF_implementation \
595 = LHEADER_IMPLEMENTATION (MCACF_lheader); \ 624 = LHEADER_IMPLEMENTATION (MCACF_lheader); \
596 if (MCACF_implementation && MCACF_implementation->disksaver) \ 625 if (MCACF_implementation && MCACF_implementation->disksave) \
597 MCACF_implementation->disksaver (MCACF_obj); \ 626 MCACF_implementation->disksave (MCACF_obj); \
598 } \ 627 } \
599 } while (0) 628 } while (0)
600 629
601 #define LRECORD_FREE_P(ptr) \ 630 #define LRECORD_FREE_P(ptr) \
602 (((struct lrecord_header *) ptr)->free) 631 (((struct lrecord_header *) ptr)->free)
1269 object is internal and shouldn't be visible externally). For internal 1298 object is internal and shouldn't be visible externally). For internal
1270 objects needing a finalizer, equal or hash method, or wanting to 1299 objects needing a finalizer, equal or hash method, or wanting to
1271 customize the print method, use the normal DEFINE_*_LISP_OBJECT 1300 customize the print method, use the normal DEFINE_*_LISP_OBJECT
1272 mechanism for defining these objects. 1301 mechanism for defining these objects.
1273 1302
1274 DEFINE_*_GENERAL_LISP_OBJECT is for objects that need to provide one of
1275 the less common methods that are omitted on most objects. These methods
1276 include the methods supporting the unified property interface using
1277 `get', `put', `remprop' and `object-plist', and (for dumpable objects
1278 only) the `disksaver' method.
1279
1280 DEFINE_MODULE_* is for objects defined in an external module. 1303 DEFINE_MODULE_* is for objects defined in an external module.
1281 1304
1282 MAKE_LISP_OBJECT and MAKE_MODULE_LISP_OBJECT are what underlies all of 1305 MAKE_LISP_OBJECT and MAKE_MODULE_LISP_OBJECT are what underlies all of
1283 these; they define a structure containing pointers to object methods 1306 these; they define a structure containing pointers to object methods
1284 and other info such as the size of the structure containing the object. 1307 and other info such as the size of the structure containing the object.
1292 #endif 1315 #endif
1293 1316
1294 /********* The dumpable versions *********** */ 1317 /********* The dumpable versions *********** */
1295 1318
1296 #define DEFINE_DUMPABLE_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \ 1319 #define DEFINE_DUMPABLE_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \
1297 DEFINE_DUMPABLE_GENERAL_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,structtype) 1320 MAKE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,sizeof (structtype),0,0,structtype)
1298
1299 #define DEFINE_DUMPABLE_GENERAL_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,structtype) \
1300 MAKE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,sizeof (structtype),0,0,structtype)
1301 1321
1302 #define DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \ 1322 #define DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \
1303 DEFINE_DUMPABLE_SIZABLE_GENERAL_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,sizer,structtype) 1323 MAKE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,0,sizer,0,structtype)
1304
1305 #define DEFINE_DUMPABLE_SIZABLE_GENERAL_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,sizer,structtype) \
1306 MAKE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,0,sizer,0,structtype)
1307 1324
1308 #define DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \ 1325 #define DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \
1309 DEFINE_DUMPABLE_FROB_BLOCK_GENERAL_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,structtype) 1326 MAKE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,sizeof(structtype),0,1,structtype)
1310
1311 #define DEFINE_DUMPABLE_FROB_BLOCK_GENERAL_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,structtype) \
1312 MAKE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,sizeof(structtype),0,1,structtype)
1313 1327
1314 #define DEFINE_DUMPABLE_FROB_BLOCK_SIZABLE_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \ 1328 #define DEFINE_DUMPABLE_FROB_BLOCK_SIZABLE_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \
1315 MAKE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,0,sizer,1,structtype) 1329 MAKE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,0,sizer,1,structtype)
1316 1330
1317 #define DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT(name,c_name,marker,desc,structtype) \ 1331 #define DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT(name,c_name,marker,desc,structtype) \
1318 DEFINE_DUMPABLE_GENERAL_LISP_OBJECT(name,c_name,marker,internal_object_printer,0,0,0,desc,0,0,0,0,0,structtype) 1332 DEFINE_DUMPABLE_LISP_OBJECT(name,c_name,marker,internal_object_printer,0,0,0,desc,structtype)
1319 1333
1320 #define DEFINE_DUMPABLE_SIZABLE_INTERNAL_LISP_OBJECT(name,c_name,marker,desc,sizer,structtype) \ 1334 #define DEFINE_DUMPABLE_SIZABLE_INTERNAL_LISP_OBJECT(name,c_name,marker,desc,sizer,structtype) \
1321 DEFINE_DUMPABLE_SIZABLE_GENERAL_LISP_OBJECT(name,c_name,marker,internal_object_printer,0,0,0,desc,0,0,0,0,0,sizer,structtype) 1335 DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT(name,c_name,marker,internal_object_printer,0,0,0,desc,sizer,structtype)
1322 1336
1323 /********* The non-dumpable versions *********** */ 1337 /********* The non-dumpable versions *********** */
1324 1338
1325 #define DEFINE_NODUMP_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \ 1339 #define DEFINE_NODUMP_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \
1326 DEFINE_NODUMP_GENERAL_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,structtype) 1340 MAKE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer,nuker,equal,hash,desc,sizeof (structtype),0,0,structtype)
1327
1328 #define DEFINE_NODUMP_GENERAL_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,structtype) \
1329 MAKE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,sizeof (structtype),0,0,structtype)
1330 1341
1331 #define DEFINE_NODUMP_SIZABLE_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \ 1342 #define DEFINE_NODUMP_SIZABLE_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \
1332 DEFINE_NODUMP_SIZABLE_GENERAL_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,sizer,structtype) 1343 MAKE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer,nuker,equal,hash,desc,0,sizer,0,structtype)
1333
1334 #define DEFINE_NODUMP_SIZABLE_GENERAL_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,sizer,structtype) \
1335 MAKE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,0,sizer,0,structtype)
1336 1344
1337 #define DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \ 1345 #define DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \
1338 DEFINE_NODUMP_FROB_BLOCK_GENERAL_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,structtype) 1346 MAKE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer,nuker,equal,hash,desc,sizeof(structtype),0,1,structtype)
1339
1340 #define DEFINE_NODUMP_FROB_BLOCK_GENERAL_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,structtype) \
1341 MAKE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,sizeof(structtype),0,1,structtype)
1342 1347
1343 #define DEFINE_NODUMP_FROB_BLOCK_SIZABLE_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \ 1348 #define DEFINE_NODUMP_FROB_BLOCK_SIZABLE_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \
1344 MAKE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,0,sizer,1,structtype) 1349 MAKE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer,nuker,equal,hash,desc,0,sizer,1,structtype)
1345 1350
1346 #define DEFINE_NODUMP_INTERNAL_LISP_OBJECT(name,c_name,marker,desc,structtype) \ 1351 #define DEFINE_NODUMP_INTERNAL_LISP_OBJECT(name,c_name,marker,desc,structtype) \
1347 DEFINE_NODUMP_GENERAL_LISP_OBJECT(name,c_name,marker,internal_object_printer,0,0,0,desc,0,0,0,0,0,structtype) 1352 DEFINE_NODUMP_LISP_OBJECT(name,c_name,marker,internal_object_printer,0,0,0,desc,structtype)
1348 1353
1349 #define DEFINE_NODUMP_SIZABLE_INTERNAL_LISP_OBJECT(name,c_name,marker,desc,sizer,structtype) \ 1354 #define DEFINE_NODUMP_SIZABLE_INTERNAL_LISP_OBJECT(name,c_name,marker,desc,sizer,structtype) \
1350 DEFINE_NODUMP_SIZABLE_GENERAL_LISP_OBJECT(name,c_name,marker,internal_object_printer,0,0,0,desc,0,0,0,0,0,sizer,structtype) 1355 DEFINE_NODUMP_SIZABLE_LISP_OBJECT(name,c_name,marker,internal_object_printer,0,0,0,desc,sizer,structtype)
1351 1356
1352 /********* MAKE_LISP_OBJECT, the underlying macro *********** */ 1357 /********* MAKE_LISP_OBJECT, the underlying macro *********** */
1353 1358
1354 #ifdef NEW_GC 1359 #ifdef NEW_GC
1355 #define MAKE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,size,sizer,frob_block_p,structtype) \ 1360 #define MAKE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker, \
1361 equal,hash,desc,size,sizer,frob_block_p,structtype) \
1356 DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \ 1362 DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \
1357 const struct lrecord_implementation lrecord_##c_name = \ 1363 struct lrecord_implementation lrecord_##c_name = \
1358 { name, dumpable, marker, printer, nuker, equal, hash, desc, \ 1364 { name, dumpable, marker, printer, nuker, equal, hash, desc, \
1359 getprop, putprop, remprop, plist, disksaver, size, sizer, \ 1365 size, sizer, lrecord_type_##c_name }
1360 lrecord_type_##c_name }
1361 #else /* not NEW_GC */ 1366 #else /* not NEW_GC */
1362 #define MAKE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,size,sizer,frob_block_p,structtype) \ 1367 #define MAKE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,size,sizer,frob_block_p,structtype) \
1363 DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \ 1368 DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \
1364 const struct lrecord_implementation lrecord_##c_name = \ 1369 struct lrecord_implementation lrecord_##c_name = \
1365 { name, dumpable, marker, printer, nuker, equal, hash, desc, \ 1370 { name, dumpable, marker, printer, nuker, equal, hash, desc, \
1366 getprop, putprop, remprop, plist, disksaver, size, sizer, \ 1371 size, sizer, lrecord_type_##c_name, frob_block_p }
1367 lrecord_type_##c_name, frob_block_p }
1368 #endif /* not NEW_GC */ 1372 #endif /* not NEW_GC */
1369 1373
1370 1374
1371 /********* The module dumpable versions *********** */ 1375 /********* The module dumpable versions *********** */
1372 1376
1373 #define DEFINE_DUMPABLE_MODULE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,structtype) \ 1377 #define DEFINE_DUMPABLE_MODULE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,structtype) \
1374 DEFINE_DUMPABLE_MODULE_GENERAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,structtype) 1378 MAKE_MODULE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,sizeof (structtype),0,0,structtype)
1375
1376 #define DEFINE_DUMPABLE_MODULE_GENERAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,structtype) \
1377 MAKE_MODULE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,sizeof (structtype),0,0,structtype)
1378 1379
1379 #define DEFINE_DUMPABLE_MODULE_SIZABLE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,sizer,structtype) \ 1380 #define DEFINE_DUMPABLE_MODULE_SIZABLE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,sizer,structtype) \
1380 DEFINE_DUMPABLE_MODULE_SIZABLE_GENERAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,sizer,structtype) 1381 MAKE_MODULE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,0,sizer,0,structtype)
1381
1382 #define DEFINE_DUMPABLE_MODULE_SIZABLE_GENERAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,sizer,structtype) \
1383 MAKE_MODULE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,0,sizer,0,structtype)
1384 1382
1385 /********* The module non-dumpable versions *********** */ 1383 /********* The module non-dumpable versions *********** */
1386 1384
1387 #define DEFINE_NODUMP_MODULE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,structtype) \ 1385 #define DEFINE_NODUMP_MODULE_LISP_OBJECT(name,c_name,dumpable,marker, \
1388 DEFINE_NODUMP_MODULE_GENERAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,structtype) 1386 printer,nuker,equal,hash,desc,structtype) \
1389 1387 MAKE_MODULE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer, \
1390 #define DEFINE_NODUMP_MODULE_GENERAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,structtype) \ 1388 nuker,equal,hash,desc,sizeof (structtype),0,0,structtype)
1391 MAKE_MODULE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,sizeof (structtype),0,0,structtype) 1389
1392 1390 #define DEFINE_NODUMP_MODULE_SIZABLE_LISP_OBJECT(name,c_name,dumpable, \
1393 #define DEFINE_NODUMP_MODULE_SIZABLE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,sizer,structtype) \ 1391 marker,printer,nuker,equal,hash,desc,sizer,structtype) \
1394 DEFINE_NODUMP_MODULE_SIZABLE_GENERAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,sizer,structtype) 1392 MAKE_MODULE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer, \
1395 1393 nuker,equal,hash,desc,0,sizer,0,structtype)
1396 #define DEFINE_NODUMP_MODULE_SIZABLE_GENERAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,sizer,structtype) \
1397 MAKE_MODULE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,0,sizer,0,structtype)
1398 1394
1399 /********* MAKE_MODULE_LISP_OBJECT, the underlying macro *********** */ 1395 /********* MAKE_MODULE_LISP_OBJECT, the underlying macro *********** */
1400 1396
1401 #ifdef NEW_GC 1397 #ifdef NEW_GC
1402 #define MAKE_MODULE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,size,sizer,frob_block_p,structtype) \ 1398 #define MAKE_MODULE_LISP_OBJECT(name,c_name,dumpable,marker,printer, \
1399 nuker,equal,hash,desc,size,sizer,frob_block_p,structtype) \
1403 DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \ 1400 DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \
1404 int lrecord_type_##c_name; \ 1401 int lrecord_type_##c_name; \
1405 struct lrecord_implementation lrecord_##c_name = \ 1402 struct lrecord_implementation lrecord_##c_name = \
1406 { name, dumpable, marker, printer, nuker, equal, hash, desc, \ 1403 { name, dumpable, marker, printer, nuker, equal, hash, desc, \
1407 getprop, putprop, remprop, plist, disksaver, size, sizer, \ 1404 size, sizer, lrecord_type_last_built_in_type }
1408 lrecord_type_last_built_in_type }
1409 #else /* not NEW_GC */ 1405 #else /* not NEW_GC */
1410 #define MAKE_MODULE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,size,sizer,frob_block_p,structtype) \ 1406 #define MAKE_MODULE_LISP_OBJECT(name,c_name,dumpable,marker,printer, \
1407 nuker,equal,hash,desc,size,sizer,frob_block_p,structtype) \
1411 DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \ 1408 DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \
1412 int lrecord_type_##c_name; \ 1409 int lrecord_type_##c_name; \
1413 struct lrecord_implementation lrecord_##c_name = \ 1410 struct lrecord_implementation lrecord_##c_name = \
1414 { name, dumpable, marker, printer, nuker, equal, hash, desc, \ 1411 { name, dumpable, marker, printer, nuker, equal, hash, desc, \
1415 getprop, putprop, remprop, plist, disksaver, size, sizer, \ 1412 size, sizer, lrecord_type_last_built_in_type, frob_block_p }
1416 lrecord_type_last_built_in_type, frob_block_p }
1417 #endif /* not NEW_GC */ 1413 #endif /* not NEW_GC */
1414
1415 #ifdef MEMORY_USAGE_STATS
1416 #define INIT_MEMORY_USAGE_STATS(type) \
1417 do \
1418 { \
1419 lrecord_implementations_table[lrecord_type_##type]-> \
1420 memusage_stats_list = Qnil; \
1421 lrecord_implementations_table[lrecord_type_##type]-> \
1422 num_extra_memusage_stats = -1; \
1423 staticpro (&lrecord_implementations_table[lrecord_type_##type]-> \
1424 memusage_stats_list); \
1425 } while (0)
1426 #else
1427 #define INIT_MEMORY_USAGE_STATS(type) DO_NOTHING
1428 #endif /* (not) MEMORY_USAGE_STATS */
1429
1430 #define INIT_LISP_OBJECT_BEGINNING(type) \
1431 do \
1432 { \
1433 lrecord_implementations_table[lrecord_type_##type] = &lrecord_##type; \
1434 INIT_MEMORY_USAGE_STATS (type); \
1435 } while (0)
1418 1436
1419 #ifdef USE_KKCC 1437 #ifdef USE_KKCC
1420 extern MODULE_API const struct memory_description *lrecord_memory_descriptions[]; 1438 extern MODULE_API const struct memory_description *lrecord_memory_descriptions[];
1421 1439
1422 #define INIT_LISP_OBJECT(type) do { \ 1440 #define INIT_LISP_OBJECT(type) do { \
1423 lrecord_implementations_table[lrecord_type_##type] = &lrecord_##type; \ 1441 INIT_LISP_OBJECT_BEGINNING (type); \
1424 lrecord_memory_descriptions[lrecord_type_##type] = \ 1442 lrecord_memory_descriptions[lrecord_type_##type] = \
1425 lrecord_implementations_table[lrecord_type_##type]->description; \ 1443 lrecord_implementations_table[lrecord_type_##type]->description; \
1426 } while (0) 1444 } while (0)
1427 #else /* not USE_KKCC */ 1445 #else /* not USE_KKCC */
1428 extern MODULE_API Lisp_Object (*lrecord_markers[]) (Lisp_Object); 1446 extern MODULE_API Lisp_Object (*lrecord_markers[]) (Lisp_Object);
1429 1447
1430 #define INIT_LISP_OBJECT(type) do { \ 1448 #define INIT_LISP_OBJECT(type) do { \
1431 lrecord_implementations_table[lrecord_type_##type] = &lrecord_##type; \ 1449 INIT_LISP_OBJECT_BEGINNING (type); \
1432 lrecord_markers[lrecord_type_##type] = \ 1450 lrecord_markers[lrecord_type_##type] = \
1433 lrecord_implementations_table[lrecord_type_##type]->marker; \ 1451 lrecord_implementations_table[lrecord_type_##type]->marker; \
1434 } while (0) 1452 } while (0)
1435 #endif /* not USE_KKCC */ 1453 #endif /* not USE_KKCC */
1436 1454
1437 #define INIT_MODULE_LISP_OBJECT(type) do { \ 1455 #define INIT_MODULE_LISP_OBJECT(type) do { \
1438 lrecord_type_##type = lrecord_type_count++; \ 1456 lrecord_type_##type = lrecord_type_count++; \
1439 lrecord_##type.lrecord_type_index = lrecord_type_##type; \ 1457 lrecord_##type.lrecord_type_index = lrecord_type_##type; \
1440 INIT_LISP_OBJECT(type); \ 1458 INIT_LISP_OBJECT (type); \
1441 } while (0) 1459 } while (0)
1442 1460
1443 #ifdef HAVE_SHLIB 1461 #ifdef HAVE_SHLIB
1444 /* Allow undefining types in order to support module unloading. */ 1462 /* Allow undefining types in order to support module unloading. */
1445 1463
1446 #ifdef USE_KKCC 1464 #ifdef USE_KKCC
1447 #define UNDEF_LISP_OBJECT(type) do { \ 1465 #define UNDEF_LISP_OBJECT(type) do { \
1448 lrecord_implementations_table[lrecord_type_##type] = NULL; \ 1466 lrecord_implementations_table[lrecord_type_##type] = NULL; \
1449 lrecord_memory_descriptions[lrecord_type_##type] = NULL; \ 1467 lrecord_memory_descriptions[lrecord_type_##type] = NULL; \
1450 } while (0) 1468 } while (0)
1451 #else /* not USE_KKCC */ 1469 #else /* not USE_KKCC */
1452 #define UNDEF_LISP_OBJECT(type) do { \ 1470 #define UNDEF_LISP_OBJECT(type) do { \
1453 lrecord_implementations_table[lrecord_type_##type] = NULL; \ 1471 lrecord_implementations_table[lrecord_type_##type] = NULL; \
1454 lrecord_markers[lrecord_type_##type] = NULL; \ 1472 lrecord_markers[lrecord_type_##type] = NULL; \
1455 } while (0) 1473 } while (0)
1456 #endif /* not USE_KKCC */ 1474 #endif /* not USE_KKCC */
1457 1475
1458 #define UNDEF_MODULE_LISP_OBJECT(type) do { \ 1476 #define UNDEF_MODULE_LISP_OBJECT(type) do { \
1459 if (lrecord_##type.lrecord_type_index == lrecord_type_count - 1) { \ 1477 if (lrecord_##type.lrecord_type_index == lrecord_type_count - 1) { \
1460 /* This is the most recently defined type. Clean up nicely. */ \ 1478 /* This is the most recently defined type. Clean up nicely. */ \
1461 lrecord_type_##type = lrecord_type_count--; \ 1479 lrecord_type_##type = lrecord_type_count--; \
1462 } /* Else we can't help leaving a hole with this implementation. */ \ 1480 } /* Else we can't help leaving a hole with this implementation. */ \
1463 UNDEF_LISP_OBJECT(type); \ 1481 UNDEF_LISP_OBJECT(type); \
1464 } while (0) 1482 } while (0)
1465 1483
1466 #endif /* HAVE_SHLIB */ 1484 #endif /* HAVE_SHLIB */
1485
1486 /*************** Macros for declaring that a Lisp object has a
1487 particular method, or for calling such a method. ********/
1488
1489 /* Declare that object-type TYPE has method M; used in
1490 initialization routines */
1491 #define OBJECT_HAS_METHOD(type, m) \
1492 (lrecord_##type.m = type##_##m)
1493 /* Same but the method name come before the type */
1494 #define OBJECT_HAS_PREMETHOD(type, m) \
1495 (lrecord_##type.m = m##_##type)
1496 /* Same but the name of the method is explicitly given */
1497 #define OBJECT_HAS_NAMED_METHOD(type, m, func) \
1498 (lrecord_##type.m = (func))
1499 /* Object type has a property with the given value. */
1500 #define OBJECT_HAS_PROPERTY(type, prop, val) \
1501 (lrecord_##type.prop = (val))
1502
1503 /* Does the given object method exist? */
1504 #define HAS_OBJECT_METH_P(obj, m) \
1505 (!!(XRECORD_LHEADER_IMPLEMENTATION (obj)->m))
1506 /* Call an object method. */
1507 #define OBJECT_METH(obj, m, args) \
1508 ((XRECORD_LHEADER_IMPLEMENTATION (obj)->m) args)
1509
1510 /* Call an object method, if it exists. */
1511 #define MAYBE_OBJECT_METH(obj, m, args) \
1512 do \
1513 { \
1514 const struct lrecord_implementation *_mom_imp = \
1515 XRECORD_LHEADER_IMPLEMENTATION (obj); \
1516 if (_mom_imp->m) \
1517 ((_mom_imp->m) args); \
1518 } while (0)
1519
1520 /* Call an object method, if it exists, or return GIVEN. NOTE:
1521 Multiply-evaluates OBJ. */
1522 #define OBJECT_METH_OR_GIVEN(obj, m, args, given) \
1523 (HAS_OBJECT_METH_P (obj, m) ? OBJECT_METH (obj, m, args) : (given))
1524
1525 #define OBJECT_PROPERTY(obj, prop) (XRECORD_LHEADER_IMPLEMENTATION (obj)->prop)
1526
1527 /************** Other stuff **************/
1467 1528
1468 #define LRECORDP(a) (XTYPE (a) == Lisp_Type_Record) 1529 #define LRECORDP(a) (XTYPE (a) == Lisp_Type_Record)
1469 #define XRECORD_LHEADER(a) ((struct lrecord_header *) XPNTR (a)) 1530 #define XRECORD_LHEADER(a) ((struct lrecord_header *) XPNTR (a))
1470 1531
1471 #define RECORD_TYPEP(x, ty) \ 1532 #define RECORD_TYPEP(x, ty) \
1673 */ 1734 */
1674 1735
1675 1736
1676 #ifdef ERROR_CHECK_TYPES 1737 #ifdef ERROR_CHECK_TYPES
1677 1738
1678 # define DECLARE_LISP_OBJECT(c_name, structtype) \ 1739 # define DECLARE_LISP_OBJECT(c_name, structtype) \
1679 extern const struct lrecord_implementation lrecord_##c_name; \ 1740 extern struct lrecord_implementation lrecord_##c_name; \
1680 DECLARE_INLINE_HEADER ( \ 1741 DECLARE_INLINE_HEADER ( \
1681 structtype * \ 1742 structtype * \
1682 error_check_##c_name (Lisp_Object obj, const Ascbyte *file, int line) \ 1743 error_check_##c_name (Lisp_Object obj, const Ascbyte *file, int line) \
1683 ) \ 1744 ) \
1684 { \ 1745 { \
1685 assert_at_line (RECORD_TYPEP (obj, lrecord_type_##c_name), file, line); \ 1746 assert_at_line (RECORD_TYPEP (obj, lrecord_type_##c_name), file, line); \
1686 return (structtype *) XPNTR (obj); \ 1747 return (structtype *) XPNTR (obj); \
1687 } \ 1748 } \
1688 extern Lisp_Object Q##c_name##p 1749 extern Lisp_Object Q##c_name##p
1689 1750
1690 # define DECLARE_MODULE_API_LISP_OBJECT(c_name, structtype) \ 1751 # define DECLARE_MODULE_API_LISP_OBJECT(c_name, structtype) \
1691 extern MODULE_API const struct lrecord_implementation lrecord_##c_name; \ 1752 extern MODULE_API struct lrecord_implementation lrecord_##c_name; \
1692 DECLARE_INLINE_HEADER ( \ 1753 DECLARE_INLINE_HEADER ( \
1693 structtype * \ 1754 structtype * \
1694 error_check_##c_name (Lisp_Object obj, const Ascbyte *file, int line) \ 1755 error_check_##c_name (Lisp_Object obj, const Ascbyte *file, int line) \
1695 ) \ 1756 ) \
1696 { \ 1757 { \
1697 assert_at_line (RECORD_TYPEP (obj, lrecord_type_##c_name), file, line); \ 1758 assert_at_line (RECORD_TYPEP (obj, lrecord_type_##c_name), file, line); \
1698 return (structtype *) XPNTR (obj); \ 1759 return (structtype *) XPNTR (obj); \
1699 } \ 1760 } \
1700 extern MODULE_API Lisp_Object Q##c_name##p 1761 extern MODULE_API Lisp_Object Q##c_name##p
1701 1762
1702 # define DECLARE_MODULE_LISP_OBJECT(c_name, structtype) \ 1763 # define DECLARE_MODULE_LISP_OBJECT(c_name, structtype) \
1703 extern int lrecord_type_##c_name; \ 1764 extern int lrecord_type_##c_name; \
1704 extern struct lrecord_implementation lrecord_##c_name; \ 1765 extern struct lrecord_implementation lrecord_##c_name; \
1705 DECLARE_INLINE_HEADER ( \ 1766 DECLARE_INLINE_HEADER ( \
1706 structtype * \ 1767 structtype * \
1707 error_check_##c_name (Lisp_Object obj, const Ascbyte *file, int line) \ 1768 error_check_##c_name (Lisp_Object obj, const Ascbyte *file, int line) \
1708 ) \ 1769 ) \
1709 { \ 1770 { \
1710 assert_at_line (RECORD_TYPEP (obj, lrecord_type_##c_name), file, line); \ 1771 assert_at_line (RECORD_TYPEP (obj, lrecord_type_##c_name), file, line); \
1711 return (structtype *) XPNTR (obj); \ 1772 return (structtype *) XPNTR (obj); \
1712 } \ 1773 } \
1713 extern Lisp_Object Q##c_name##p 1774 extern Lisp_Object Q##c_name##p
1714 1775
1715 # define XRECORD(x, c_name, structtype) \ 1776 # define XRECORD(x, c_name, structtype) \
1716 error_check_##c_name (x, __FILE__, __LINE__) 1777 error_check_##c_name (x, __FILE__, __LINE__)
1717 1778
1732 1793
1733 #else /* not ERROR_CHECK_TYPES */ 1794 #else /* not ERROR_CHECK_TYPES */
1734 1795
1735 # define DECLARE_LISP_OBJECT(c_name, structtype) \ 1796 # define DECLARE_LISP_OBJECT(c_name, structtype) \
1736 extern Lisp_Object Q##c_name##p; \ 1797 extern Lisp_Object Q##c_name##p; \
1737 extern const struct lrecord_implementation lrecord_##c_name 1798 extern struct lrecord_implementation lrecord_##c_name
1738 # define DECLARE_MODULE_API_LISP_OBJECT(c_name, structtype) \ 1799 # define DECLARE_MODULE_API_LISP_OBJECT(c_name, structtype) \
1739 extern MODULE_API Lisp_Object Q##c_name##p; \ 1800 extern MODULE_API Lisp_Object Q##c_name##p; \
1740 extern MODULE_API const struct lrecord_implementation lrecord_##c_name 1801 extern MODULE_API struct lrecord_implementation lrecord_##c_name
1741 # define DECLARE_MODULE_LISP_OBJECT(c_name, structtype) \ 1802 # define DECLARE_MODULE_LISP_OBJECT(c_name, structtype) \
1742 extern Lisp_Object Q##c_name##p; \ 1803 extern Lisp_Object Q##c_name##p; \
1743 extern int lrecord_type_##c_name; \ 1804 extern int lrecord_type_##c_name; \
1744 extern struct lrecord_implementation lrecord_##c_name 1805 extern struct lrecord_implementation lrecord_##c_name
1745 # define XRECORD(x, c_name, structtype) ((structtype *) XPNTR (x)) 1806 # define XRECORD(x, c_name, structtype) ((structtype *) XPNTR (x))
1946 ) 2007 )
1947 { 2008 {
1948 return detagged_lisp_object_size (XRECORD_LHEADER (o)); 2009 return detagged_lisp_object_size (XRECORD_LHEADER (o));
1949 } 2010 }
1950 2011
1951 struct overhead_stats; 2012 struct usage_stats;
1952 2013
1953 MODULE_API void copy_lisp_object (Lisp_Object dst, Lisp_Object src); 2014 MODULE_API void copy_lisp_object (Lisp_Object dst, Lisp_Object src);
1954 MODULE_API void zero_sized_lisp_object (Lisp_Object obj, Bytecount size); 2015 MODULE_API void zero_sized_lisp_object (Lisp_Object obj, Bytecount size);
1955 MODULE_API void zero_nonsized_lisp_object (Lisp_Object obj); 2016 MODULE_API void zero_nonsized_lisp_object (Lisp_Object obj);
1956 #ifdef MEMORY_USAGE_STATS 2017 #ifdef MEMORY_USAGE_STATS
1957 Bytecount lisp_object_storage_size (Lisp_Object obj, 2018 Bytecount lisp_object_storage_size (Lisp_Object obj,
1958 struct overhead_stats *ovstats); 2019 struct usage_stats *ustats);
1959 #endif /* MEMORY_USAGE_STATS */ 2020 #endif /* MEMORY_USAGE_STATS */
1960 void free_normal_lisp_object (Lisp_Object obj); 2021 void free_normal_lisp_object (Lisp_Object obj);
1961 2022
1962 2023
1963 /************************************************************************/ 2024 /************************************************************************/