diff src/alloc.c @ 5126:2a462149bd6a ben-lisp-object

merge
author Ben Wing <ben@xemacs.org>
date Wed, 24 Feb 2010 19:04:27 -0600
parents b5df3737028a 151d425f8ef0
children a9c41067dd88
line wrap: on
line diff
--- a/src/alloc.c	Wed Feb 24 01:58:04 2010 -0600
+++ b/src/alloc.c	Wed Feb 24 19:04:27 2010 -0600
@@ -1185,7 +1185,12 @@
   PUT_FIXED_TYPE_ON_FREE_LIST (type, structtype, FFT_ptr);	\
   MARK_LRECORD_AS_FREE (FFT_ptr);				\
 } while (0)
-
+#endif /* NEW_GC */
+
+#ifdef NEW_GC
+#define FREE_FIXED_TYPE_WHEN_NOT_IN_GC(lo, type, structtype, ptr)	\
+  free_lrecord (lo)
+#else /* not NEW_GC */
 /* Like FREE_FIXED_TYPE() but used when we are explicitly
    freeing a structure through free_cons(), free_marker(), etc.
    rather than through the normal process of sweeping.
@@ -1200,15 +1205,15 @@
    set, which is used for Purify and the like. */
 
 #ifndef ALLOC_NO_POOLS
-#define FREE_FIXED_TYPE_WHEN_NOT_IN_GC(type, structtype, ptr)	\
-do { FREE_FIXED_TYPE (type, structtype, ptr);			\
-     DECREMENT_CONS_COUNTER (sizeof (structtype));		\
-     gc_count_num_##type##_freelist++;				\
+#define FREE_FIXED_TYPE_WHEN_NOT_IN_GC(lo, type, structtype, ptr)	\
+do { FREE_FIXED_TYPE (type, structtype, ptr);				\
+     DECREMENT_CONS_COUNTER (sizeof (structtype));			\
+     gc_count_num_##type##_freelist++;					\
    } while (0)
 #else
-#define FREE_FIXED_TYPE_WHEN_NOT_IN_GC(type, structtype, ptr)
+#define FREE_FIXED_TYPE_WHEN_NOT_IN_GC(lo, type, structtype, ptr)
 #endif
-#endif /* NEW_GC */
+#endif /* (not) NEW_GC */
 
 #ifdef NEW_GC
 #define ALLOCATE_FIXED_TYPE_AND_SET_IMPL(type, lisp_type, var, lrec_ptr)\
@@ -3463,6 +3468,8 @@
   Dynarr_add (mcpro_names, varname);
 }
 
+const Ascbyte *mcpro_name (int count);
+
 /* External debugging function: Return the name of the variable at offset
    COUNT. */
 const Ascbyte *
@@ -3504,33 +3511,45 @@
   int instances_freed;
   int bytes_freed;
   int instances_on_free_list;
-} lcrecord_stats [countof (lrecord_implementations_table)];
-
-static void
-tick_lcrecord_stats (const struct lrecord_header *h, int free_p)
+  int bytes_on_free_list;
+} lrecord_stats [countof (lrecord_implementations_table)];
+
+void
+tick_lrecord_stats (const struct lrecord_header *h,
+		    enum lrecord_alloc_status status)
 {
   int type_index = h->type;
-
+  Bytecount sz = detagged_lisp_object_size (h);
+
+  switch (status)
+    {
+    case ALLOC_IN_USE:
+      lrecord_stats[type_index].instances_in_use++;
+      lrecord_stats[type_index].bytes_in_use += sz;
+      break;
+    case ALLOC_FREE:
+      lrecord_stats[type_index].instances_freed++;
+      lrecord_stats[type_index].bytes_freed += sz;
+      break;
+    case ALLOC_ON_FREE_LIST:
+      lrecord_stats[type_index].instances_on_free_list++;
+      lrecord_stats[type_index].bytes_on_free_list += sz;
+      break;
+    default:
+      ABORT ();
+    }
+}
+
+inline static void
+tick_lcrecord_stats (const struct lrecord_header *h, int free_p)
+{
   if (((struct old_lcrecord_header *) h)->free)
     {
       gc_checking_assert (!free_p);
-      lcrecord_stats[type_index].instances_on_free_list++;
+      tick_lrecord_stats (h, ALLOC_ON_FREE_LIST);
     }
   else
-    {
-      Bytecount sz = detagged_lisp_object_size (h);
-
-      if (free_p)
-	{
-	  lcrecord_stats[type_index].instances_freed++;
-	  lcrecord_stats[type_index].bytes_freed += sz;
-	}
-      else
-	{
-	  lcrecord_stats[type_index].instances_in_use++;
-	  lcrecord_stats[type_index].bytes_in_use += sz;
-	}
-    }
+    tick_lrecord_stats (h, free_p ? ALLOC_FREE : ALLOC_IN_USE);
 }
 #endif /* not NEW_GC */
 
