Mercurial > hg > xemacs-beta
annotate src/debug.c @ 5157:1fae11d56ad2
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 | e0138eaaca0c |
| children | 308d34e9f07d |
| rev | line source |
|---|---|
| 428 | 1 /* Debugging aids -- togglable assertions. |
| 2 Copyright (C) 1994 Free Software Foundation, Inc. | |
| 3 | |
| 4 This file is part of XEmacs. | |
| 5 | |
| 6 XEmacs is free software; you can redistribute it and/or modify it | |
| 7 under the terms of the GNU General Public License as published by the | |
| 8 Free Software Foundation; either version 2, or (at your option) any | |
| 9 later version. | |
| 10 | |
| 11 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 14 for more details. | |
| 15 | |
| 16 You should have received a copy of the GNU General Public License | |
| 17 along with XEmacs; see the file COPYING. If not, write to | |
| 18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 19 Boston, MA 02111-1307, USA. */ | |
| 20 | |
| 21 /* Synched up with: Not in FSF. */ | |
| 22 | |
| 23 /* This file has been Mule-ized. */ | |
| 24 | |
| 25 /* Written by Chuck Thompson */ | |
| 26 | |
| 27 #include <config.h> | |
| 28 #include "lisp.h" | |
| 29 #include "debug.h" | |
| 30 #include "bytecode.h" | |
| 31 | |
| 32 /* | |
| 33 * To add a new debug class: | |
| 1318 | 34 * 1. Add a symbol definition for it here or in general-slots.h, if one |
| 35 * doesn't exist elsewhere. If you add it here, make sure to add a | |
| 36 * defsymbol line for it in syms_of_debug. | |
| 428 | 37 * 2. Add an extern definition for the symbol to debug.h. |
| 38 * 3. Add entries for the class to struct debug_classes in debug.h. | |
| 39 * 4. Add a FROB line for it in xemacs_debug_loop. | |
| 40 */ | |
| 41 | |
| 42 struct debug_classes active_debug_classes; | |
| 43 | |
| 44 enum debug_loop | |
| 45 { | |
| 436 | 46 X_ADD, |
| 47 X_DELETE, | |
| 48 X_LIST, | |
| 49 X_ACTIVE, | |
| 50 X_INIT, | |
| 51 X_VALIDATE, | |
| 52 X_TYPE, | |
| 53 X_SETTYPE | |
| 428 | 54 }; |
| 55 | |
| 56 static Lisp_Object | |
| 1204 | 57 xemacs_debug_loop (enum debug_loop op, Lisp_Object class_, Lisp_Object type) |
| 428 | 58 { |
| 436 | 59 int flag = (op == X_ADD) ? 1 : 0; |
| 428 | 60 Lisp_Object retval = Qnil; |
| 61 | |
| 1318 | 62 #define FROB(item) \ |
| 63 if (op == X_LIST || op == X_ACTIVE || op == X_INIT || EQ (class_, Q##item)) \ | |
| 64 { \ | |
| 65 if (op == X_ADD || op == X_DELETE || op == X_INIT) \ | |
| 66 active_debug_classes.item = flag; \ | |
| 67 else if (op == X_LIST \ | |
| 68 || (op == X_ACTIVE && active_debug_classes.item)) \ | |
| 69 retval = Fcons (Q##item, retval); \ | |
| 70 else if (op == X_VALIDATE) \ | |
| 71 return Qt; \ | |
| 72 else if (op == X_SETTYPE) \ | |
| 73 active_debug_classes.types_of_##item = XINT (type); \ | |
| 74 else if (op == X_TYPE) \ | |
| 75 retval = make_int (active_debug_classes.types_of_##item); \ | |
| 76 if (op == X_INIT) active_debug_classes.types_of_##item = VALBITS; \ | |
| 428 | 77 } |
| 78 | |
| 79 FROB (redisplay); | |
| 80 FROB (buffers); | |
| 81 FROB (extents); | |
| 82 FROB (faces); | |
| 83 FROB (windows); | |
| 84 FROB (frames); | |
| 85 FROB (devices); | |
| 86 FROB (byte_code); | |
| 87 | |
| 88 return retval; | |
| 89 #undef FROB | |
| 90 } | |
| 91 | |
| 92 DEFUN ("add-debug-class-to-check", Fadd_debug_class_to_check, 1, 1, 0, /* | |
| 93 Add a debug class to the list of active classes. | |
| 94 */ | |
| 1204 | 95 (class_)) |
| 428 | 96 { |
| 1204 | 97 if (NILP (xemacs_debug_loop (X_VALIDATE, class_, Qnil))) |
| 563 | 98 invalid_argument ("No such debug class exists", Qunbound); |
| 428 | 99 else |
| 1204 | 100 xemacs_debug_loop (X_ADD, class_, Qnil); |
| 428 | 101 |
| 436 | 102 return (xemacs_debug_loop (X_ACTIVE, Qnil, Qnil)); |
| 428 | 103 } |
| 104 | |
| 105 DEFUN ("delete-debug-class-to-check", Fdelete_debug_class_to_check, 1, 1, 0, /* | |
| 106 Delete a debug class from the list of active classes. | |
| 107 */ | |
| 1204 | 108 (class_)) |
| 428 | 109 { |
| 1204 | 110 if (NILP (xemacs_debug_loop (X_VALIDATE, class_, Qnil))) |
| 563 | 111 invalid_argument ("No such debug class exists", Qunbound); |
| 428 | 112 else |
| 1204 | 113 xemacs_debug_loop (X_DELETE, class_, Qnil); |
| 428 | 114 |
| 436 | 115 return (xemacs_debug_loop (X_ACTIVE, Qnil, Qnil)); |
| 428 | 116 } |
| 117 | |
| 118 DEFUN ("debug-classes-being-checked", Fdebug_classes_being_checked, 0, 0, 0, /* | |
| 119 Return a list of active debug classes. | |
| 120 */ | |
| 121 ()) | |
| 122 { | |
| 436 | 123 return (xemacs_debug_loop (X_ACTIVE, Qnil, Qnil)); |
| 428 | 124 } |
| 125 | |
| 126 DEFUN ("debug-classes-list", Fdebug_classes_list, 0, 0, 0, /* | |
| 127 Return a list of all defined debug classes. | |
| 128 */ | |
| 129 ()) | |
| 130 { | |
| 436 | 131 return (xemacs_debug_loop (X_LIST, Qnil, Qnil)); |
| 428 | 132 } |
| 133 | |
| 134 DEFUN ("set-debug-classes-to-check", Fset_debug_classes_to_check, 1, 1, 0, /* | |
| 135 Set which classes of debug statements should be active. | |
| 136 CLASSES should be a list of debug classes. | |
| 137 */ | |
| 138 (classes)) | |
| 139 { | |
| 140 Lisp_Object rest; | |
| 141 | |
| 142 CHECK_LIST (classes); | |
| 143 | |
| 144 /* Make sure all objects in the list are valid. If anyone is not | |
| 145 valid, reject the entire list without doing anything. */ | |
| 1204 | 146 LIST_LOOP (rest, classes) |
| 428 | 147 { |
| 436 | 148 if (NILP (xemacs_debug_loop (X_VALIDATE, XCAR (rest), Qnil))) |
| 563 | 149 sferror ("Invalid object in class list", Qunbound); |
| 428 | 150 } |
| 151 | |
| 152 LIST_LOOP (rest, classes) | |
| 153 Fadd_debug_class_to_check (XCAR (rest)); | |
| 154 | |
| 436 | 155 return (xemacs_debug_loop (X_ACTIVE, Qnil, Qnil)); |
| 428 | 156 } |
| 157 | |
| 158 DEFUN ("set-debug-class-types-to-check", Fset_debug_class_types_to_check, 2, 2, 0, /* | |
| 159 For the given debug CLASS, set which TYPES are actually interesting. | |
| 160 TYPES should be an integer representing the or'd value of all desired types. | |
| 161 Lists of defined types and their values are located in the source code. | |
| 162 */ | |
| 1204 | 163 (class_, type)) |
| 428 | 164 { |
| 165 CHECK_INT (type); | |
| 1204 | 166 if (NILP (xemacs_debug_loop (X_VALIDATE, class_, Qnil))) |
| 563 | 167 invalid_argument ("Invalid debug class", Qunbound); |
| 428 | 168 |
| 1204 | 169 xemacs_debug_loop (X_SETTYPE, class_, type); |
| 428 | 170 |
| 1204 | 171 return (xemacs_debug_loop (X_TYPE, class_, Qnil)); |
| 428 | 172 } |
| 173 | |
| 174 DEFUN ("debug-types-being-checked", Fdebug_types_being_checked, 1, 1, 0, /* | |
| 175 For the given CLASS, return the associated type value. | |
| 176 */ | |
| 1204 | 177 (class_)) |
| 428 | 178 { |
| 1204 | 179 if (NILP (xemacs_debug_loop (X_VALIDATE, class_, Qnil))) |
| 563 | 180 invalid_argument ("Invalid debug class", Qunbound); |
| 428 | 181 |
| 1204 | 182 return (xemacs_debug_loop (X_TYPE, class_, Qnil)); |
| 428 | 183 } |
| 184 | |
| 185 void | |
| 186 syms_of_debug (void) | |
| 187 { | |
| 188 DEFSUBR (Fadd_debug_class_to_check); | |
| 189 DEFSUBR (Fdelete_debug_class_to_check); | |
| 190 DEFSUBR (Fdebug_classes_being_checked); | |
| 191 DEFSUBR (Fdebug_classes_list); | |
| 192 DEFSUBR (Fset_debug_classes_to_check); | |
| 193 DEFSUBR (Fset_debug_class_types_to_check); | |
| 194 DEFSUBR (Fdebug_types_being_checked); | |
| 195 } | |
| 196 | |
| 197 void | |
| 198 reinit_vars_of_debug (void) | |
| 199 { | |
| 200 /* If you need to have any classes active early on in startup, then | |
| 201 the flags should be set here. | |
| 202 All functions called by this function are "allowed" according | |
| 203 to emacs.c. */ | |
| 436 | 204 xemacs_debug_loop (X_INIT, Qnil, Qnil); |
| 428 | 205 } |
| 206 | |
| 207 void | |
| 208 vars_of_debug (void) | |
| 209 { | |
|
4852
e0138eaaca0c
need to provide debug-xemacs for debug-on-error changes to work
Ben Wing <ben@xemacs.org>
parents:
2367
diff
changeset
|
210 Fprovide (intern ("debug-xemacs")); |
| 428 | 211 } |