commit: fix various problems with allocation statistics, track overhead properly
Ben Wing
ben at xemacs.org
Sat Mar 20 21:22:49 EDT 2010
changeset: 5160:ab9ee10a53e4
user: Ben Wing <ben at xemacs.org>
date: Sat Mar 20 20:20:30 2010 -0500
files: lisp/ChangeLog lisp/diagnose.el src/ChangeLog src/alloc.c src/emacs.c src/lisp.h src/lrecord.h src/marker.c
description:
fix various problems with allocation statistics, track overhead properly
-------------------- ChangeLog entries follow: --------------------
lisp/ChangeLog addition:
2010-03-20 Ben Wing <ben at xemacs.org>
* diagnose.el (show-memory-usage):
* diagnose.el (show-object-memory-usage-stats):
Further changes to correspond with changes in the C code;
add an additional column showing the overhead used with each type,
and add it into the grand total memory usage.
src/ChangeLog addition:
2010-03-20 Ben Wing <ben at xemacs.org>
* alloc.c:
* alloc.c (init_lrecord_stats):
* alloc.c (free_normal_lisp_object):
* alloc.c (struct):
* alloc.c (clear_lrecord_stats):
* alloc.c (tick_lrecord_stats):
* alloc.c (COUNT_FROB_BLOCK_USAGE):
* alloc.c (COPY_INTO_LRECORD_STATS):
* alloc.c (sweep_strings):
* alloc.c (UNMARK_string):
* alloc.c (gc_sweep_1):
* alloc.c (finish_object_memory_usage_stats):
* alloc.c (object_memory_usage_stats):
* alloc.c (object_dead_p):
* alloc.c (fixed_type_block_overhead):
* alloc.c (lisp_object_storage_size):
* emacs.c (main_1):
* lisp.h:
* lrecord.h:
Export lisp_object_storage_size() and malloced_storage_size() even
when not MEMORY_USAGE_STATS, to get the non-MEMORY_USAGE_STATS
build to compile.
Don't export fixed_type_block_overhead() any more.
Some code cleanup, rearrangement, add some section headers.
Clean up various bugs especially involving computation of overhead
and double-counting certain usage in total_gc_usage. Add
statistics computing the overhead used by all types. Don't add a
special entry for string headers in the object-memory-usage-stats
because it's already present as just "string". But do count the
overhead used by long strings. Don't try to call the
memory_usage() methods when NEW_GC because there's nowhere obvious
in the sweep stage to make the calls.
* marker.c (compute_buffer_marker_usage):
Just use lisp_object_storage_size() rather than trying to
reimplement it.
diff -r cb303ff63e76 -r ab9ee10a53e4 lisp/ChangeLog
--- a/lisp/ChangeLog Fri Mar 19 17:02:11 2010 -0500
+++ b/lisp/ChangeLog Sat Mar 20 20:20:30 2010 -0500
@@ -1,3 +1,11 @@
+2010-03-20 Ben Wing <ben at xemacs.org>
+
+ * diagnose.el (show-memory-usage):
+ * diagnose.el (show-object-memory-usage-stats):
+ Further changes to correspond with changes in the C code;
+ add an additional column showing the overhead used with each type,
+ and add it into the grand total memory usage.
+
2010-03-19 Ben Wing <ben at xemacs.org>
* diagnose.el (show-object-memory-usage-stats):
diff -r cb303ff63e76 -r ab9ee10a53e4 lisp/diagnose.el
--- a/lisp/diagnose.el Fri Mar 19 17:02:11 2010 -0500
+++ b/lisp/diagnose.el Sat Mar 20 20:20:30 2010 -0500
@@ -159,9 +159,7 @@
(princ (format fmt
(match-string 1 (symbol-name stat))
num)))
- (when (eq stat 'long-strings-total-length)
- (incf total num)
- (princ (format fmt stat num))))
+ )
(sixth (garbage-collect)))
(princ "\n")
(princ (format fmt "total" total))
@@ -186,77 +184,83 @@
(garbage-collect)
(let ((buffer "*object memory usage statistics*")
(plist (object-memory-usage-stats))
- (fmt "%-30s%10s%10s%18s\n")
+ (fmt "%-30s%10s%10s%10s%18s\n")
(grandtotal 0)
begin)
(flet ((show-stats (match-string)
- (princ (format fmt "object" "count" "storage" "non-Lisp storage"))
- (princ (make-string 68 ?-))
+ (princ (format fmt "object" "count" "storage" "overhead"
+ "non-Lisp storage"))
+ (princ (make-string 78 ?-))
(princ "\n")
(let ((total-use 0)
(total-non-lisp-use 0)
(total-use-overhead 0)
+ (total-use-with-overhead 0)
(total-count 0))
(map-plist
#'(lambda (stat num)
- (when (and (string-match match-string
- (symbol-name stat))
- (let ((match (match-string
- 1 (symbol-name stat))))
- (or (< (length match) 9)
- (not (equal (substring match -9)
- "-non-lisp")))))
- (let ((storage-use num)
- (storage-use-overhead
- (plist-get
- plist
- (intern (concat (match-string 1 (symbol-name stat))
- "-storage-including-overhead"))))
- (non-lisp-storage
- (or (plist-get
- plist
- (intern (concat (match-string 1
- (symbol-name stat))
- "-non-lisp-storage")))
- 0))
-
- (storage-count
- (or (loop for str in '("s-used" "es-used" "-used")
- for val = (plist-get
- plist
- (intern
- (concat (match-string
- 1 (symbol-name stat))
- str)))
- if val
- return val)
- (plist-get
- plist
- (intern
- (concat (substring
- (match-string 1 (symbol-name stat))
- 0 -1)
- "ies-used")))
- )))
- (incf total-use storage-use)
- (incf total-use-overhead (if storage-use-overhead
- storage-use-overhead
- storage-use))
- (incf total-non-lisp-use non-lisp-storage)
- (incf total-count (or storage-count 0))
- (and (> storage-use 0)
- (princ (format fmt
- (match-string 1 (symbol-name stat))
- (or storage-count "unknown")
- storage-use
- non-lisp-storage))))))
+ (let ((symmatch
+ (and (string-match match-string (symbol-name stat))
+ (match-string 1 (symbol-name stat)))))
+ (when (and symmatch (or (< (length symmatch) 9)
+ (not (equal (substring symmatch -9)
+ "-non-lisp"))))
+ (let* ((storage-use num)
+ (storage-use-overhead
+ (or (plist-get
+ plist
+ (intern (concat symmatch
+ "-storage-overhead")))
+ 0))
+ (storage-use-with-overhead
+ (or (plist-get
+ plist
+ (intern (concat
+ symmatch
+ "-storage-including-overhead")))
+ (+ storage-use storage-use-overhead)))
+ (storage-use-overhead
+ (- storage-use-with-overhead storage-use))
+ (non-lisp-storage
+ (or (plist-get
+ plist
+ (intern (concat symmatch
+ "-non-lisp-storage")))
+ 0))
+ (storage-count
+ (or (loop for str in '("s-used" "es-used" "-used")
+ for val = (plist-get
+ plist
+ (intern
+ (concat symmatch str)))
+ if val
+ return val)
+ (plist-get
+ plist
+ (intern
+ (concat (substring symmatch 0 -1)
+ "ies-used")))
+ )))
+ (incf total-use storage-use)
+ (incf total-use-overhead storage-use-overhead)
+ (incf total-use-with-overhead storage-use-with-overhead)
+ (incf total-non-lisp-use non-lisp-storage)
+ (incf total-count (or storage-count 0))
+ (and (> storage-use-with-overhead 0)
+ (princ (format fmt symmatch
+ (or storage-count "unknown")
+ storage-use
+ storage-use-overhead
+ non-lisp-storage)))))))
plist)
(princ "\n")
(princ (format fmt "total"
- total-count total-use-overhead total-non-lisp-use))
- (incf grandtotal total-use-overhead)
+ total-count total-use total-use-overhead
+ total-non-lisp-use))
+ (incf grandtotal total-use-with-overhead)
+ (incf grandtotal total-non-lisp-use)
(when-fboundp #'sort-numeric-fields
- (sort-numeric-fields -2
+ (sort-numeric-fields -3
(save-excursion
(goto-char begin)
(forward-line 3)
diff -r cb303ff63e76 -r ab9ee10a53e4 src/ChangeLog
--- a/src/ChangeLog Fri Mar 19 17:02:11 2010 -0500
+++ b/src/ChangeLog Sat Mar 20 20:20:30 2010 -0500
@@ -1,3 +1,45 @@
+2010-03-20 Ben Wing <ben at xemacs.org>
+
+ * alloc.c:
+ * alloc.c (init_lrecord_stats):
+ * alloc.c (free_normal_lisp_object):
+ * alloc.c (struct):
+ * alloc.c (clear_lrecord_stats):
+ * alloc.c (tick_lrecord_stats):
+ * alloc.c (COUNT_FROB_BLOCK_USAGE):
+ * alloc.c (COPY_INTO_LRECORD_STATS):
+ * alloc.c (sweep_strings):
+ * alloc.c (UNMARK_string):
+ * alloc.c (gc_sweep_1):
+ * alloc.c (finish_object_memory_usage_stats):
+ * alloc.c (object_memory_usage_stats):
+ * alloc.c (object_dead_p):
+ * alloc.c (fixed_type_block_overhead):
+ * alloc.c (lisp_object_storage_size):
+ * emacs.c (main_1):
+ * lisp.h:
+ * lrecord.h:
+ Export lisp_object_storage_size() and malloced_storage_size() even
+ when not MEMORY_USAGE_STATS, to get the non-MEMORY_USAGE_STATS
+ build to compile.
+
+ Don't export fixed_type_block_overhead() any more.
+
+ Some code cleanup, rearrangement, add some section headers.
+
+ Clean up various bugs especially involving computation of overhead
+ and double-counting certain usage in total_gc_usage. Add
+ statistics computing the overhead used by all types. Don't add a
+ special entry for string headers in the object-memory-usage-stats
+ because it's already present as just "string". But do count the
+ overhead used by long strings. Don't try to call the
+ memory_usage() methods when NEW_GC because there's nowhere obvious
+ in the sweep stage to make the calls.
+
+ * marker.c (compute_buffer_marker_usage):
+ Just use lisp_object_storage_size() rather than trying to
+ reimplement it.
+
2010-03-19 Ben Wing <ben at xemacs.org>
* alloc.c:
diff -r cb303ff63e76 -r ab9ee10a53e4 src/alloc.c
--- a/src/alloc.c Fri Mar 19 17:02:11 2010 -0500
+++ b/src/alloc.c Sat Mar 20 20:20:30 2010 -0500
@@ -113,6 +113,15 @@
UID is only 20 bits in old-GC, and 22 in NEW_GC.) */
int lrecord_uid_counter[countof (lrecord_implementations_table)];
+#ifndef USE_KKCC
+/* Object marker functions are in the lrecord_implementation structure.
+ But copying them to a parallel array is much more cache-friendly.
+ This hack speeds up (garbage-collect) by about 5%. */
+Lisp_Object (*lrecord_markers[countof (lrecord_implementations_table)]) (Lisp_Object);
+#endif /* not USE_KKCC */
+
+struct gcpro *gcprolist;
+
/* Non-zero means we're in the process of doing the dump */
int purify_flag;
@@ -517,7 +526,7 @@
} lrecord_stats [countof (lrecord_implementations_table)];
void
-init_lrecord_stats ()
+init_lrecord_stats (void)
{
xzero (lrecord_stats);
}
@@ -844,37 +853,6 @@
zero_sized_lisp_object (obj, lisp_object_size (obj));
}
-
-#ifdef MEMORY_USAGE_STATS
-
-Bytecount
-lisp_object_storage_size (Lisp_Object obj, struct usage_stats *ustats)
-{
-#ifndef NEW_GC
- const struct lrecord_implementation *imp =
- XRECORD_LHEADER_IMPLEMENTATION (obj);
-#endif /* not NEW_GC */
- Bytecount size = lisp_object_size (obj);
-
-#ifdef NEW_GC
- return mc_alloced_storage_size (size, ustats);
-#else
- if (imp->frob_block_p)
- {
- Bytecount overhead = fixed_type_block_overhead (size);
- if (ustats)
- {
- ustats->was_requested += size;
- ustats->malloc_overhead += overhead;
- }
- return size + overhead;
- }
- else
- return malloced_storage_size (XPNTR (obj), size, ustats);
-#endif
-}
-
-#endif /* MEMORY_USAGE_STATS */
void
free_normal_lisp_object (Lisp_Object obj)
@@ -3390,17 +3368,8 @@
/************************************************************************/
-/* Garbage Collection */
-/************************************************************************/
-
-#ifndef USE_KKCC
-/* Object marker functions are in the lrecord_implementation structure.
- But copying them to a parallel array is much more cache-friendly.
- This hack speeds up (garbage-collect) by about 5%. */
-Lisp_Object (*lrecord_markers[countof (lrecord_implementations_table)]) (Lisp_Object);
-#endif /* not USE_KKCC */
-
-struct gcpro *gcprolist;
+/* Staticpro, MCpro */
+/************************************************************************/
/* We want the staticpro list relocated, but not the pointers found
therein, because they refer to locations in the global data segment, not
@@ -3539,10 +3508,6 @@
#endif /* not DEBUG_XEMACS */
-
-
-
-
#ifdef NEW_GC
static const struct memory_description mcpro_description_1[] = {
{ XD_END }
@@ -3604,47 +3569,102 @@
#endif /* not DEBUG_XEMACS */
#endif /* NEW_GC */
+
+/************************************************************************/
+/* Allocation Statistics */
+/************************************************************************/
#ifndef NEW_GC
static int gc_count_num_short_string_in_use;
static Bytecount gc_count_string_total_size;
static Bytecount gc_count_short_string_total_size;
+static Bytecount gc_count_long_string_storage_including_overhead;
/* static int gc_count_total_records_used, gc_count_records_total_size; */
-/* stats on lcrecords in use - kinda kludgy */
+/* stats on objects in use */
static struct
{
- int instances_in_use;
- int bytes_in_use;
- int instances_freed;
- int bytes_freed;
- int instances_on_free_list;
- int bytes_on_free_list;
+ Elemcount instances_in_use;
+ Bytecount bytes_in_use;
+ Bytecount bytes_in_use_overhead;
+ Elemcount instances_freed;
+ Bytecount bytes_freed;
+ Bytecount bytes_freed_overhead;
+ Elemcount instances_on_free_list;
+ Bytecount bytes_on_free_list;
+ Bytecount bytes_on_free_list_overhead;
#ifdef MEMORY_USAGE_STATS
Bytecount nonlisp_bytes_in_use;
struct generic_usage_stats stats;
#endif
} lrecord_stats [countof (lrecord_implementations_table)];
+static void
+clear_lrecord_stats (void)
+{
+ xzero (lrecord_stats);
+ gc_count_num_short_string_in_use = 0;
+ gc_count_string_total_size = 0;
+ gc_count_short_string_total_size = 0;
+ gc_count_long_string_storage_including_overhead = 0;
+}
+
+/* Keep track of extra statistics for strings -- length of the string
+ characters for short and long strings, number of short and long strings. */
+static void
+tick_string_stats (Lisp_String *p, int from_sweep)
+{
+ Bytecount size = p->size_;
+ gc_count_string_total_size += size;
+ if (!BIG_STRING_SIZE_P (size))
+ {
+ gc_count_short_string_total_size += size;
+ gc_count_num_short_string_in_use++;
+ }
+ else
+ gc_count_long_string_storage_including_overhead +=
+ malloced_storage_size (p->data_, p->size_, NULL);
+ /* During the sweep stage, we count the total number of strings in use.
+ This gets those not stored in pdump storage. For pdump storage, we
+ need to bump the number of strings in use so as to get an accurate
+ count of all strings in use (pdump or not). But don't do this when
+ called from the sweep stage, or we will double-count. */
+ if (!from_sweep)
+ gc_count_num_string_in_use++;
+}
+
+/* As objects are sweeped, we record statistics about their memory usage.
+ Currently, all lcrecords are processed this way as well as any frob-block
+ objects that were saved and restored as a result of the pdump process.
+ (See pdump_objects_unmark().) Other frob-block objects do NOT get their
+ statistics noted this way -- instead, as the frob blocks are swept,
+ COPY_INTO_LRECORD_STATS() is called, and notes statistics about the
+ frob blocks. */
+
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);
+ Bytecount obj = wrap_pointer_1 (h);
+ Bytecount sz = lisp_object_size (obj);
+ Bytecount sz_with_overhead = lisp_object_storage_size (obj, NULL);
+ Bytecount overhead = sz_with_overhead - sz;
switch (status)
{
case ALLOC_IN_USE:
lrecord_stats[type_index].instances_in_use++;
lrecord_stats[type_index].bytes_in_use += sz;
+ lrecord_stats[type_index].bytes_in_use_overhead += overhead;
+ if (STRINGP (obj))
+ tick_string_stats (XSTRING (obj), 0);
#ifdef MEMORY_USAGE_STATS
{
struct generic_usage_stats stats;
- Lisp_Object obj = wrap_pointer_1 (h);
if (HAS_OBJECT_METH_P (obj, memory_usage))
{
int i;
@@ -3661,10 +3681,12 @@
case ALLOC_FREE:
lrecord_stats[type_index].instances_freed++;
lrecord_stats[type_index].bytes_freed += sz;
+ lrecord_stats[type_index].bytes_freed_overhead += overhead;
break;
case ALLOC_ON_FREE_LIST:
lrecord_stats[type_index].instances_on_free_list++;
lrecord_stats[type_index].bytes_on_free_list += sz;
+ lrecord_stats[type_index].bytes_on_free_list_overhead += overhead;
break;
default:
ABORT ();
@@ -3682,9 +3704,14 @@
else
tick_lrecord_stats (h, free_p ? ALLOC_FREE : ALLOC_IN_USE);
}
-#endif /* not NEW_GC */
-
-
+
+#endif /* not NEW_GC */
+
+
+/************************************************************************/
+/* Garbage Collection -- Sweep/Compact */
+/************************************************************************/
+
#ifndef NEW_GC
/* Free all unmarked records */
static void
@@ -3745,19 +3772,26 @@
/* *total = total_size; */
}
+static Bytecount fixed_type_block_overhead (Bytecount size,
+ Bytecount per_block);
+
/* 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; \
+ EMACS_INT s_overhead = 0; \
struct type##_block *x = current_##type##_block; \
while (x) { s += sizeof (*x) + MALLOC_OVERHEAD; x = x->prev; } \
+ s_overhead = fixed_type_block_overhead (s, sizeof (struct type##_block)); \
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].bytes_in_use_overhead += \
+ s_overhead; \
lrecord_stats[lrecord_type_##type].instances_on_free_list += \
gc_count_num_##type##_freelist; \
lrecord_stats[lrecord_type_##type].instances_in_use += \
@@ -4423,20 +4457,12 @@
static void
sweep_strings (void)
{
- int num_small_used = 0;
- Bytecount num_small_bytes = 0, num_bytes = 0;
int debug = debug_string_purity;
#define UNMARK_string(ptr) do { \
Lisp_String *p = (ptr); \
- Bytecount size = p->size_; \
UNMARK_RECORD_HEADER (&(p->u.lheader)); \
- num_bytes += size; \
- if (!BIG_STRING_SIZE_P (size)) \
- { \
- num_small_bytes += size; \
- num_small_used++; \
- } \
+ tick_string_stats (p, 1); \
if (debug) \
debug_string_purity_print (wrap_string (p)); \
} while (0)
@@ -4447,10 +4473,6 @@
} while (0)
SWEEP_FIXED_TYPE_BLOCK_1 (string, Lisp_String, u.lheader);
-
- gc_count_num_short_string_in_use = num_small_used;
- gc_count_string_total_size = num_bytes;
- gc_count_short_string_total_size = num_small_bytes;
}
#endif /* not NEW_GC */
@@ -4460,7 +4482,7 @@
{
/* Reset all statistics to 0. They will be incremented when
sweeping lcrecords, frob-block lrecords and dumped objects. */
- xzero (lrecord_stats);
+ clear_lrecord_stats ();
/* Free all unmarked records. Do this at the very beginning,
before anything else, so that the finalize methods can safely
@@ -4542,8 +4564,11 @@
#endif
}
#endif /* not NEW_GC */
-
-/* Clearing for disksave. */
+
+
+/************************************************************************/
+/* "Disksave Finalization" -- Preparing for Dumping */
+/************************************************************************/
void
disksave_object_finalization (void)
@@ -4679,7 +4704,13 @@
void
finish_object_memory_usage_stats (void)
{
-#ifdef MEMORY_USAGE_STATS
+ /* Here we add up the aggregate values for each statistic, previously
+ computed during tick_lrecord_stats(), to get a single combined value
+ of non-Lisp memory usage for all objects of each type. We can't
+ do this if NEW_GC because nothing like tick_lrecord_stats() gets
+ called -- instead, statistics are computed when objects are allocated,
+ which is too early to be calling the memory_usage() method. */
+#if defined (MEMORY_USAGE_STATS) && !defined (NEW_GC)
int i;
for (i = 0; i < countof (lrecord_implementations_table); i++)
{
@@ -4692,7 +4723,7 @@
lrecord_stats[i].stats.othervals[j];
}
}
-#endif /* MEMORY_USAGE_STATS */
+#endif /* defined (MEMORY_USAGE_STATS) && !defined (NEW_GC) */
}
static Lisp_Object
@@ -4733,38 +4764,6 @@
#else /* not NEW_GC */
-#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 (lrecord_stats[i].bytes_in_use != 0
@@ -4774,9 +4773,13 @@
Ascbyte buf[255];
const Ascbyte *name = lrecord_implementations_table[i]->name;
+ sprintf (buf, "%s-storage-overhead", name);
+ pl = gc_plist_hack (buf, lrecord_stats[i].bytes_in_use_overhead, pl);
+ tgu_val += lrecord_stats[i].bytes_in_use_overhead;
sprintf (buf, "%s-storage", name);
pl = gc_plist_hack (buf, lrecord_stats[i].bytes_in_use, pl);
tgu_val += lrecord_stats[i].bytes_in_use;
+#ifdef MEMORY_USAGE_STATS
if (lrecord_stats[i].nonlisp_bytes_in_use)
{
sprintf (buf, "%s-non-lisp-storage", name);
@@ -4784,6 +4787,7 @@
pl);
tgu_val += lrecord_stats[i].nonlisp_bytes_in_use;
}
+#endif /* MEMORY_USAGE_STATS */
pluralize_and_append (buf, name, "-freed");
if (lrecord_stats[i].instances_freed != 0)
pl = gc_plist_hack (buf, lrecord_stats[i].instances_freed, pl);
@@ -4796,21 +4800,32 @@
}
}
- HACK_O_MATIC (string, "string-header-storage", pl);
+ pl = gc_plist_hack ("long-string-chars-storage-overhead",
+ gc_count_long_string_storage_including_overhead -
+ (gc_count_string_total_size
+ - gc_count_short_string_total_size), pl);
+ pl = gc_plist_hack ("long-string-chars-storage",
+ gc_count_string_total_size
+ - gc_count_short_string_total_size, pl);
+ do
+ {
+ COUNT_FROB_BLOCK_USAGE (string_chars);
+ tgu_val += s + s_overhead;
+ pl = gc_plist_hack ("short-string-chars-storage-overhead", s_overhead, pl);
+ pl = gc_plist_hack ("short-string-chars-storage", s, pl);
+ }
+ while (0);
+
pl = gc_plist_hack ("long-strings-total-length",
gc_count_string_total_size
- gc_count_short_string_total_size, pl);
- HACK_O_MATIC (string_chars, "short-string-storage", pl);
pl = gc_plist_hack ("short-strings-total-length",
gc_count_short_string_total_size, pl);
- pl = gc_plist_hack ("strings-free", gc_count_num_string_freelist, pl);
pl = gc_plist_hack ("long-strings-used",
gc_count_num_string_in_use
- gc_count_num_short_string_in_use, pl);
pl = gc_plist_hack ("short-strings-used",
gc_count_num_short_string_in_use, pl);
-
-#undef HACK_O_MATIC
#endif /* NEW_GC */
@@ -5107,7 +5122,6 @@
need_to_signal_post_gc;
}
-
int
object_dead_p (Lisp_Object obj)
{
@@ -5120,7 +5134,7 @@
(EXTENTP (obj) && !EXTENT_LIVE_P (XEXTENT (obj))));
}
-#ifdef MEMORY_USAGE_STATS
+#ifdef ALLOC_TYPE_STATS
/* Attempt to determine the actual amount of space that is used for
the block allocated starting at PTR, supposedly of size "CLAIMED_SIZE".
@@ -5214,25 +5228,60 @@
}
#ifndef NEW_GC
-Bytecount
-fixed_type_block_overhead (Bytecount size)
-{
- Bytecount per_block = TYPE_ALLOC_SIZE (cons, unsigned char);
+static Bytecount
+fixed_type_block_overhead (Bytecount size, Bytecount per_block)
+{
Bytecount overhead = 0;
Bytecount storage_size = malloced_storage_size (0, per_block, 0);
while (size >= per_block)
{
size -= per_block;
- overhead += sizeof (void *) + per_block - storage_size;
+ overhead += storage_size - per_block;
}
if (rand () % per_block < size)
- overhead += sizeof (void *) + per_block - storage_size;
+ overhead += storage_size - per_block;
return overhead;
}
#endif /* not NEW_GC */
-#endif /* MEMORY_USAGE_STATS */
-
-
+
+Bytecount
+lisp_object_storage_size (Lisp_Object obj, struct usage_stats *ustats)
+{
+#ifndef NEW_GC
+ const struct lrecord_implementation *imp =
+ XRECORD_LHEADER_IMPLEMENTATION (obj);
+#endif /* not NEW_GC */
+ Bytecount size = lisp_object_size (obj);
+
+#ifdef NEW_GC
+ return mc_alloced_storage_size (size, ustats);
+#else
+ if (imp->frob_block_p)
+ {
+ Bytecount overhead =
+ /* #### Always using cons_block is incorrect but close; only
+ string_chars_block is significantly different in size, and
+ it won't ever be seen in this function */
+ fixed_type_block_overhead (size, sizeof (struct cons_block));
+ if (ustats)
+ {
+ ustats->was_requested += size;
+ ustats->malloc_overhead += overhead;
+ }
+ return size + overhead;
+ }
+ else
+ return malloced_storage_size (XPNTR (obj), size, ustats);
+#endif
+}
+
+#endif /* ALLOC_TYPE_STATS */
+
+
+/************************************************************************/
+/* Initialization */
+/************************************************************************/
+
/* Initialization */
static void
common_init_alloc_early (void)
diff -r cb303ff63e76 -r ab9ee10a53e4 src/emacs.c
--- a/src/emacs.c Fri Mar 19 17:02:11 2010 -0500
+++ b/src/emacs.c Sat Mar 20 20:20:30 2010 -0500
@@ -1767,7 +1767,9 @@
glyph_objects_create ();
hash_table_objects_create ();
lstream_objects_create ();
+#ifdef MULE
mule_charset_objects_create ();
+#endif
#ifdef HAVE_GTK
ui_gtk_objects_create ();
#endif
diff -r cb303ff63e76 -r ab9ee10a53e4 src/lisp.h
--- a/src/lisp.h Fri Mar 19 17:02:11 2010 -0500
+++ b/src/lisp.h Sat Mar 20 20:20:30 2010 -0500
@@ -1592,8 +1592,6 @@
/* misc */
/* ------------------------------- */
-#ifdef MEMORY_USAGE_STATS
-
/* This structure is used to keep statistics on the amount of memory
in use.
@@ -1626,8 +1624,6 @@
struct usage_stats u;
Bytecount othervals[32];
};
-
-#endif /* MEMORY_USAGE_STATS */
/************************************************************************/
@@ -4839,10 +4835,7 @@
extern Lisp_Object Qpost_gc_hook, Qgarbage_collecting;
void recompute_funcall_allocation_flag (void);
-#ifdef MEMORY_USAGE_STATS
Bytecount malloced_storage_size (void *, Bytecount, struct usage_stats *);
-Bytecount fixed_type_block_overhead (Bytecount);
-#endif
#ifdef EVENT_DATA_AS_OBJECTS
Lisp_Object make_key_data (void);
@@ -5935,7 +5928,7 @@
Lisp_Object noseeum_copy_marker (Lisp_Object, Lisp_Object);
Lisp_Object set_marker_restricted (Lisp_Object, Lisp_Object, Lisp_Object);
#ifdef MEMORY_USAGE_STATS
-int compute_buffer_marker_usage (struct buffer *, struct usage_stats *);
+Bytecount compute_buffer_marker_usage (struct buffer *, struct usage_stats *);
#endif
void init_buffer_markers (struct buffer *b);
void uninit_buffer_markers (struct buffer *b);
diff -r cb303ff63e76 -r ab9ee10a53e4 src/lrecord.h
--- a/src/lrecord.h Fri Mar 19 17:02:11 2010 -0500
+++ b/src/lrecord.h Sat Mar 20 20:20:30 2010 -0500
@@ -2022,10 +2022,8 @@
MODULE_API void copy_lisp_object (Lisp_Object dst, Lisp_Object src);
MODULE_API void zero_sized_lisp_object (Lisp_Object obj, Bytecount size);
MODULE_API void zero_nonsized_lisp_object (Lisp_Object obj);
-#ifdef MEMORY_USAGE_STATS
Bytecount lisp_object_storage_size (Lisp_Object obj,
struct usage_stats *ustats);
-#endif /* MEMORY_USAGE_STATS */
void free_normal_lisp_object (Lisp_Object obj);
diff -r cb303ff63e76 -r ab9ee10a53e4 src/marker.c
--- a/src/marker.c Fri Mar 19 17:02:11 2010 -0500
+++ b/src/marker.c Sat Mar 20 20:20:30 2010 -0500
@@ -497,25 +497,15 @@
#ifdef MEMORY_USAGE_STATS
-int
+Bytecount
compute_buffer_marker_usage (struct buffer *b, struct usage_stats *ustats)
{
Lisp_Marker *m;
- int total = 0;
- int overhead;
+ Bytecount total = 0;
for (m = BUF_MARKERS (b); m; m = m->next)
- total += sizeof (Lisp_Marker);
- ustats->was_requested += total;
-#ifdef NEW_GC
- overhead = mc_alloced_storage_size (total, 0) - total;
-#else /* not NEW_GC */
- overhead = fixed_type_block_overhead (total);
-#endif /* not NEW_GC */
- /* #### claiming this is all malloc overhead is not really right,
- but it has to go somewhere. */
- ustats->malloc_overhead += overhead;
- return total + overhead;
+ total += lisp_object_storage_size (wrap_marker (m), ustats);
+ return total;
}
#endif /* MEMORY_USAGE_STATS */
More information about the XEmacs-Patches
mailing list