@@ -3544,8 +3563,6 @@
   int num_used = 0;
   /* int total_size = 0; */
 
-  xzero (lcrecord_stats); /* Reset all statistics to 0. */
-
   /* First go through and call all the finalize methods.
      Then go through and free the objects.  There used to
      be only one loop here, with the call to the finalizer
@@ -3600,6 +3617,22 @@
 /* And the Lord said: Thou shalt use the `c-backslash-region' command
    to make macros prettier. */
 
+#define COUNT_FROB_BLOCK_USAGE(type)					\
+  EMACS_INT s = 0;							\
+  struct type##_block *x = current_##type##_block;			\
+  while (x) { s += sizeof (*x) + MALLOC_OVERHEAD; x = x->prev; }	\
+  DO_NOTHING
+
+#define COPY_INTO_LRECORD_STATS(type)				\
+do {								\
+  COUNT_FROB_BLOCK_USAGE (type);				\
+  lrecord_stats[lrecord_type_##type].bytes_in_use += s;		\
+  lrecord_stats[lrecord_type_##type].instances_on_free_list +=	\
+    gc_count_num_##type##_freelist;				\
+  lrecord_stats[lrecord_type_##type].instances_in_use +=	\
+    gc_count_num_##type##_in_use;				\
+} while (0)
+
 #ifdef ERROR_CHECK_GC
 
 #define SWEEP_FIXED_TYPE_BLOCK_1(typename, obj_type, lheader)		\
@@ -3644,86 +3677,88 @@
 									\
   gc_count_num_##typename##_in_use = num_used;				\
   gc_count_num_##typename##_freelist = num_free;			\
+  COPY_INTO_LRECORD_STATS (typename);					\
 } while (0)
 
 #else /* !ERROR_CHECK_GC */
 
-#define SWEEP_FIXED_TYPE_BLOCK_1(typename, obj_type, lheader)		     \
-do {									     \
-  struct typename##_block *SFTB_current;				     \
-  struct typename##_block **SFTB_prev;					     \
-  int SFTB_limit;							     \
-  int num_free = 0, num_used = 0;					     \
-									     \
-  typename##_free_list = 0;						     \
-									     \
-  for (SFTB_prev = &current_##typename##_block,				     \
-       SFTB_current = current_##typename##_block,			     \
-       SFTB_limit = current_##typename##_block_index;			     \
-       SFTB_current;							     \
-       )								     \
-    {									     \
-      int SFTB_iii;							     \
-      int SFTB_empty = 1;						     \
-      Lisp_Free *SFTB_old_free_list = typename##_free_list;		     \
-									     \
-      for (SFTB_iii = 0; SFTB_iii < SFTB_limit; SFTB_iii++)		     \
-	{								     \
-	  obj_type *SFTB_victim = &(SFTB_current->block[SFTB_iii]);	     \
-									     \
-	  if (LRECORD_FREE_P (SFTB_victim))				     \
-	    {								     \
-	      num_free++;						     \
+#define SWEEP_FIXED_TYPE_BLOCK_1(typename, obj_type, lheader)		\
+do {									\
+  struct typename##_block *SFTB_current;				\
+  struct typename##_block **SFTB_prev;					\
+  int SFTB_limit;							\
+  int num_free = 0, num_used = 0;					\
+									\
+  typename##_free_list = 0;						\
+									\
+  for (SFTB_prev = &current_##typename##_block,				\
+       SFTB_current = current_##typename##_block,			\
+       SFTB_limit = current_##typename##_block_index;			\
+       SFTB_current;							\
+       )								\
+    {									\
+      int SFTB_iii;							\
+      int SFTB_empty = 1;						\
+      Lisp_Free *SFTB_old_free_list = typename##_free_list;		\
+									\
+      for (SFTB_iii = 0; SFTB_iii < SFTB_limit; SFTB_iii++)		\
+	{								\
+	  obj_type *SFTB_victim = &(SFTB_current->block[SFTB_iii]);	\
+									\
+	  if (LRECORD_FREE_P (SFTB_victim))				\
+	    {								\
+	      num_free++;						\
 	      PUT_FIXED_TYPE_ON_FREE_LIST (typename, obj_type, SFTB_victim); \
-	    }								     \
-	  else if (C_READONLY_RECORD_HEADER_P (&SFTB_victim->lheader))	     \
-	    {								     \
-	      SFTB_empty = 0;						     \
-	      num_used++;						     \
-	    }								     \
-	  else if (! MARKED_RECORD_HEADER_P (&SFTB_victim->lheader))	     \
-	    {								     \
-	      num_free++;						     \
-	      FREE_FIXED_TYPE (typename, obj_type, SFTB_victim);	     \
-	    }								     \
-	  else								     \
-	    {								     \
-	      SFTB_empty = 0;						     \
-	      num_used++;						     \
-	      UNMARK_##typename (SFTB_victim);				     \
-	    }								     \
-	}								     \
-      if (!SFTB_empty)							     \
-	{								     \
-	  SFTB_prev = &(SFTB_current->prev);				     \
-	  SFTB_current = SFTB_current->prev;				     \
-	}								     \
-      else if (SFTB_current == current_##typename##_block		     \
-	       && !SFTB_current->prev)					     \
-	{								     \
-	  /* No real point in freeing sole allocation block */		     \
-	  break;							     \
-	}								     \
-      else								     \
-	{								     \
-	  struct typename##_block *SFTB_victim_block = SFTB_current;	     \
-	  if (SFTB_victim_block == current_##typename##_block)		     \
-	    current_##typename##_block_index				     \
-	      = countof (current_##typename##_block->block);		     \
-	  SFTB_current = SFTB_current->prev;				     \
-	  {								     \
-	    *SFTB_prev = SFTB_current;					     \
-	    xfree (SFTB_victim_block);	     \
-	    /* Restore free list to what it was before victim was swept */   \
-	    typename##_free_list = SFTB_old_free_list;			     \
-	    num_free -= SFTB_limit;					     \
-	  }								     \
-	}								     \
-      SFTB_limit = countof (current_##typename##_block->block);		     \
-    }									     \
-									     \
-  gc_count_num_##typename##_in_use = num_used;				     \
-  gc_count_num_##typename##_freelist = num_free;			     \
+	    }								\
+	  else if (C_READONLY_RECORD_HEADER_P (&SFTB_victim->lheader))	\
+	    {								\
+	      SFTB_empty = 0;						\
+	      num_used++;						\
+	    }								\
+	  else if (! MARKED_RECORD_HEADER_P (&SFTB_victim->lheader))	\
+	    {								\
+	      num_free++;						\
+	      FREE_FIXED_TYPE (typename, obj_type, SFTB_victim);	\
+	    }								\
+	  else								\
+	    {								\
+	      SFTB_empty = 0;						\
+	      num_used++;						\
+	      UNMARK_##typename (SFTB_victim);				\
+	    }								\
+	}								\
+      if (!SFTB_empty)							\
+	{								\
+	  SFTB_prev = &(SFTB_current->prev);				\
+	  SFTB_current = SFTB_current->prev;				\
+	}								\
+      else if (SFTB_current == current_##typename##_block		\
+	       && !SFTB_current->prev)					\
+	{								\
+	  /* No real point in freeing sole allocation block */		\
+	  break;							\
+	}								\
+      else								\
+	{								\
+	  struct typename##_block *SFTB_victim_block = SFTB_current;	\
+	  if (SFTB_victim_block == current_##typename##_block)		\
+	    current_##typename##_block_index				\
+	      = countof (current_##typename##_block->block);		\
+	  SFTB_current = SFTB_current->prev;				\
+	  {								\
+	    *SFTB_prev = SFTB_current;					\
+	    xfree (SFTB_victim_block);					\
+	    /* Restore free list to what it was before victim was swept */ \
+	    typename##_free_list = SFTB_old_free_list;			\
+	    num_free -= SFTB_limit;					\
+	  }								\
+	}								\
+      SFTB_limit = countof (current_##typename##_block->block);		\
+    }									\
+									\
+  gc_count_num_##typename##_in_use = num_used;				\
+  gc_count_num_##typename##_freelist = num_free;			\
+  COPY_INTO_LRECORD_STATS (typename);					\
 } while (0)
 
 #endif /* !ERROR_CHECK_GC */
@@ -3771,11 +3806,7 @@
     ASSERT_VALID_POINTER (XPNTR (cons_car (ptr)));
 #endif /* ERROR_CHECK_GC */
 
-#ifdef NEW_GC
-  free_lrecord (cons);
-#else /* not NEW_GC */
-  FREE_FIXED_TYPE_WHEN_NOT_IN_GC (cons, Lisp_Cons, ptr);
-#endif /* not NEW_GC */
+  FREE_FIXED_TYPE_WHEN_NOT_IN_GC (cons, cons, Lisp_Cons, ptr);
 }
 
 /* explicitly free a list.  You **must make sure** that you have
@@ -3910,11 +3941,8 @@
 void
 free_key_data (Lisp_Object ptr)
 {
-#ifdef NEW_GC
-  free_lrecord (ptr);
-#else /* not NEW_GC */
-  FREE_FIXED_TYPE_WHEN_NOT_IN_GC (key_data, Lisp_Key_Data, XKEY_DATA (ptr));
-#endif /* not NEW_GC */
+  FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, key_data, Lisp_Key_Data,
+				  XKEY_DATA (ptr));
 }
 
 #ifndef NEW_GC
@@ -3931,11 +3959,8 @@
 void
 free_button_data (Lisp_Object ptr)
 {
-#ifdef NEW_GC
-  free_lrecord (ptr);
-#else /* not NEW_GC */
-  FREE_FIXED_TYPE_WHEN_NOT_IN_GC (button_data, Lisp_Button_Data, XBUTTON_DATA (ptr));
-#endif /* not NEW_GC */
+  FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, button_data, Lisp_Button_Data,
+				  XBUTTON_DATA (ptr));
 }
 
 #ifndef NEW_GC
@@ -3952,11 +3977,8 @@
 void
 free_motion_data (Lisp_Object ptr)
 {
-#ifdef NEW_GC
-  free_lrecord (ptr);
-#else /* not NEW_GC */
-  FREE_FIXED_TYPE_WHEN_NOT_IN_GC (motion_data, Lisp_Motion_Data, XMOTION_DATA (ptr));
-#endif /* not NEW_GC */
+  FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, motion_data, Lisp_Motion_Data,
+				  XMOTION_DATA (ptr));
 }
 
 #ifndef NEW_GC
@@ -3973,11 +3995,8 @@
 void
 free_process_data (Lisp_Object ptr)
 {
-#ifdef NEW_GC
-  free_lrecord (ptr);
-#else /* not NEW_GC */
-  FREE_FIXED_TYPE_WHEN_NOT_IN_GC (process_data, Lisp_Process_Data, XPROCESS_DATA (ptr));
-#endif /* not NEW_GC */
+  FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, process_data, Lisp_Process_Data,
+				  XPROCESS_DATA (ptr));
 }
 
 #ifndef NEW_GC
@@ -3994,11 +4013,8 @@
 void
 free_timeout_data (Lisp_Object ptr)
 {
-#ifdef NEW_GC
-  free_lrecord (ptr);
-#else /* not NEW_GC */
-  FREE_FIXED_TYPE_WHEN_NOT_IN_GC (timeout_data, Lisp_Timeout_Data, XTIMEOUT_DATA (ptr));
-#endif /* not NEW_GC */
+  FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, timeout_data, Lisp_Timeout_Data,
+				  XTIMEOUT_DATA (ptr));
 }
 
 #ifndef NEW_GC
@@ -4015,11 +4031,8 @@
 void
 free_magic_data (Lisp_Object ptr)
 {
-#ifdef NEW_GC
-  free_lrecord (ptr);
-#else /* not NEW_GC */
-  FREE_FIXED_TYPE_WHEN_NOT_IN_GC (magic_data, Lisp_Magic_Data, XMAGIC_DATA (ptr));
-#endif /* not NEW_GC */
+  FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, magic_data, Lisp_Magic_Data,
+				  XMAGIC_DATA (ptr));
 }
 
 #ifndef NEW_GC
@@ -4036,11 +4049,8 @@
 void
 free_magic_eval_data (Lisp_Object ptr)
 {
-#ifdef NEW_GC
-  free_lrecord (ptr);
-#else /* not NEW_GC */
-  FREE_FIXED_TYPE_WHEN_NOT_IN_GC (magic_eval_data, Lisp_Magic_Eval_Data, XMAGIC_EVAL_DATA (ptr));
-#endif /* not NEW_GC */
+  FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, magic_eval_data, Lisp_Magic_Eval_Data,
+				  XMAGIC_EVAL_DATA (ptr));
 }
 
 #ifndef NEW_GC
