comparison 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
comparison
equal deleted inserted replaced
5172:be6e5ea38dda 5179:14fda1dbdb26
3677 3677
3678 Bytecount 3678 Bytecount
3679 lisp_object_storage_size (Lisp_Object obj, struct usage_stats *ustats) 3679 lisp_object_storage_size (Lisp_Object obj, struct usage_stats *ustats)
3680 { 3680 {
3681 #ifndef NEW_GC 3681 #ifndef NEW_GC
3682 const struct lrecord_implementation *imp = 3682 const struct lrecord_implementation *imp;
3683 XRECORD_LHEADER_IMPLEMENTATION (obj);
3684 #endif /* not NEW_GC */ 3683 #endif /* not NEW_GC */
3685 Bytecount size = lisp_object_size (obj); 3684 Bytecount size;
3685
3686 if (!LRECORDP (obj))
3687 return 0;
3688
3689 size = lisp_object_size (obj);
3686 3690
3687 #ifdef NEW_GC 3691 #ifdef NEW_GC
3688 return mc_alloced_storage_size (size, ustats); 3692 return mc_alloced_storage_size (size, ustats);
3689 #else 3693 #else
3694 imp = XRECORD_LHEADER_IMPLEMENTATION (obj);
3690 if (imp->frob_block_p) 3695 if (imp->frob_block_p)
3691 { 3696 {
3692 Bytecount overhead = 3697 Bytecount overhead =
3693 /* #### Always using cons_block is incorrect but close; only 3698 /* #### Always using cons_block is incorrect but close; only
3694 string_chars_block is significantly different in size, and 3699 string_chars_block is significantly different in size, and
4192 struct usage_stats object_stats; 4197 struct usage_stats object_stats;
4193 int i; 4198 int i;
4194 Lisp_Object val = Qnil; 4199 Lisp_Object val = Qnil;
4195 Lisp_Object stats_list; 4200 Lisp_Object stats_list;
4196 4201
4197 if (INTP (object) || CHARP (object)) 4202 if (!LRECORDP (object))
4198 invalid_argument ("No memory associated with immediate objects (int or char)", 4203 invalid_argument
4199 object); 4204 ("No memory associated with immediate objects (int or char)", object);
4200 4205
4201 stats_list = OBJECT_PROPERTY (object, memusage_stats_list); 4206 stats_list = OBJECT_PROPERTY (object, memusage_stats_list);
4202 4207
4203 xzero (object_stats); 4208 xzero (object_stats);
4204 lisp_object_storage_size (object, &object_stats); 4209 lisp_object_storage_size (object, &object_stats);
4267 Bytecount *extra_nonlisp_storage, 4272 Bytecount *extra_nonlisp_storage,
4268 Bytecount *extra_lisp_ancillary_storage, 4273 Bytecount *extra_lisp_ancillary_storage,
4269 struct generic_usage_stats *stats) 4274 struct generic_usage_stats *stats)
4270 { 4275 {
4271 Bytecount total; 4276 Bytecount total;
4272 struct lrecord_implementation *imp = XRECORD_LHEADER_IMPLEMENTATION (object);
4273 4277
4274 total = lisp_object_storage_size (object, NULL); 4278 total = lisp_object_storage_size (object, NULL);
4275 if (storage_size) 4279 if (storage_size)
4276 *storage_size = total; 4280 *storage_size = total;
4277 4281
4278 if (HAS_OBJECT_METH_P (object, memory_usage)) 4282 if (LRECORDP (object) && HAS_OBJECT_METH_P (object, memory_usage))
4279 { 4283 {
4280 int i; 4284 int i;
4281 struct generic_usage_stats gustats; 4285 struct generic_usage_stats gustats;
4282 Bytecount sum; 4286 Bytecount sum;
4287 struct lrecord_implementation *imp =
4288 XRECORD_LHEADER_IMPLEMENTATION (object);
4283 4289
4284 xzero (gustats); 4290 xzero (gustats);
4285 OBJECT_METH (object, memory_usage, (object, &gustats)); 4291 OBJECT_METH (object, memory_usage, (object, &gustats));
4286 4292
4287 if (stats) 4293 if (stats)
4316 4322
4317 Bytecount 4323 Bytecount
4318 lisp_object_memory_usage (Lisp_Object object) 4324 lisp_object_memory_usage (Lisp_Object object)
4319 { 4325 {
4320 return lisp_object_memory_usage_full (object, NULL, NULL, NULL, NULL); 4326 return lisp_object_memory_usage_full (object, NULL, NULL, NULL, NULL);
4327 }
4328
4329 static Bytecount
4330 tree_memory_usage_1 (Lisp_Object arg, int vectorp, int depth)
4331 {
4332 Bytecount total = 0;
4333
4334 if (depth > 200)
4335 return total;
4336
4337 if (CONSP (arg))
4338 {
4339 SAFE_LIST_LOOP_3 (elt, arg, tail)
4340 {
4341 total += lisp_object_memory_usage (tail);
4342 if (CONSP (elt) || VECTORP (elt))
4343 total += tree_memory_usage_1 (elt, vectorp, depth + 1);
4344 if (VECTORP (XCDR (tail))) /* hack for (a b . [c d]) */
4345 total += tree_memory_usage_1 (XCDR (tail), vectorp, depth +1);
4346 }
4347 }
4348 else if (VECTORP (arg) && vectorp)
4349 {
4350 int i = XVECTOR_LENGTH (arg);
4351 int j;
4352 total += lisp_object_memory_usage (arg);
4353 for (j = 0; j < i; j++)
4354 {
4355 Lisp_Object elt = XVECTOR_DATA (arg) [j];
4356 if (CONSP (elt) || VECTORP (elt))
4357 total += tree_memory_usage_1 (elt, vectorp, depth + 1);
4358 }
4359 }
4360 return total;
4361 }
4362
4363 Bytecount
4364 tree_memory_usage (Lisp_Object arg, int vectorp)
4365 {
4366 return tree_memory_usage_1 (arg, vectorp, 0);
4321 } 4367 }
4322 4368
4323 #endif /* MEMORY_USAGE_STATS */ 4369 #endif /* MEMORY_USAGE_STATS */
4324 4370
4325 #ifdef ALLOC_TYPE_STATS 4371 #ifdef ALLOC_TYPE_STATS