Mercurial > hg > xemacs-beta
changeset 5179:14fda1dbdb26
add memory usage info for specifiers
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-03-29 Ben Wing <ben@xemacs.org>
* alloc.c:
* alloc.c (lisp_object_storage_size):
* alloc.c (Fobject_memory_usage):
* alloc.c (lisp_object_memory_usage_full):
Don't crash if passed a non-record object (int or char).
* alloc.c (tree_memory_usage_1):
* lrecord.h:
New function tree_memory_usage() to return the memory usage of
a tree of conses and/or vectors.
* lisp.h:
* lisp.h (PRIVATE_UNVERIFIED_LIST_LOOP_7):
Add SAFE_LIST_LOOP_* functions for looping over a list not known
to be correct or non-circular, but without signalling an error --
instead, just stop enumerating when an error detected.
* emacs.c (main_1):
* specifier.c:
* specifier.c (specifier_memory_usage):
* specifier.c (vars_of_specifier):
* symsinit.h:
Add memory usage info for specifiers.
author | Ben Wing <ben@xemacs.org> |
---|---|
date | Mon, 29 Mar 2010 22:47:55 -0500 |
parents | be6e5ea38dda |
children | 4cd28c29a7a1 |
files | src/ChangeLog src/alloc.c src/emacs.c src/lisp.h src/lrecord.h src/specifier.c src/symsinit.h |
diffstat | 7 files changed, 158 insertions(+), 13 deletions(-) [+] |
line wrap: on
line diff
--- a/src/ChangeLog Mon Mar 29 00:11:03 2010 -0500 +++ b/src/ChangeLog Mon Mar 29 22:47:55 2010 -0500 @@ -1,3 +1,29 @@ +2010-03-29 Ben Wing <ben@xemacs.org> + + * alloc.c: + * alloc.c (lisp_object_storage_size): + * alloc.c (Fobject_memory_usage): + * alloc.c (lisp_object_memory_usage_full): + Don't crash if passed a non-record object (int or char). + + * alloc.c (tree_memory_usage_1): + * lrecord.h: + New function tree_memory_usage() to return the memory usage of + a tree of conses and/or vectors. + + * lisp.h: + * lisp.h (PRIVATE_UNVERIFIED_LIST_LOOP_7): + Add SAFE_LIST_LOOP_* functions for looping over a list not known + to be correct or non-circular, but without signalling an error -- + instead, just stop enumerating when an error detected. + + * emacs.c (main_1): + * specifier.c: + * specifier.c (specifier_memory_usage): + * specifier.c (vars_of_specifier): + * symsinit.h: + Add memory usage info for specifiers. + 2010-03-28 Ben Wing <ben@xemacs.org> * window.c (find_window_mirror_internal):
--- a/src/alloc.c Mon Mar 29 00:11:03 2010 -0500 +++ b/src/alloc.c Mon Mar 29 22:47:55 2010 -0500 @@ -3679,14 +3679,19 @@ lisp_object_storage_size (Lisp_Object obj, struct usage_stats *ustats) { #ifndef NEW_GC - const struct lrecord_implementation *imp = - XRECORD_LHEADER_IMPLEMENTATION (obj); + const struct lrecord_implementation *imp; #endif /* not NEW_GC */ - Bytecount size = lisp_object_size (obj); + Bytecount size; + + if (!LRECORDP (obj)) + return 0; + + size = lisp_object_size (obj); #ifdef NEW_GC return mc_alloced_storage_size (size, ustats); #else + imp = XRECORD_LHEADER_IMPLEMENTATION (obj); if (imp->frob_block_p) { Bytecount overhead = @@ -4194,9 +4199,9 @@ Lisp_Object val = Qnil; Lisp_Object stats_list; - if (INTP (object) || CHARP (object)) - invalid_argument ("No memory associated with immediate objects (int or char)", - object); + if (!LRECORDP (object)) + invalid_argument + ("No memory associated with immediate objects (int or char)", object); stats_list = OBJECT_PROPERTY (object, memusage_stats_list); @@ -4269,17 +4274,18 @@ struct generic_usage_stats *stats) { Bytecount total; - struct lrecord_implementation *imp = XRECORD_LHEADER_IMPLEMENTATION (object); total = lisp_object_storage_size (object, NULL); if (storage_size) *storage_size = total; - if (HAS_OBJECT_METH_P (object, memory_usage)) + if (LRECORDP (object) && HAS_OBJECT_METH_P (object, memory_usage)) { int i; struct generic_usage_stats gustats; Bytecount sum; + struct lrecord_implementation *imp = + XRECORD_LHEADER_IMPLEMENTATION (object); xzero (gustats); OBJECT_METH (object, memory_usage, (object, &gustats)); @@ -4320,6 +4326,46 @@ return lisp_object_memory_usage_full (object, NULL, NULL, NULL, NULL); } +static Bytecount +tree_memory_usage_1 (Lisp_Object arg, int vectorp, int depth) +{ + Bytecount total = 0; + + if (depth > 200) + return total; + + if (CONSP (arg)) + { + SAFE_LIST_LOOP_3 (elt, arg, tail) + { + total += lisp_object_memory_usage (tail); + if (CONSP (elt) || VECTORP (elt)) + total += tree_memory_usage_1 (elt, vectorp, depth + 1); + if (VECTORP (XCDR (tail))) /* hack for (a b . [c d]) */ + total += tree_memory_usage_1 (XCDR (tail), vectorp, depth +1); + } + } + else if (VECTORP (arg) && vectorp) + { + int i = XVECTOR_LENGTH (arg); + int j; + total += lisp_object_memory_usage (arg); + for (j = 0; j < i; j++) + { + Lisp_Object elt = XVECTOR_DATA (arg) [j]; + if (CONSP (elt) || VECTORP (elt)) + total += tree_memory_usage_1 (elt, vectorp, depth + 1); + } + } + return total; +} + +Bytecount +tree_memory_usage (Lisp_Object arg, int vectorp) +{ + return tree_memory_usage_1 (arg, vectorp, 0); +} + #endif /* MEMORY_USAGE_STATS */ #ifdef ALLOC_TYPE_STATS
--- a/src/emacs.c Mon Mar 29 00:11:03 2010 -0500 +++ b/src/emacs.c Mon Mar 29 22:47:55 2010 -0500 @@ -1776,6 +1776,7 @@ #ifdef HAVE_SCROLLBARS scrollbar_objects_create (); #endif + specifier_objects_create (); #ifdef HAVE_GTK ui_gtk_objects_create (); #endif
--- a/src/lisp.h Mon Mar 29 00:11:03 2010 -0500 +++ b/src/lisp.h Mon Mar 29 22:47:55 2010 -0500 @@ -2119,21 +2119,46 @@ PRIVATE_EXTERNAL_LIST_LOOP_6 (elt, list, len, tail, \ tortoise_##elt, CIRCULAR_LIST_SUSPICION_LENGTH) - -#define PRIVATE_EXTERNAL_LIST_LOOP_6(elt, list, len, hare, \ - tortoise, suspicion_length) \ +#define PRIVATE_UNVERIFIED_LIST_LOOP_7(elt, list, len, hare, \ + tortoise, suspicion_length, \ + signalp) \ for (tortoise = hare = list, len = 0; \ \ (CONSP (hare) ? ((elt = XCAR (hare)), 1) : \ (NILP (hare) ? 0 : \ - (signal_malformed_list_error (list), 0))); \ + ((signalp ? signal_malformed_list_error (list) : 0), 0))); \ \ hare = XCDR (hare), \ (void) \ ((++len > suspicion_length) \ && \ ((((len & 1) != 0) && (tortoise = XCDR (tortoise), 0)), \ - (EQ (hare, tortoise) && (signal_circular_list_error (list), 0))))) + (EQ (hare, tortoise) && \ + ((signalp ? signal_circular_list_error (list) : 0), 0))))) + +#define PRIVATE_EXTERNAL_LIST_LOOP_6(elt, list, len, hare, \ + tortoise, suspicion_length) \ + PRIVATE_UNVERIFIED_LIST_LOOP_7 (elt, list, len, hare, tortoise, \ + suspicion_length, 1) + +#define PRIVATE_SAFE_LIST_LOOP_6(elt, list, len, hare, \ + tortoise, suspicion_length) \ + PRIVATE_UNVERIFIED_LIST_LOOP_7 (elt, list, len, hare, tortoise, \ + suspicion_length, 0) + +/* Similar to EXTERNAL_LIST_LOOP_2() but don't signal when an error + is detected, just stop. */ +#define SAFE_LIST_LOOP_2(elt, list) \ +Lisp_Object elt, hare_##elt, tortoise_##elt; \ +EMACS_INT len_##elt; \ +PRIVATE_SAFE_LIST_LOOP_6 (elt, list, len_##elt, hare_##elt, \ + tortoise_##elt, CIRCULAR_LIST_SUSPICION_LENGTH) + +#define SAFE_LIST_LOOP_3(elt, list, tail) \ +Lisp_Object elt, tail, tortoise_##elt; \ +EMACS_INT len_##elt; \ +PRIVATE_SAFE_LIST_LOOP_6 (elt, list, len_##elt, tail, \ + tortoise_##elt, CIRCULAR_LIST_SUSPICION_LENGTH) /* GET_LIST_LENGTH and GET_EXTERNAL_LIST_LENGTH:
--- a/src/lrecord.h Mon Mar 29 00:11:03 2010 -0500 +++ b/src/lrecord.h Mon Mar 29 22:47:55 2010 -0500 @@ -2085,6 +2085,7 @@ Bytecount *extra_lisp_storage, struct generic_usage_stats *stats); Bytecount lisp_object_memory_usage (Lisp_Object object); +Bytecount tree_memory_usage (Lisp_Object arg, int vectorp); void free_normal_lisp_object (Lisp_Object obj);
--- a/src/specifier.c Mon Mar 29 00:11:03 2010 -0500 +++ b/src/specifier.c Mon Mar 29 22:47:55 2010 -0500 @@ -3724,10 +3724,48 @@ return DISPLAYTABLE_SPECIFIERP (object) ? Qt : Qnil; } + + +#ifdef MEMORY_USAGE_STATS + +struct specifier_stats +{ + struct usage_stats u; + /* Ancillary Lisp */ + Bytecount global, device, frame, window, buffer, fallback; + Bytecount magic_parent; +}; + +static void +specifier_memory_usage (Lisp_Object specifier, + struct generic_usage_stats *gustats) +{ + struct specifier_stats *stats = (struct specifier_stats *) gustats; + Lisp_Specifier *spec = XSPECIFIER (specifier); + + stats->global = tree_memory_usage (spec->global_specs, 1); + stats->device = tree_memory_usage (spec->device_specs, 1); + stats->frame = tree_memory_usage (spec->frame_specs, 1); + stats->window = tree_memory_usage (spec->window_specs, 1); + stats->buffer = tree_memory_usage (spec->buffer_specs, 1); + stats->fallback = tree_memory_usage (spec->fallback, 1); + if (SPECIFIERP (spec->magic_parent)) + stats->magic_parent = lisp_object_memory_usage (spec->magic_parent); +} + +#endif /* MEMORY_USAGE_STATS */ /************************************************************************/ /* Initialization */ /************************************************************************/ + +void +specifier_objects_create (void) +{ +#ifdef MEMORY_USAGE_STATS + OBJECT_HAS_METHOD (specifier, memory_usage); +#endif +} void syms_of_specifier (void) @@ -3852,6 +3890,13 @@ void vars_of_specifier (void) { +#ifdef MEMORY_USAGE_STATS + OBJECT_HAS_PROPERTY (specifier, memusage_stats_list, + listu (Qt, Qglobal, Qdevice, Qframe, Qwindow, Qbuffer, + Qfallback, intern ("magic-parent"), + Qunbound)); +#endif /* MEMORY_USAGE_STATS */ + Vcached_specifiers = Qnil; staticpro (&Vcached_specifiers);
--- a/src/symsinit.h Mon Mar 29 00:11:03 2010 -0500 +++ b/src/symsinit.h Mon Mar 29 22:47:55 2010 -0500 @@ -218,6 +218,7 @@ void lstream_objects_create (void); void mule_charset_objects_create (void); void scrollbar_objects_create (void); +void specifier_objects_create (void); void ui_gtk_objects_create (void); void window_objects_create (void);