@@ -4057,11 +4067,8 @@
 void
 free_eval_data (Lisp_Object ptr)
 {
-#ifdef NEW_GC
-  free_lrecord (ptr);
-#else /* not NEW_GC */
-  FREE_FIXED_TYPE_WHEN_NOT_IN_GC (eval_data, Lisp_Eval_Data, XEVAL_DATA (ptr));
-#endif /* not NEW_GC */
+  FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, eval_data, Lisp_Eval_Data,
+				  XEVAL_DATA (ptr));
 }
 
 #ifndef NEW_GC
@@ -4078,11 +4085,8 @@
 void
 free_misc_user_data (Lisp_Object ptr)
 {
-#ifdef NEW_GC
-  free_lrecord (ptr);
-#else /* not NEW_GC */
-  FREE_FIXED_TYPE_WHEN_NOT_IN_GC (misc_user_data, Lisp_Misc_User_Data, XMISC_USER_DATA (ptr));
-#endif /* not NEW_GC */
+  FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, misc_user_data, Lisp_Misc_User_Data,
+				  XMISC_USER_DATA (ptr));
 }
 
 #endif /* EVENT_DATA_AS_OBJECTS */
@@ -4106,11 +4110,7 @@
 void
 free_marker (Lisp_Object ptr)
 {
-#ifdef NEW_GC
-  free_lrecord (ptr);
-#else /* not NEW_GC */
-  FREE_FIXED_TYPE_WHEN_NOT_IN_GC (marker, Lisp_Marker, XMARKER (ptr));
-#endif /* not NEW_GC */
+  FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, marker, Lisp_Marker, XMARKER (ptr));
 }
 
 
