Mercurial > hg > xemacs-beta

comparison src/alloc.c @ 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
103 Bytecount funcall_alloca_count; 103 Bytecount funcall_alloca_count;
104 104
105 /* All the built-in lisp object types are enumerated in `enum lrecord_type'. 105 /* All the built-in lisp object types are enumerated in `enum lrecord_type'.
106 Additional ones may be defined by a module (none yet). We leave some 106 Additional ones may be defined by a module (none yet). We leave some
107 room in `lrecord_implementations_table' for such new lisp object types. */ 107 room in `lrecord_implementations_table' for such new lisp object types. */
108 const struct lrecord_implementation *lrecord_implementations_table[(int)lrecord_type_last_built_in_type + MODULE_DEFINABLE_TYPE_COUNT]; 108 struct lrecord_implementation *lrecord_implementations_table[(int)lrecord_type_last_built_in_type + MODULE_DEFINABLE_TYPE_COUNT];
109 int lrecord_type_count = lrecord_type_last_built_in_type; 109 int lrecord_type_count = lrecord_type_last_built_in_type;
110 110
111 /* This is just for use by the printer, to allow things to print uniquely. 111 /* This is just for use by the printer, to allow things to print uniquely.
112 We have a separate UID space for each object. (Important because the 112 We have a separate UID space for each object. (Important because the
113 UID is only 20 bits in old-GC, and 22 in NEW_GC.) */ 113 UID is only 20 bits in old-GC, and 22 in NEW_GC.) */
124 #ifdef ERROR_CHECK_TYPES 124 #ifdef ERROR_CHECK_TYPES
125 125
126 Error_Behavior ERROR_ME, ERROR_ME_NOT, ERROR_ME_WARN, ERROR_ME_DEBUG_WARN; 126 Error_Behavior ERROR_ME, ERROR_ME_NOT, ERROR_ME_WARN, ERROR_ME_DEBUG_WARN;
127 127
128 #endif 128 #endif
129
130 #ifdef MEMORY_USAGE_STATS
131 Lisp_Object Qobject_actually_requested, Qobject_malloc_overhead;
132 Lisp_Object Qother_memory_actually_requested, Qother_memory_malloc_overhead;
133 Lisp_Object Qother_memory_dynarr_overhead, Qother_memory_gap_overhead;
134 #endif /* MEMORY_USAGE_STATS */
129 135
130 /* Very cheesy ways of figuring out how much memory is being used for 136 /* Very cheesy ways of figuring out how much memory is being used for
131 data. #### Need better (system-dependent) ways. */ 137 data. #### Need better (system-dependent) ways. */
132 void *minimum_address_seen; 138 void *minimum_address_seen;
133 void *maximum_address_seen; 139 void *maximum_address_seen;
758 { 764 {
759 stderr_out ("Disksaving a non-dumpable object: "); 765 stderr_out ("Disksaving a non-dumpable object: ");
760 debug_print (wrap_pointer_1 (header)); 766 debug_print (wrap_pointer_1 (header));
761 } 767 }
762 #endif 768 #endif
763 if (imp->disksaver && !objh->free) 769 if (imp->disksave && !objh->free)
764 (imp->disksaver) (wrap_pointer_1 (header)); 770 (imp->disksave) (wrap_pointer_1 (header));
765 } 771 }
766 #endif /* not NEW_GC */ 772 #endif /* not NEW_GC */
767 } 773 }
768 774
769 /* Bitwise copy all parts of a Lisp object other than the header */ 775 /* Bitwise copy all parts of a Lisp object other than the header */
840 } 846 }
841 847
842 #ifdef MEMORY_USAGE_STATS 848 #ifdef MEMORY_USAGE_STATS
843 849
844 Bytecount 850 Bytecount
845 lisp_object_storage_size (Lisp_Object obj, struct overhead_stats *ovstats) 851 lisp_object_storage_size (Lisp_Object obj, struct usage_stats *ustats)
846 { 852 {
847 #ifndef NEW_GC 853 #ifndef NEW_GC
848 const struct lrecord_implementation *imp = 854 const struct lrecord_implementation *imp =
849 XRECORD_LHEADER_IMPLEMENTATION (obj); 855 XRECORD_LHEADER_IMPLEMENTATION (obj);
850 #endif /* not NEW_GC */ 856 #endif /* not NEW_GC */
851 Bytecount size = lisp_object_size (obj); 857 Bytecount size = lisp_object_size (obj);
852 858
853 #ifdef NEW_GC 859 #ifdef NEW_GC
854 return mc_alloced_storage_size (size, ovstats); 860 return mc_alloced_storage_size (size, ustats);
855 #else 861 #else
856 if (imp->frob_block_p) 862 if (imp->frob_block_p)
857 { 863 {
858 Bytecount overhead = fixed_type_block_overhead (size); 864 Bytecount overhead = fixed_type_block_overhead (size);
859 if (ovstats) 865 if (ustats)
860 { 866 {
861 ovstats->was_requested += size; 867 ustats->was_requested += size;
862 ovstats->malloc_overhead += overhead; 868 ustats->malloc_overhead += overhead;
863 } 869 }
864 return size + overhead; 870 return size + overhead;
865 } 871 }
866 else 872 else
867 return malloced_storage_size (XPNTR (obj), size, ovstats); 873 return malloced_storage_size (XPNTR (obj), size, ustats);
868 #endif 874 #endif
869 } 875 }
870 876
871 #endif /* MEMORY_USAGE_STATS */ 877 #endif /* MEMORY_USAGE_STATS */
872 878
1478 { 1484 {
1479 /* This cannot GC. */ 1485 /* This cannot GC. */
1480 return Fcons (obj0, Fcons (obj1, Fcons (obj2, Fcons (obj3, Fcons (obj4, Fcons (obj5, Qnil)))))); 1486 return Fcons (obj0, Fcons (obj1, Fcons (obj2, Fcons (obj3, Fcons (obj4, Fcons (obj5, Qnil))))));
1481 } 1487 }
1482 1488
1489 /* Return a list of arbitrary length, terminated by Qunbound. */
1490
1491 Lisp_Object
1492 listu (Lisp_Object first, ...)
1493 {
1494 Lisp_Object obj = Qnil;
1495 Lisp_Object val;
1496 va_list va;
1497
1498 va_start (va, first);
1499 val = first;
1500 while (!UNBOUNDP (val))
1501 {
1502 obj = Fcons (val, obj);
1503 val = va_arg (va, Lisp_Object);
1504 }
1505 va_end (va);
1506 return Fnreverse (obj);
1507 }
1508
1509 /* Return a list of arbitrary length, with length specified and remaining
1510 args making up the list. */
1511
1512 Lisp_Object
1513 listn (int num_args, ...)
1514 {
1515 int i;
1516 Lisp_Object obj = Qnil;
1517 va_list va;
1518
1519 va_start (va, num_args);
1520 for (i = 0; i < num_args; i++)
1521 obj = Fcons (va_arg (va, Lisp_Object), obj);
1522 va_end (va);
1523 return Fnreverse (obj);
1524 }
1525
1526 /* Return a list of arbitrary length, with length specified and an array
1527 of elements. */
1528
1483 DEFUN ("make-list", Fmake_list, 2, 2, 0, /* 1529 DEFUN ("make-list", Fmake_list, 2, 2, 0, /*
1484 Return a new list of length LENGTH, with each element being OBJECT. 1530 Return a new list of length LENGTH, with each element being OBJECT.
1485 */ 1531 */
1486 (length, object)) 1532 (length, object))
1487 { 1533 {
2432 internal_hash() already knows how to hash strings and finalization 2478 internal_hash() already knows how to hash strings and finalization
2433 is done with the ADDITIONAL_FREE_string macro, which is the 2479 is done with the ADDITIONAL_FREE_string macro, which is the
2434 standard way to do finalization when using 2480 standard way to do finalization when using
2435 SWEEP_FIXED_TYPE_BLOCK(). */ 2481 SWEEP_FIXED_TYPE_BLOCK(). */
2436 2482
2437 DEFINE_DUMPABLE_FROB_BLOCK_GENERAL_LISP_OBJECT ("string", string, 2483 DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("string", string,
2438 mark_string, print_string, 2484 mark_string, print_string,
2439 0, string_equal, 0, 2485 0, string_equal, 0,
2440 string_description, 2486 string_description,
2441 string_getprop, 2487 Lisp_String);
2442 string_putprop,
2443 string_remprop,
2444 string_plist,
2445 0 /* no disksaver */,
2446 Lisp_String);
2447 #endif /* not NEW_GC */ 2488 #endif /* not NEW_GC */
2448 2489
2449 #ifdef NEW_GC 2490 #ifdef NEW_GC
2450 #define STRING_FULLSIZE(size) \ 2491 #define STRING_FULLSIZE(size) \
2451 ALIGN_SIZE (FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_String_Direct_Data, Lisp_Object, data, (size) + 1), sizeof (Lisp_Object *)); 2492 ALIGN_SIZE (FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_String_Direct_Data, Lisp_Object, data, (size) + 1), sizeof (Lisp_Object *));
2482 #define STRING_CHARS_FREE_P(ptr) ((ptr)->string == NULL) 2523 #define STRING_CHARS_FREE_P(ptr) ((ptr)->string == NULL)
2483 #define MARK_STRING_CHARS_AS_FREE(ptr) ((void) ((ptr)->string = NULL)) 2524 #define MARK_STRING_CHARS_AS_FREE(ptr) ((void) ((ptr)->string = NULL))
2484 #endif /* not NEW_GC */ 2525 #endif /* not NEW_GC */
2485 2526
2486 #ifdef NEW_GC 2527 #ifdef NEW_GC
2487 DEFINE_DUMPABLE_GENERAL_LISP_OBJECT ("string", string, 2528 DEFINE_DUMPABLE_LISP_OBJECT ("string", string, mark_string, print_string,
2488 mark_string, print_string, 2529 0, string_equal, 0,
2489 0, 2530 string_description, Lisp_String);
2490 string_equal, 0,
2491 string_description,
2492 string_getprop,
2493 string_putprop,
2494 string_remprop,
2495 string_plist,
2496 0 /* no disksaver */,
2497 Lisp_String);
2498 2531
2499 2532
2500 static const struct memory_description string_direct_data_description[] = { 2533 static const struct memory_description string_direct_data_description[] = {
2501 { XD_BYTECOUNT, offsetof (Lisp_String_Direct_Data, size) }, 2534 { XD_BYTECOUNT, offsetof (Lisp_String_Direct_Data, size) },
2502 { XD_END } 2535 { XD_END }
4746 } 4779 }
4747 4780
4748 return pl; 4781 return pl;
4749 } 4782 }
4750 4783
4751 DEFUN("object-memory-usage-stats", Fobject_memory_usage_stats, 0, 0 ,"", /* 4784 DEFUN ("object-memory-usage-stats", Fobject_memory_usage_stats, 0, 0, 0, /*
4752 Return statistics about memory usage of Lisp objects. 4785 Return statistics about memory usage of Lisp objects.
4753 */ 4786 */
4754 ()) 4787 ())
4755 { 4788 {
4756 return object_memory_usage_stats (0); 4789 return object_memory_usage_stats (0);
4757 } 4790 }
4758 4791
4759 #endif /* ALLOC_TYPE_STATS */ 4792 #endif /* ALLOC_TYPE_STATS */
4793
4794 #ifdef MEMORY_USAGE_STATS
4795
4796 /* Compute the number of extra memory-usage statistics associated with an
4797 object. We can't compute this at the time INIT_LISP_OBJECT() is called
4798 because the value of the `memusage_stats_list' property is generally
4799 set afterwards. So we compute the values for all types of objects
4800 after all objects have been initialized. */
4801
4802 static void
4803 compute_memusage_stats_length (void)
4804 {
4805 int i;
4806
4807 for (i = 0; i < countof (lrecord_implementations_table); i++)
4808 {
4809 int len = 0;
4810 struct lrecord_implementation *imp = lrecord_implementations_table[i];
4811
4812 if (!imp)
4813 continue;
4814 /* For some of the early objects, Qnil was not yet initialized at
4815 the time of object initialization, so it came up as Qnull_pointer.
4816 Fix that now. */
4817 if (EQ (imp->memusage_stats_list, Qnull_pointer))
4818 imp->memusage_stats_list = Qnil;
4819 {
4820 LIST_LOOP_2 (item, imp->memusage_stats_list)
4821 {
4822 if (!NILP (item) && !EQ (item, Qt))
4823 len++;
4824 }
4825 }
4826
4827 imp->num_extra_memusage_stats = len;
4828 }
4829 }
4830
4831 DEFUN ("object-memory-usage", Fobject_memory_usage, 1, 1, 0, /*
4832 Return stats about the memory usage of OBJECT.
4833 The values returned are in the form of an alist of usage types and byte
4834 counts. The byte counts attempt to encompass all the memory used
4835 by the object (separate from the memory logically associated with any
4836 other object), including internal structures and any malloc()
4837 overhead associated with them. In practice, the byte counts are
4838 underestimated because certain memory usage is very hard to determine
4839 \(e.g. the amount of memory used inside the Xt library or inside the
4840 X server).
4841
4842 Multiple slices of the total memory usage may be returned, separated
4843 by a nil. Each slice represents a particular view of the memory, a
4844 particular way of partitioning it into groups. Within a slice, there
4845 is no overlap between the groups of memory, and each slice collectively
4846 represents all the memory concerned. The rightmost slice typically
4847 represents the total memory used plus malloc and dynarr overhead.
4848
4849 Slices describing other Lisp objects logically associated with the
4850 object may be included, separated from other slices by `t' and from
4851 each other by nil if there is more than one.
4852
4853 #### We have to figure out how to handle the memory used by the object
4854 itself vs. the memory used by substructures. Probably the memory_usage
4855 method should return info only about substructures and related Lisp
4856 objects, since the caller can always find and all info about the object
4857 itself.
4858 */
4859 (object))
4860 {
4861 struct generic_usage_stats gustats;
4862 struct usage_stats object_stats;
4863 int i;
4864 Lisp_Object val = Qnil;
4865 Lisp_Object stats_list = OBJECT_PROPERTY (object, memusage_stats_list);
4866
4867 xzero (object_stats);
4868 lisp_object_storage_size (object, &object_stats);
4869
4870 val = acons (Qobject_actually_requested,
4871 make_int (object_stats.was_requested), val);
4872 val = acons (Qobject_malloc_overhead,
4873 make_int (object_stats.malloc_overhead), val);
4874 assert (!object_stats.dynarr_overhead);
4875 assert (!object_stats.gap_overhead);
4876
4877 if (!NILP (stats_list))
4878 {
4879 xzero (gustats);
4880 MAYBE_OBJECT_METH (object, memory_usage, (object, &gustats));
4881
4882 val = Fcons (Qt, val);
4883 val = acons (Qother_memory_actually_requested,
4884 make_int (gustats.u.was_requested), val);
4885 val = acons (Qother_memory_malloc_overhead,
4886 make_int (gustats.u.malloc_overhead), val);
4887 if (gustats.u.dynarr_overhead)
4888 val = acons (Qother_memory_dynarr_overhead,
4889 make_int (gustats.u.dynarr_overhead), val);
4890 if (gustats.u.gap_overhead)
4891 val = acons (Qother_memory_gap_overhead,
4892 make_int (gustats.u.gap_overhead), val);
4893 val = Fcons (Qnil, val);
4894
4895 i = 0;
4896 {
4897 LIST_LOOP_2 (item, stats_list)
4898 {
4899 if (NILP (item) || EQ (item, Qt))
4900 val = Fcons (item, val);
4901 else
4902 {
4903 val = acons (item, make_int (gustats.othervals[i]), val);
4904 i++;
4905 }
4906 }
4907 }
4908 }
4909
4910 return Fnreverse (val);
4911 }
4912
4913 #endif /* MEMORY_USAGE_STATS */
4760 4914
4761 /* Debugging aids. */ 4915 /* Debugging aids. */
4762 4916
4763 DEFUN ("garbage-collect", Fgarbage_collect, 0, 0, "", /* 4917 DEFUN ("garbage-collect", Fgarbage_collect, 0, 0, "", /*
4764 Reclaim storage for Lisp objects no longer needed. 4918 Reclaim storage for Lisp objects no longer needed.
4856 { 5010 {
4857 return make_int (total_data_usage ()); 5011 return make_int (total_data_usage ());
4858 } 5012 }
4859 5013
4860 #ifdef ALLOC_TYPE_STATS 5014 #ifdef ALLOC_TYPE_STATS
4861 DEFUN ("object-memory-usage", Fobject_memory_usage, 0, 0, 0, /* 5015 DEFUN ("total-object-memory-usage", Ftotal_object_memory_usage, 0, 0, 0, /*
4862 Return total number of bytes used for object storage in XEmacs. 5016 Return total number of bytes used for object storage in XEmacs.
4863 This may be helpful in debugging XEmacs's memory usage. 5017 This may be helpful in debugging XEmacs's memory usage.
4864 See also `consing-since-gc' and `object-memory-usage-stats'. 5018 See also `consing-since-gc' and `object-memory-usage-stats'.
4865 */ 5019 */
4866 ()) 5020 ())
4948 blocks are allocated in the minimum required size except 5102 blocks are allocated in the minimum required size except
4949 that some minimum block size is imposed (e.g. 16 bytes). */ 5103 that some minimum block size is imposed (e.g. 16 bytes). */
4950 5104
4951 Bytecount 5105 Bytecount
4952 malloced_storage_size (void * UNUSED (ptr), Bytecount claimed_size, 5106 malloced_storage_size (void * UNUSED (ptr), Bytecount claimed_size,
4953 struct overhead_stats *stats) 5107 struct usage_stats *stats)
4954 { 5108 {
4955 Bytecount orig_claimed_size = claimed_size; 5109 Bytecount orig_claimed_size = claimed_size;
4956 5110
4957 #ifndef SYSTEM_MALLOC 5111 #ifndef SYSTEM_MALLOC
4958 if (claimed_size < (Bytecount) (2 * sizeof (void *))) 5112 if (claimed_size < (Bytecount) (2 * sizeof (void *)))
5054 #endif 5208 #endif
5055 #endif 5209 #endif
5056 #ifndef NEW_GC 5210 #ifndef NEW_GC
5057 init_string_chars_alloc (); 5211 init_string_chars_alloc ();
5058 init_string_alloc (); 5212 init_string_alloc ();
5213 /* #### Is it intentional that this is called twice? --ben */
5059 init_string_chars_alloc (); 5214 init_string_chars_alloc ();
5060 init_cons_alloc (); 5215 init_cons_alloc ();
5061 init_symbol_alloc (); 5216 init_symbol_alloc ();
5062 init_compiled_function_alloc (); 5217 init_compiled_function_alloc ();
5063 init_float_alloc (); 5218 init_float_alloc ();
5162 #else 5317 #else
5163 gcprolist = 0; 5318 gcprolist = 0;
5164 #endif /* defined (__cplusplus) && defined (ERROR_CHECK_GC) */ 5319 #endif /* defined (__cplusplus) && defined (ERROR_CHECK_GC) */
5165 } 5320 }
5166 5321
5322 static void
5323 reinit_alloc_objects_early (void)
5324 {
5325 OBJECT_HAS_METHOD (string, getprop);
5326 OBJECT_HAS_METHOD (string, putprop);
5327 OBJECT_HAS_METHOD (string, remprop);
5328 OBJECT_HAS_METHOD (string, plist);
5329 }
5330
5167 void 5331 void
5168 reinit_alloc_early (void) 5332 reinit_alloc_early (void)
5169 { 5333 {
5170 common_init_alloc_early (); 5334 common_init_alloc_early ();
5171 #ifndef NEW_GC 5335 #ifndef NEW_GC
5172 init_lcrecord_lists (); 5336 init_lcrecord_lists ();
5173 #endif /* not NEW_GC */ 5337 #endif /* not NEW_GC */
5338 reinit_alloc_objects_early ();
5174 } 5339 }
5175 5340
5176 void 5341 void
5177 init_alloc_once_early (void) 5342 init_alloc_once_early (void)
5178 { 5343 {
5183 for (i = 0; i < countof (lrecord_implementations_table); i++) 5348 for (i = 0; i < countof (lrecord_implementations_table); i++)
5184 lrecord_implementations_table[i] = 0; 5349 lrecord_implementations_table[i] = 0;
5185 } 5350 }
5186 5351
5187 dump_add_opaque (lrecord_uid_counter, sizeof (lrecord_uid_counter)); 5352 dump_add_opaque (lrecord_uid_counter, sizeof (lrecord_uid_counter));
5188
5189 INIT_LISP_OBJECT (cons);
5190 INIT_LISP_OBJECT (vector);
5191 INIT_LISP_OBJECT (string);
5192 #ifdef NEW_GC
5193 INIT_LISP_OBJECT (string_indirect_data);
5194 INIT_LISP_OBJECT (string_direct_data);
5195 #endif /* NEW_GC */
5196 #ifndef NEW_GC
5197 INIT_LISP_OBJECT (lcrecord_list);
5198 INIT_LISP_OBJECT (free);
5199 #endif /* not NEW_GC */
5200 5353
5201 staticpros = Dynarr_new2 (Lisp_Object_ptr_dynarr, Lisp_Object *); 5354 staticpros = Dynarr_new2 (Lisp_Object_ptr_dynarr, Lisp_Object *);
5202 Dynarr_resize (staticpros, 1410); /* merely a small optimization */ 5355 Dynarr_resize (staticpros, 1410); /* merely a small optimization */
5203 dump_add_root_block_ptr (&staticpros, &staticpros_description); 5356 dump_add_root_block_ptr (&staticpros, &staticpros_description);
5204 #ifdef DEBUG_XEMACS 5357 #ifdef DEBUG_XEMACS
5219 &const_Ascbyte_ptr_dynarr_description); 5372 &const_Ascbyte_ptr_dynarr_description);
5220 #endif 5373 #endif
5221 #else /* not NEW_GC */ 5374 #else /* not NEW_GC */
5222 init_lcrecord_lists (); 5375 init_lcrecord_lists ();
5223 #endif /* not NEW_GC */ 5376 #endif /* not NEW_GC */
5377
5378 INIT_LISP_OBJECT (cons);
5379 INIT_LISP_OBJECT (vector);
5380 INIT_LISP_OBJECT (string);
5381
5382 #ifdef NEW_GC
5383 INIT_LISP_OBJECT (string_indirect_data);
5384 INIT_LISP_OBJECT (string_direct_data);
5385 #endif /* NEW_GC */
5386 #ifndef NEW_GC
5387 INIT_LISP_OBJECT (lcrecord_list);
5388 INIT_LISP_OBJECT (free);
5389 #endif /* not NEW_GC */
5390
5391 reinit_alloc_objects_early ();
5224 } 5392 }
5225 5393
5226 void 5394 void
5227 syms_of_alloc (void) 5395 syms_of_alloc (void)
5228 { 5396 {
5229 DEFSYMBOL (Qgarbage_collecting); 5397 DEFSYMBOL (Qgarbage_collecting);
5398
5399 #ifdef MEMORY_USAGE_STATS
5400 DEFSYMBOL (Qobject_actually_requested);
5401 DEFSYMBOL (Qobject_malloc_overhead);
5402 DEFSYMBOL (Qother_memory_actually_requested);
5403 DEFSYMBOL (Qother_memory_malloc_overhead);
5404 DEFSYMBOL (Qother_memory_dynarr_overhead);
5405 DEFSYMBOL (Qother_memory_gap_overhead);
5406 #endif /* MEMORY_USAGE_STATS */
5230 5407
5231 DEFSUBR (Fcons); 5408 DEFSUBR (Fcons);
5232 DEFSUBR (Flist); 5409 DEFSUBR (Flist);
5233 DEFSUBR (Fvector); 5410 DEFSUBR (Fvector);
5234 DEFSUBR (Fbit_vector); 5411 DEFSUBR (Fbit_vector);
5241 DEFSUBR (Fmake_symbol); 5418 DEFSUBR (Fmake_symbol);
5242 DEFSUBR (Fmake_marker); 5419 DEFSUBR (Fmake_marker);
5243 DEFSUBR (Fpurecopy); 5420 DEFSUBR (Fpurecopy);
5244 #ifdef ALLOC_TYPE_STATS 5421 #ifdef ALLOC_TYPE_STATS
5245 DEFSUBR (Fobject_memory_usage_stats); 5422 DEFSUBR (Fobject_memory_usage_stats);
5423 DEFSUBR (Ftotal_object_memory_usage);
5424 #endif /* ALLOC_TYPE_STATS */
5425 #ifdef MEMORY_USAGE_STATS
5246 DEFSUBR (Fobject_memory_usage); 5426 DEFSUBR (Fobject_memory_usage);
5247 #endif /* ALLOC_TYPE_STATS */ 5427 #endif /* MEMORY_USAGE_STATS */
5248 DEFSUBR (Fgarbage_collect); 5428 DEFSUBR (Fgarbage_collect);
5249 #if 0 5429 #if 0
5250 DEFSUBR (Fmemory_limit); 5430 DEFSUBR (Fmemory_limit);
5251 #endif 5431 #endif
5252 DEFSUBR (Ftotal_memory_usage); 5432 DEFSUBR (Ftotal_memory_usage);
5256 DEFSUBR (Fvalgrind_quick_leak_check); 5436 DEFSUBR (Fvalgrind_quick_leak_check);
5257 #endif 5437 #endif
5258 } 5438 }
5259 5439
5260 void 5440 void
5441 reinit_vars_of_alloc (void)
5442 {
5443 #ifdef MEMORY_USAGE_STATS
5444 compute_memusage_stats_length ();
5445 #endif /* MEMORY_USAGE_STATS */
5446 }
5447
5448 void
5261 vars_of_alloc (void) 5449 vars_of_alloc (void)
5262 { 5450 {
5263 #ifdef DEBUG_XEMACS 5451 #ifdef DEBUG_XEMACS
5264 DEFVAR_INT ("debug-allocation", &debug_allocation /* 5452 DEFVAR_INT ("debug-allocation", &debug_allocation /*
5265 If non-zero, print out information to stderr about all objects allocated. 5453 If non-zero, print out information to stderr about all objects allocated.