Mercurial > hg > xemacs-beta
diff src/alloc.c @ 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 | 71ee43b8a74d |
line wrap: on
line diff
--- 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