@@ -4327,6 +4327,10 @@
 void
 gc_sweep_1 (void)
 {
+  /* Reset all statistics to 0.  They will be incremented when
+     sweeping lcrecords, frob-block lrecords and dumped objects. */
+  xzero (lrecord_stats);
+
   /* Free all unmarked records.  Do this at the very beginning,
      before anything else, so that the finalize methods can safely
      examine items in the objects.  sweep_lcrecords_1() makes
@@ -4489,6 +4493,60 @@
   return cons3 (intern (name), make_int (value), tail);
 }
 
+/* Pluralize a lowercase English word stored in BUF, assuming BUF has
+   enough space to hold the extra letters (at most 2). */
+static void
+pluralize_word (Ascbyte *buf)
+{
+  Bytecount len = strlen (buf);
+  int upper = 0;
+  Ascbyte d, e;
+
+  if (len == 0 || len == 1)
+    goto pluralize_apostrophe_s;
+  e = buf[len - 1];
+  d = buf[len - 2];
+  upper = isupper (e);
+  e = tolower (e);
+  d = tolower (d);
+  if (e == 'y')
+    {
+      switch (d)
+	{
+	case 'a':
+	case 'e':
+	case 'i':
+	case 'o':
+	case 'u':
+	  goto pluralize_s;
+	default:
+	  buf[len - 1] = (upper ? 'I' : 'i');
+	  goto pluralize_es;
+	}
+    }
+  else if (e == 's' || e == 'x' || (e == 'h' && (d == 's' || d == 'c')))
+    {
+      pluralize_es:
+      buf[len++] = (upper ? 'E' : 'e');
+    }
+  pluralize_s:
+  buf[len++] = (upper ? 'S' : 's');
+  buf[len] = '\0';
+  return;
+
+  pluralize_apostrophe_s:
+  buf[len++] = '\'';
+  goto pluralize_s;
+}
+
+static void
+pluralize_and_append (Ascbyte *buf, const Ascbyte *name, const Ascbyte *suffix)
+{
+  strcpy (buf, name);
+  pluralize_word (buf);
+  strcat (buf, suffix);
+}
+
 static Lisp_Object
 object_memory_usage_stats (int set_total_gc_usage)
 {
@@ -4504,7 +4562,6 @@
         {
           Ascbyte buf[255];
           const Ascbyte *name = lrecord_implementations_table[i]->name;
-	  int len = strlen (name);
 
 	  if (lrecord_stats[i].bytes_in_use_including_overhead != 
 	      lrecord_stats[i].bytes_in_use)
@@ -4521,87 +4578,70 @@
 			      lrecord_stats[i].bytes_in_use,
 			      pl);
 	  tgu_val += lrecord_stats[i].bytes_in_use_including_overhead;
-	  
-	  if (name[len-1] == 's')
-	    sprintf (buf, "%ses-used", name);
-	  else
-	    sprintf (buf, "%ss-used", name);
+
+	  pluralize_and_append (buf, name, "-used");
 	  pl = gc_plist_hack (buf, lrecord_stats[i].instances_in_use, pl);
         }
     }
 
 #else /* not NEW_GC */
 
