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);