-#define HACK_O_MATIC(type, name, pl) do {				\
-  EMACS_INT s = 0;							\
-  struct type##_block *x = current_##type##_block;			\
-  while (x) { s += sizeof (*x) + MALLOC_OVERHEAD; x = x->prev; }	\
-  tgu_val += s;							\
-  (pl) = gc_plist_hack ((name), s, (pl));				\
+#define HACK_O_MATIC(type, name, pl)		\
+do {						\
+  COUNT_FROB_BLOCK_USAGE (type);		\
+  tgu_val += s;					\
+  (pl) = gc_plist_hack ((name), s, (pl));	\
+} while (0)
+
+#define FROB(type)				\
+do {						\
+  COUNT_FROB_BLOCK_USAGE (type);		\
+  tgu_val += s;					\
 } while (0)
 
+  FROB (extent);
+  FROB (event);
+  FROB (marker);
+  FROB (float);
+#ifdef HAVE_BIGNUM
+  FROB (bignum);
+#endif /* HAVE_BIGNUM */
+#ifdef HAVE_RATIO
+  FROB (ratio);
+#endif /* HAVE_RATIO */
+#ifdef HAVE_BIGFLOAT
+  FROB (bigfloat);
+#endif /* HAVE_BIGFLOAT */
+  FROB (compiled_function);
+  FROB (symbol);
+  FROB (cons);
+
+#undef FROB
+
   for (i = 0; i < lrecord_type_count; i++)
     {
-      if (lcrecord_stats[i].bytes_in_use != 0
-          || lcrecord_stats[i].bytes_freed != 0
-	  || lcrecord_stats[i].instances_on_free_list != 0)
+      if (lrecord_stats[i].bytes_in_use != 0
+          || lrecord_stats[i].bytes_freed != 0
+	  || lrecord_stats[i].instances_on_free_list != 0)
         {
           Ascbyte buf[255];
           const Ascbyte *name = lrecord_implementations_table[i]->name;
-	  int len = strlen (name);
 
           sprintf (buf, "%s-storage", name);
-          pl = gc_plist_hack (buf, lcrecord_stats[i].bytes_in_use, pl);
-	  tgu_val += lcrecord_stats[i].bytes_in_use;
-	  /* Okay, simple pluralization check for `symbol-value-varalias' */
-	  if (name[len-1] == 's')
-	    sprintf (buf, "%ses-freed", name);
-	  else
-	    sprintf (buf, "%ss-freed", name);
-          if (lcrecord_stats[i].instances_freed != 0)
-            pl = gc_plist_hack (buf, lcrecord_stats[i].instances_freed, pl);
-	  if (name[len-1] == 's')
-	    sprintf (buf, "%ses-on-free-list", name);
-	  else
-	    sprintf (buf, "%ss-on-free-list", name);
-          if (lcrecord_stats[i].instances_on_free_list != 0)
-            pl = gc_plist_hack (buf, lcrecord_stats[i].instances_on_free_list,
+          pl = gc_plist_hack (buf, lrecord_stats[i].bytes_in_use, pl);
+	  tgu_val += lrecord_stats[i].bytes_in_use;
+	  pluralize_and_append (buf, name, "-freed");
+          if (lrecord_stats[i].instances_freed != 0)
+            pl = gc_plist_hack (buf, lrecord_stats[i].instances_freed, pl);
+	  pluralize_and_append (buf, name, "-on-free-list");
+          if (lrecord_stats[i].instances_on_free_list != 0)
+            pl = gc_plist_hack (buf, lrecord_stats[i].instances_on_free_list,
 				pl);
-	  if (name[len-1] == 's')
-	    sprintf (buf, "%ses-used", name);
-	  else
-	    sprintf (buf, "%ss-used", name);
-          pl = gc_plist_hack (buf, lcrecord_stats[i].instances_in_use, pl);
+	  pluralize_and_append (buf, name, "-used");
+          pl = gc_plist_hack (buf, lrecord_stats[i].instances_in_use, pl);
         }
     }
 
-  HACK_O_MATIC (extent, "extent-storage", pl);
-  pl = gc_plist_hack ("extents-free", gc_count_num_extent_freelist, pl);
-  pl = gc_plist_hack ("extents-used", gc_count_num_extent_in_use, pl);
-  HACK_O_MATIC (event, "event-storage", pl);
-  pl = gc_plist_hack ("events-free", gc_count_num_event_freelist, pl);
-  pl = gc_plist_hack ("events-used", gc_count_num_event_in_use, pl);
-  HACK_O_MATIC (marker, "marker-storage", pl);
-  pl = gc_plist_hack ("markers-free", gc_count_num_marker_freelist, pl);
-  pl = gc_plist_hack ("markers-used", gc_count_num_marker_in_use, pl);
-  HACK_O_MATIC (float, "float-storage", pl);
-  pl = gc_plist_hack ("floats-free", gc_count_num_float_freelist, pl);
-  pl = gc_plist_hack ("floats-used", gc_count_num_float_in_use, pl);
-#ifdef HAVE_BIGNUM
-  HACK_O_MATIC (bignum, "bignum-storage", pl);
-  pl = gc_plist_hack ("bignums-free", gc_count_num_bignum_freelist, pl);
-  pl = gc_plist_hack ("bignums-used", gc_count_num_bignum_in_use, pl);
-#endif /* HAVE_BIGNUM */
-#ifdef HAVE_RATIO
-  HACK_O_MATIC (ratio, "ratio-storage", pl);
-  pl = gc_plist_hack ("ratios-free", gc_count_num_ratio_freelist, pl);
-  pl = gc_plist_hack ("ratios-used", gc_count_num_ratio_in_use, pl);
-#endif /* HAVE_RATIO */
-#ifdef HAVE_BIGFLOAT
-  HACK_O_MATIC (bigfloat, "bigfloat-storage", pl);
-  pl = gc_plist_hack ("bigfloats-free", gc_count_num_bigfloat_freelist, pl);
-  pl = gc_plist_hack ("bigfloats-used", gc_count_num_bigfloat_in_use, pl);
-#endif /* HAVE_BIGFLOAT */
   HACK_O_MATIC (string, "string-header-storage", pl);
   pl = gc_plist_hack ("long-strings-total-length",
                       gc_count_string_total_size
@@ -4616,20 +4656,6 @@
   pl = gc_plist_hack ("short-strings-used",
                       gc_count_num_short_string_in_use, pl);
 
-  HACK_O_MATIC (compiled_function, "compiled-function-storage", pl);
-  pl = gc_plist_hack ("compiled-functions-free",
-		      gc_count_num_compiled_function_freelist, pl);
-  pl = gc_plist_hack ("compiled-functions-used",
-		      gc_count_num_compiled_function_in_use, pl);
-
-  HACK_O_MATIC (symbol, "symbol-storage", pl);
-  pl = gc_plist_hack ("symbols-free", gc_count_num_symbol_freelist, pl);
-  pl = gc_plist_hack ("symbols-used", gc_count_num_symbol_in_use, pl);
-
-  HACK_O_MATIC (cons, "cons-storage", pl);
-  pl = gc_plist_hack ("conses-free", gc_count_num_cons_freelist, pl);
-  pl = gc_plist_hack ("conses-used", gc_count_num_cons_in_use, pl);
-
 #undef HACK_O_MATIC
 
 #endif /* NEW_GC */
@@ -4706,8 +4732,9 @@
 	   Fcons (make_int (gc_count_num_marker_in_use),
 		  make_int (gc_count_num_marker_freelist)),
 	   make_int (gc_count_string_total_size),
-	   make_int (lcrecord_stats[lrecord_type_vector].bytes_in_use +
-		     lcrecord_stats[lrecord_type_vector].bytes_freed),
+	   make_int (lrecord_stats[lrecord_type_vector].bytes_in_use +
+		     lrecord_stats[lrecord_type_vector].bytes_freed +
+		     lrecord_stats[lrecord_type_vector].bytes_on_free_list),
 	   object_memory_usage_stats (1));
 #endif /* not NEW_GC */
 #else /* not ALLOC_TYPE_STATS */