[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: Debugging memory leaks/stale references
|
From: |
Florian Weimer |
|
Subject: |
Re: Debugging memory leaks/stale references |
|
Date: |
Tue, 28 Sep 2004 23:51:26 +0200 |
Here's the updated patch for future reference.
--- emacs-upstream/src/find-leak.py 1970-01-01 01:00:00.000000000 +0100
+++ emacs-memory-dump/src/find-leak.py 2004-09-28 23:35:37.000000000 +0200
@@ -0,0 +1,108 @@
+# A patched Emacs writes malloc() traces to standard error after user
+# has invoked enable-malloc-tracing. This script processes the output
+# and produces some statistics. It finds non-freed memory blocks and
+# groups them by the backtrace at the point of allocation. After
+# that, the leaking backtraces are sorted by decreasing leakage, and
+# the addresses are resolved using addr2line.
+#
+# You should pass this script the name of the file to which Emacs
+# wrote the malloc trace on the command line. The file might contain
+# some garbled lines with multiple "@" signs (possibly due to some
+# obscure reentrance problems that have not yet been solved). Delete
+# them if this script runs into them.
+#
+# It is a good idea to repeat the action that triggers the memory leak
+# multiple times (so that memory-limit grows by a substantial value),
+# then invoke garbage-collect (to free as much memory as possible),
+# and exit from Emacs. Some Lisp objects will not be freed (and show
+# up in the leakage statistics), but the real memory leak will be
+# substantially larger and easy to spot in the sorted output.
+#
+# Note that if your system's libc library has been compiled with frame
+# pointer omission, the output won't contain usable information. You
+# must use the debugging version of libc. (On Debian systems, it's
+# available in the libc6-dbg package, and you have to set the
+# LD_LIBRARY_PATH environment variable to "/usr/lib/debug".)
+#
+# Note that this approach won't be very helpful if the leak is caused
+# by unused, but still-referenced Lisp data. Use garbage-collect-dump
+# (in the patched Emacs) for that and hope for the best. Its output
+# is more structured and might reveal which Lisp variable is the
+# culprit.
+
+import sys, os
+
+def convert_allocators(allocs):
+ l = []
+ for a in allocs:
+ if a <> '(nil)':
+ l.append(eval(a))
+ else:
+ l.append(0)
+ return tuple(l)
+
+def unfreed_objects(file):
+ objects = {}
+
+ for line in file.readlines():
+ fields = line.split(' ')
+ if fields[0] <> '@':
+ continue
+
+ if fields[1] == 'A':
+ address = eval(fields[2])
+ size = int(fields[3])
+ if fields[4] <> ':':
+ raise ValueError
+ objects[address] = (size, convert_allocators(fields[5:]))
+
+ elif fields[1] == 'R':
+ address = fields[2]
+ if address == '(nil)':
+ address = 0
+ else:
+ address = eval(address)
+
+ new_address = eval(fields[3])
+ size = int(fields[4])
+ if fields[5] <> ':':
+ raise ValueError
+ if objects.has_key(address):
+ del objects[address]
+ objects[new_address] = (size, convert_allocators(fields[6:]))
+
+ elif fields[1] == 'F':
+ address = eval(fields[2])
+ if objects.has_key(address):
+ del objects[address]
+
+ return objects
+
+def leaking_paths(objects):
+ paths = {}
+ for (size, path) in objects.values():
+ paths[path] = paths.get(path, 0) + size
+ return paths
+
+objects = unfreed_objects(open(sys.argv[1]))
+paths = leaking_paths(objects)
+
+resolve_cache = {}
+def resolve(addr):
+ if resolve_cache.has_key(addr):
+ return resolve_cache[addr]
+ address = hex(p)
+ lines = os.popen("addr2line -e ./emacs -f " + address, "r").readlines()
+ result = tuple("".join(lines).split('\n'))
+ resolve_cache[addr] = result
+ return result
+
+l = map(lambda (path, size): (-size, path), paths.items())
+l.sort()
+for (size, path) in l:
+ size = -size
+ print '*', size
+ for p in path:
+ print " " + " ".join(resolve(p))
+
+# arch-tag: 38cf01b5-1b4d-405e-b324-0f79a146826f
--- emacs-upstream/src/lisp.h 2004-09-27 21:32:39.000000000 +0200
+++ emacs-memory-dump/src/lisp.h 2004-09-28 20:49:45.000000000 +0200
@@ -2440,9 +2440,12 @@
extern void memory_full P_ ((void));
extern void buffer_memory_full P_ ((void));
extern int survives_gc_p P_ ((Lisp_Object));
-extern void mark_object P_ ((Lisp_Object));
+extern void mark_object P_ ((Lisp_Object, unsigned));
+extern void mark_kboards P_ ((unsigned));
+extern void mark_backtrace P_ ((void));
extern Lisp_Object Vpurify_flag;
extern Lisp_Object Vmemory_full;
+extern int message_enable_multibyte;
EXFUN (Fcons, 2);
EXFUN (list2, 2);
EXFUN (list3, 3);
--- emacs-upstream/src/alloc.c 2004-09-27 21:33:09.000000000 +0200
+++ emacs-memory-dump/src/alloc.c 2004-09-28 21:10:38.000000000 +0200
@@ -258,12 +258,15 @@
Lisp_Object Vgc_elapsed; /* accumulated elapsed time in GC */
EMACS_INT gcs_done; /* accumulated GCs */
-static void mark_buffer P_ ((Lisp_Object));
-extern void mark_kboards P_ ((void));
-extern void mark_backtrace P_ ((void));
+/* If non-zero, dump objects to stderr while they are marked. */
+static int do_dump = 0;
+
+static void dump_marker_section (char *name);
+
+static void mark_buffer P_ ((Lisp_Object, unsigned));
static void gc_sweep P_ ((void));
-static void mark_glyph_matrix P_ ((struct glyph_matrix *));
-static void mark_face_cache P_ ((struct face_cache *));
+static void mark_glyph_matrix P_ ((struct glyph_matrix *, unsigned));
+static void mark_face_cache P_ ((struct face_cache *, unsigned));
#ifdef HAVE_WINDOW_SYSTEM
static void mark_image P_ ((struct image *));
@@ -275,8 +278,6 @@
static void free_large_strings P_ ((void));
static void sweep_strings P_ ((void));
-extern int message_enable_multibyte;
-
/* When scanning the C stack for live Lisp objects, Emacs keeps track
of what memory allocated via lisp_malloc is intended for what
purpose. This enumeration specifies the type of memory. */
@@ -389,8 +390,8 @@
static int live_symbol_p P_ ((struct mem_node *, void *));
static int live_float_p P_ ((struct mem_node *, void *));
static int live_misc_p P_ ((struct mem_node *, void *));
-static void mark_maybe_object P_ ((Lisp_Object));
-static void mark_memory P_ ((void *, void *));
+static void mark_maybe_object P_ ((Lisp_Object, unsigned));
+static void mark_memory P_ ((void *, void *, unsigned));
static void mem_init P_ ((void));
static struct mem_node *mem_insert P_ ((void *, void *, enum mem_type));
static void mem_insert_fixup P_ ((struct mem_node *));
@@ -1217,7 +1218,7 @@
{
eassert (!i->gcmarkbit); /* Intervals are never shared. */
i->gcmarkbit = 1;
- mark_object (i->plist);
+ mark_object (i->plist, 0);
}
@@ -3688,8 +3689,9 @@
/* Mark OBJ if we can prove it's a Lisp_Object. */
static INLINE void
-mark_maybe_object (obj)
+mark_maybe_object (obj, depth)
Lisp_Object obj;
+ unsigned depth;
{
void *po = (void *) XPNTR (obj);
struct mem_node *m = mem_find (po);
@@ -3743,7 +3745,7 @@
zombies[nzombies] = obj;
++nzombies;
#endif
- mark_object (obj);
+ mark_object (obj, depth + 1);
}
}
}
@@ -3753,8 +3755,9 @@
marked. */
static INLINE void
-mark_maybe_pointer (p)
+mark_maybe_pointer (p, depth)
void *p;
+ unsigned depth;
{
struct mem_node *m;
@@ -3824,7 +3827,7 @@
}
if (!GC_NILP (obj))
- mark_object (obj);
+ mark_object (obj, depth + 1);
}
}
@@ -3832,8 +3835,9 @@
/* Mark Lisp objects referenced from the address range START..END. */
static void
-mark_memory (start, end)
+mark_memory (start, end, depth)
void *start, *end;
+ unsigned depth;
{
Lisp_Object *p;
void **pp;
@@ -3853,7 +3857,7 @@
/* Mark Lisp_Objects. */
for (p = (Lisp_Object *) start; (void *) p < end; ++p)
- mark_maybe_object (*p);
+ mark_maybe_object (*p, depth + 1);
/* Mark Lisp data pointed to. This is necessary because, in some
situations, the C compiler optimizes Lisp objects away, so that
@@ -4098,7 +4102,7 @@
#endif
#endif
for (i = 0; i < sizeof (Lisp_Object); i += GC_LISP_OBJECT_ALIGNMENT)
- mark_memory ((char *) stack_base + i, end);
+ mark_memory ((char *) stack_base + i, end, 1);
#if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS
check_gcpros ();
@@ -4455,14 +4459,14 @@
/* Mark all the special slots that serve as the roots of accessibility. */
for (i = 0; i < staticidx; i++)
- mark_object (*staticvec[i]);
+ mark_object (*staticvec[i], 1);
for (bind = specpdl; bind != specpdl_ptr; bind++)
{
- mark_object (bind->symbol);
- mark_object (bind->old_value);
+ mark_object (bind->symbol, 1);
+ mark_object (bind->old_value, 1);
}
- mark_kboards ();
+ mark_kboards (1);
#ifdef USE_GTK
{
@@ -4483,18 +4487,22 @@
}
#endif
+ dump_marker_section ("Begin marking byte stack.");
mark_byte_stack ();
+ dump_marker_section ("Begin marking byte stack.");
for (catch = catchlist; catch; catch = catch->next)
{
- mark_object (catch->tag);
- mark_object (catch->val);
+ mark_object (catch->tag, 1);
+ mark_object (catch->val, 1);
}
for (handler = handlerlist; handler; handler = handler->next)
{
- mark_object (handler->handler);
- mark_object (handler->var);
+ mark_object (handler->handler, 1);
+ mark_object (handler->var, 1);
}
+ dump_marker_section ("Begin marking backtrace.");
mark_backtrace ();
+ dump_marker_section ("End marking backtrace.");
#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
mark_stack ();
@@ -4542,7 +4550,7 @@
}
/* Now that we have stripped the elements that need not be in the
undo_list any more, we can finally mark the list. */
- mark_object (nextb->undo_list);
+ mark_object (nextb->undo_list, 1);
nextb = nextb->next;
}
@@ -4630,13 +4638,24 @@
return Flist (sizeof total / sizeof *total, total);
}
+DEFUN ("garbage-collect-dump", Fgarbage_collect_dump, Sgarbage_collect_dump,
0, 0, "",
+ doc: /* Run garbage collection and dump objects. */)
+ ()
+{
+ ++do_dump;
+ dump_marker_section ("Begin garbage collection.");
+ Fgarbage_collect ();
+ dump_marker_section ("End garbage collection.");
+ --do_dump;
+}
/* Mark Lisp objects in glyph matrix MATRIX. Currently the
only interesting objects referenced from glyphs are strings. */
static void
-mark_glyph_matrix (matrix)
+mark_glyph_matrix (matrix, depth)
struct glyph_matrix *matrix;
+ unsigned depth;
{
struct glyph_row *row = matrix->rows;
struct glyph_row *end = row + matrix->nrows;
@@ -4653,7 +4672,7 @@
for (; glyph < end_glyph; ++glyph)
if (GC_STRINGP (glyph->object)
&& !STRING_MARKED_P (XSTRING (glyph->object)))
- mark_object (glyph->object);
+ mark_object (glyph->object, depth + 1);
}
}
}
@@ -4662,8 +4681,9 @@
/* Mark Lisp faces in the face cache C. */
static void
-mark_face_cache (c)
+mark_face_cache (c, depth)
struct face_cache *c;
+ unsigned depth;
{
if (c)
{
@@ -4675,7 +4695,7 @@
if (face)
{
for (j = 0; j < LFACE_VECTOR_SIZE; ++j)
- mark_object (face->lface[j]);
+ mark_object (face->lface[j], depth + 1);
}
}
}
@@ -4690,10 +4710,10 @@
mark_image (img)
struct image *img;
{
- mark_object (img->spec);
+ mark_object (img->spec, 1);
if (!NILP (img->data.lisp_val))
- mark_object (img->data.lisp_val);
+ mark_object (img->data.lisp_val, 1);
}
@@ -4725,9 +4745,84 @@
Normally this is zero and the check never goes off. */
int mark_object_loop_halt;
+/* For memory debugging: dumps the string in human-readable form to
+ stderr. */
+static void
+dump_string (char *data, unsigned length)
+{
+ unsigned i;
+
+ for (i = 0; i < length; ++i)
+ {
+ char c = data[i];
+ if (c >= 32 && c <= 126)
+ fputc (c, stderr);
+ else if (c == '"' || c == '\\')
+ {
+ fputc ('\\', stderr);
+ fputc (c, stderr);
+ }
+ else if (c == '\n')
+ fputs ("\\n", stderr);
+ else if (c == '\t')
+ fputs ("\\t", stderr);
+ else if (c == '\r')
+ fputs ("\\r", stderr);
+ else
+ fprintf (stderr, "\\%03o", (unsigned)(unsigned char) c);
+ }
+}
+
+/* For memory debugging: prints OBJ of TYPE, at nesting level
+ DEPTH to stderr. */
+static void
+dump_object (char *type, unsigned depth, Lisp_Object obj, int marked)
+{
+ unsigned i;
+
+ if (!do_dump)
+ return;
+
+ fprintf (stderr, "[%u] %s (%p)%s\n",
+ depth, type, (void *)obj, marked ? " *" : "");
+}
+
+static void
+dump_object_int (unsigned depth, Lisp_Object obj)
+{
+ if (!do_dump)
+ return;
+
+ fprintf (stderr, "[%u] INT %d\n", depth, XINT(obj));
+}
+
+static void
+dump_marker_section(char *name)
+{
+ if (!do_dump)
+ return;
+
+ fprintf (stderr, "%s\n", name);
+}
+
+/* For memory debugging: prints OBJ of TYPE, with NAME, at nesting
+ level DEPTH to stderr. */
+static void
+dump_object_name (char *type, unsigned depth, Lisp_Object obj, struct
Lisp_String* name, int marked)
+{
+ if (!do_dump)
+ return;
+
+ fprintf (stderr, "[%u] %s (%p) \"", depth, type, (void *)obj);
+ dump_string (name->data, name->size & ~ARRAY_MARK_FLAG);
+ fprintf (stderr, "\"%s\n", marked ? " *" : "");
+}
+
+
void
-mark_object (arg)
+mark_object (arg, depth)
Lisp_Object arg;
+ unsigned depth;
{
register Lisp_Object obj = arg;
#ifdef GC_CHECK_MARKED_OBJECTS
@@ -4792,6 +4887,7 @@
CHECK_ALLOCATED_AND_LIVE (live_string_p);
MARK_INTERVAL_TREE (ptr->intervals);
MARK_STRING (ptr);
+ dump_object_name ("STRING", depth, obj, ptr, ptr->size &
ARRAY_MARK_FLAG);
#ifdef GC_CHECK_STRING_BYTES
/* Check that the string size recorded in the string is the
same as the one recorded in the sdata structure. */
@@ -4811,6 +4907,8 @@
if (GC_BUFFERP (obj))
{
+ dump_object ("BUFFER", depth, obj, VECTOR_MARKED_P (XBUFFER (obj)));
+
if (!VECTOR_MARKED_P (XBUFFER (obj)))
{
#ifdef GC_CHECK_MARKED_OBJECTS
@@ -4823,7 +4921,7 @@
abort ();
}
#endif /* GC_CHECK_MARKED_OBJECTS */
- mark_buffer (obj);
+ mark_buffer (obj, depth + 1);
}
}
else if (GC_SUBRP (obj))
@@ -4837,6 +4935,8 @@
register EMACS_INT size = ptr->size;
register int i;
+ dump_object ("COMPILED", depth, obj, VECTOR_MARKED_P (ptr));
+
if (VECTOR_MARKED_P (ptr))
break; /* Already marked */
@@ -4846,7 +4946,7 @@
for (i = 0; i < size; i++) /* and then mark its elements */
{
if (i != COMPILED_CONSTANTS)
- mark_object (ptr->contents[i]);
+ mark_object (ptr->contents[i], depth + 1);
}
obj = ptr->contents[COMPILED_CONSTANTS];
goto loop;
@@ -4855,40 +4955,48 @@
{
register struct frame *ptr = XFRAME (obj);
+ dump_object ("FRAME", depth, obj, VECTOR_MARKED_P (ptr));
+
if (VECTOR_MARKED_P (ptr)) break; /* Already marked */
+
VECTOR_MARK (ptr); /* Else mark it */
CHECK_LIVE (live_vector_p);
- mark_object (ptr->name);
- mark_object (ptr->icon_name);
- mark_object (ptr->title);
- mark_object (ptr->focus_frame);
- mark_object (ptr->selected_window);
- mark_object (ptr->minibuffer_window);
- mark_object (ptr->param_alist);
- mark_object (ptr->scroll_bars);
- mark_object (ptr->condemned_scroll_bars);
- mark_object (ptr->menu_bar_items);
- mark_object (ptr->face_alist);
- mark_object (ptr->menu_bar_vector);
- mark_object (ptr->buffer_predicate);
- mark_object (ptr->buffer_list);
- mark_object (ptr->menu_bar_window);
- mark_object (ptr->tool_bar_window);
- mark_face_cache (ptr->face_cache);
+ mark_object (ptr->name, depth + 1);
+ mark_object (ptr->icon_name, depth + 1);
+ mark_object (ptr->title, depth + 1);
+ mark_object (ptr->focus_frame, depth + 1);
+ mark_object (ptr->selected_window, depth + 1);
+ mark_object (ptr->minibuffer_window, depth + 1);
+ mark_object (ptr->param_alist, depth + 1);
+ mark_object (ptr->scroll_bars, depth + 1);
+ mark_object (ptr->condemned_scroll_bars, depth + 1);
+ mark_object (ptr->menu_bar_items, depth + 1);
+ mark_object (ptr->face_alist, depth + 1);
+ mark_object (ptr->menu_bar_vector, depth + 1);
+ mark_object (ptr->buffer_predicate, depth + 1);
+ mark_object (ptr->buffer_list, depth + 1);
+ mark_object (ptr->menu_bar_window, depth + 1);
+ mark_object (ptr->tool_bar_window, depth + 1);
+ mark_face_cache (ptr->face_cache, depth + 1);
#ifdef HAVE_WINDOW_SYSTEM
+ dump_marker_section ("Begin marking FRAME images.");
mark_image_cache (ptr);
- mark_object (ptr->tool_bar_items);
- mark_object (ptr->desired_tool_bar_string);
- mark_object (ptr->current_tool_bar_string);
+ dump_marker_section ("End marking FRAME images.");
+ mark_object (ptr->tool_bar_items, depth + 1);
+ mark_object (ptr->desired_tool_bar_string, depth + 1);
+ mark_object (ptr->current_tool_bar_string, depth + 1);
#endif /* HAVE_WINDOW_SYSTEM */
}
else if (GC_BOOL_VECTOR_P (obj))
{
register struct Lisp_Vector *ptr = XVECTOR (obj);
+ dump_object ("BOOL_VECTOR", depth, obj, VECTOR_MARKED_P (ptr));
+
if (VECTOR_MARKED_P (ptr))
break; /* Already marked */
+
CHECK_LIVE (live_vector_p);
VECTOR_MARK (ptr); /* Else mark it */
}
@@ -4898,6 +5006,8 @@
struct window *w = XWINDOW (obj);
register int i;
+ dump_object ("WINDOW", depth, obj, VECTOR_MARKED_P (ptr));
+
/* Stop if already marked. */
if (VECTOR_MARKED_P (ptr))
break;
@@ -4911,7 +5021,7 @@
for (i = 0;
(char *) &ptr->contents[i] < (char *) &w->current_matrix;
i++)
- mark_object (ptr->contents[i]);
+ mark_object (ptr->contents[i], depth + 1);
/* Mark glyphs for leaf windows. Marking window matrices is
sufficient because frame matrices use the same glyph
@@ -4920,14 +5030,16 @@
&& NILP (w->vchild)
&& w->current_matrix)
{
- mark_glyph_matrix (w->current_matrix);
- mark_glyph_matrix (w->desired_matrix);
+ mark_glyph_matrix (w->current_matrix, depth + 1);
+ mark_glyph_matrix (w->desired_matrix, depth + 1);
}
}
else if (GC_HASH_TABLE_P (obj))
{
struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
+ dump_object ("HASH_TABLE", depth, obj, VECTOR_MARKED_P (h));
+
/* Stop if already marked. */
if (VECTOR_MARKED_P (h))
break;
@@ -4941,20 +5053,20 @@
Being in the next_weak chain
should not keep the hash table alive.
No need to mark `count' since it is an integer. */
- mark_object (h->test);
- mark_object (h->weak);
- mark_object (h->rehash_size);
- mark_object (h->rehash_threshold);
- mark_object (h->hash);
- mark_object (h->next);
- mark_object (h->index);
- mark_object (h->user_hash_function);
- mark_object (h->user_cmp_function);
+ mark_object (h->test, depth + 1);
+ mark_object (h->weak, depth + 1);
+ mark_object (h->rehash_size, depth + 1);
+ mark_object (h->rehash_threshold, depth + 1);
+ mark_object (h->hash, depth + 1);
+ mark_object (h->next, depth + 1);
+ mark_object (h->index, depth + 1);
+ mark_object (h->user_hash_function, depth + 1);
+ mark_object (h->user_cmp_function, depth + 1);
/* If hash table is not weak, mark all keys and values.
For weak tables, mark only the vector. */
if (GC_NILP (h->weak))
- mark_object (h->key_and_value);
+ mark_object (h->key_and_value, depth + 1);
else
VECTOR_MARK (XVECTOR (h->key_and_value));
}
@@ -4964,6 +5076,8 @@
register EMACS_INT size = ptr->size;
register int i;
+ dump_object ("VECTOR", depth, obj, VECTOR_MARKED_P (ptr));
+
if (VECTOR_MARKED_P (ptr)) break; /* Already marked */
CHECK_LIVE (live_vector_p);
VECTOR_MARK (ptr); /* Else mark it */
@@ -4971,7 +5085,7 @@
size &= PSEUDOVECTOR_SIZE_MASK;
for (i = 0; i < size; i++) /* and then mark its elements */
- mark_object (ptr->contents[i]);
+ mark_object (ptr->contents[i], depth + 1);
}
break;
@@ -4980,12 +5094,15 @@
register struct Lisp_Symbol *ptr = XSYMBOL (obj);
struct Lisp_Symbol *ptrx;
+ dump_object_name ("SYMBOL", depth, obj, XSTRING (ptr->xname),
ptr->gcmarkbit);
+
if (ptr->gcmarkbit) break;
+
CHECK_ALLOCATED_AND_LIVE (live_symbol_p);
ptr->gcmarkbit = 1;
- mark_object (ptr->value);
- mark_object (ptr->function);
- mark_object (ptr->plist);
+ mark_object (ptr->value, depth + 1);
+ mark_object (ptr->function, depth + 1);
+ mark_object (ptr->plist, depth + 1);
if (!PURE_POINTER_P (XSTRING (ptr->xname)))
MARK_STRING (XSTRING (ptr->xname));
@@ -5006,6 +5123,7 @@
case Lisp_Misc:
CHECK_ALLOCATED_AND_LIVE (live_misc_p);
+ dump_object ("MISC", depth, obj, XMARKER (obj)->gcmarkbit);
if (XMARKER (obj)->gcmarkbit)
break;
XMARKER (obj)->gcmarkbit = 1;
@@ -5023,9 +5141,9 @@
obj = ptr->realvalue;
goto loop;
}
- mark_object (ptr->realvalue);
- mark_object (ptr->buffer);
- mark_object (ptr->frame);
+ mark_object (ptr->realvalue, depth + 1);
+ mark_object (ptr->buffer, depth + 1);
+ mark_object (ptr->frame, depth + 1);
obj = ptr->cdr;
goto loop;
}
@@ -5058,18 +5176,17 @@
Lisp_Object *p = (Lisp_Object *) ptr->pointer;
int nelt;
for (nelt = ptr->integer; nelt > 0; nelt--, p++)
- mark_maybe_object (*p);
+ mark_maybe_object (*p, depth + 1);
}
}
#endif
break;
-
case Lisp_Misc_Overlay:
{
struct Lisp_Overlay *ptr = XOVERLAY (obj);
- mark_object (ptr->start);
- mark_object (ptr->end);
- mark_object (ptr->plist);
+ mark_object (ptr->start, depth + 1);
+ mark_object (ptr->end, depth + 1);
+ mark_object (ptr->plist, depth + 1);
if (ptr->next)
{
XSETMISC (obj, ptr->next);
@@ -5086,30 +5203,23 @@
case Lisp_Cons:
{
register struct Lisp_Cons *ptr = XCONS (obj);
+ dump_object ("CONS", depth, obj, CONS_MARKED_P (ptr));
if (CONS_MARKED_P (ptr)) break;
CHECK_ALLOCATED_AND_LIVE (live_cons_p);
CONS_MARK (ptr);
- /* If the cdr is nil, avoid recursion for the car. */
- if (EQ (ptr->cdr, Qnil))
- {
- obj = ptr->car;
- cdr_count = 0;
- goto loop;
- }
- mark_object (ptr->car);
- obj = ptr->cdr;
- cdr_count++;
- if (cdr_count == mark_object_loop_halt)
- abort ();
- goto loop;
+ mark_object (ptr->car, depth + 1);
+ mark_object (ptr->cdr, depth + 1);
+ break;
}
case Lisp_Float:
CHECK_ALLOCATED_AND_LIVE (live_float_p);
+ dump_object ("CONS", depth, obj, FLOAT_MARKED_P (XFLOAT (obj)));
FLOAT_MARK (XFLOAT (obj));
break;
case Lisp_Int:
+ dump_object_int (depth, obj);
break;
default:
@@ -5124,8 +5234,9 @@
/* Mark the pointers in a buffer structure. */
static void
-mark_buffer (buf)
+mark_buffer (buf, depth)
Lisp_Object buf;
+ unsigned depth;
{
register struct buffer *buffer = XBUFFER (buf);
register Lisp_Object *ptr, tmp;
@@ -5142,24 +5253,24 @@
if (buffer->overlays_before)
{
XSETMISC (tmp, buffer->overlays_before);
- mark_object (tmp);
+ mark_object (tmp, depth + 1);
}
if (buffer->overlays_after)
{
XSETMISC (tmp, buffer->overlays_after);
- mark_object (tmp);
+ mark_object (tmp, depth + 1);
}
for (ptr = &buffer->name;
(char *)ptr < (char *)buffer + sizeof (struct buffer);
ptr++)
- mark_object (*ptr);
+ mark_object (*ptr, depth + 1);
/* If this is an indirect buffer, mark its base buffer. */
if (buffer->base_buffer && !VECTOR_MARKED_P (buffer->base_buffer))
{
XSETBUFFER (base_buffer, buffer->base_buffer);
- mark_buffer (base_buffer);
+ mark_buffer (base_buffer, depth + 1);
}
}
@@ -5599,6 +5710,71 @@
return Flist (8, consed);
}
+
+static void *(*dump_hook_old_malloc) (size_t, const void *);
+static void *(*dump_hook_old_realloc) (void *, size_t, const void *);
+static void (*dump_hook_old_free) (void *, const void *);
+
+static void
+dump_malloc_backtrace (void)
+{
+ void *trace[20];
+ unsigned depth, i;
+
+ depth = backtrace (trace, 20);
+ for (i = 1; i < depth; ++i)
+ {
+ fprintf (stderr, " %p", trace[i]);
+ }
+ fputs ("\n", stderr);
+}
+
+static void *
+dump_hook_malloc (size_t size, const void *caller)
+{
+ void *result;
+ __malloc_hook = dump_hook_old_malloc;
+ result = malloc(size);
+ fprintf (stderr, "@ A %p %u :", result, size);
+ dump_malloc_backtrace ();
+ __malloc_hook = &dump_hook_malloc;
+ return result;
+}
+
+static void *
+dump_hook_realloc (void *ptr, size_t size, const void *caller)
+{
+ void *result;
+ __realloc_hook = dump_hook_old_realloc;
+ result = realloc(ptr, size);
+ fprintf (stderr, "@ R %p %p %u :", ptr, result, size);
+ dump_malloc_backtrace ();
+ __realloc_hook = &dump_hook_realloc;
+ return result;
+}
+
+static void
+dump_hook_free (void *ptr, const void *caller)
+{
+ __free_hook = dump_hook_old_free;
+ free(ptr);
+ fprintf (stderr, "@ F %p :", ptr);
+ dump_malloc_backtrace ();
+ __free_hook = &dump_hook_free;
+}
+
+DEFUN ("enable-malloc-tracing", Fenable_malloc_tracing,
Senable_malloc_tracing, 0, 0, "",
+ doc: /* Enable tracing of memory allocations. */)
+ ()
+{
+ dump_hook_old_malloc = __malloc_hook;
+ dump_hook_old_realloc = __realloc_hook;
+ dump_hook_old_free = __free_hook;
+ __malloc_hook = &dump_hook_malloc;
+ __realloc_hook = &dump_hook_realloc;
+ __free_hook = &dump_hook_free;
+}
+
int suppress_checking;
void
die (msg, file, line)
@@ -5792,8 +5968,10 @@
defsubr (&Smake_marker);
defsubr (&Spurecopy);
defsubr (&Sgarbage_collect);
+ defsubr (&Sgarbage_collect_dump);
defsubr (&Smemory_limit);
defsubr (&Smemory_use_counts);
+ defsubr (&Senable_malloc_tracing);
#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
defsubr (&Sgc_status);
--- emacs-upstream/src/bytecode.c 2004-09-27 21:33:01.000000000 +0200
+++ emacs-memory-dump/src/bytecode.c 2004-09-25 19:16:07.000000000 +0200
@@ -289,10 +289,10 @@
eassert (stack->top);
for (obj = stack->bottom; obj <= stack->top; ++obj)
- mark_object (*obj);
+ mark_object (*obj, 1);
- mark_object (stack->byte_string);
- mark_object (stack->constants);
+ mark_object (stack->byte_string, 1);
+ mark_object (stack->constants, 1);
}
}
--- emacs-upstream/src/eval.c 2004-09-27 21:32:39.000000000 +0200
+++ emacs-memory-dump/src/eval.c 2004-09-25 20:23:47.000000000 +0200
@@ -3260,14 +3260,14 @@
for (backlist = backtrace_list; backlist; backlist = backlist->next)
{
- mark_object (*backlist->function);
+ mark_object (*backlist->function, 1);
if (backlist->nargs == UNEVALLED || backlist->nargs == MANY)
i = 0;
else
i = backlist->nargs - 1;
for (; i >= 0; i--)
- mark_object (backlist->args[i]);
+ mark_object (backlist->args[i], 1);
}
}
--- emacs-upstream/src/fns.c 2004-09-27 21:32:39.000000000 +0200
+++ emacs-memory-dump/src/fns.c 2004-09-25 19:15:38.000000000 +0200
@@ -4804,13 +4804,13 @@
/* Make sure key and value survive. */
if (!key_known_to_survive_p)
{
- mark_object (HASH_KEY (h, i));
+ mark_object (HASH_KEY (h, i), 1);
marked = 1;
}
if (!value_known_to_survive_p)
{
- mark_object (HASH_VALUE (h, i));
+ mark_object (HASH_VALUE (h, i), 1);
marked = 1;
}
}
--- emacs-upstream/src/keyboard.c 2004-09-27 21:32:39.000000000 +0200
+++ emacs-memory-dump/src/keyboard.c 2004-09-25 17:36:06.000000000 +0200
@@ -11425,7 +11425,8 @@
/* Mark the pointers in the kboard objects.
Called by the Fgarbage_collector. */
void
-mark_kboards ()
+mark_kboards (depth)
+ unsigned depth;
{
KBOARD *kb;
Lisp_Object *p;
@@ -11433,19 +11434,19 @@
{
if (kb->kbd_macro_buffer)
for (p = kb->kbd_macro_buffer; p < kb->kbd_macro_ptr; p++)
- mark_object (*p);
- mark_object (kb->Voverriding_terminal_local_map);
- mark_object (kb->Vlast_command);
- mark_object (kb->Vreal_last_command);
- mark_object (kb->Vprefix_arg);
- mark_object (kb->Vlast_prefix_arg);
- mark_object (kb->kbd_queue);
- mark_object (kb->defining_kbd_macro);
- mark_object (kb->Vlast_kbd_macro);
- mark_object (kb->Vsystem_key_alist);
- mark_object (kb->system_key_syms);
- mark_object (kb->Vdefault_minibuffer_frame);
- mark_object (kb->echo_string);
+ mark_object (*p, depth + 1);
+ mark_object (kb->Voverriding_terminal_local_map, depth + 1);
+ mark_object (kb->Vlast_command, depth + 1);
+ mark_object (kb->Vreal_last_command, depth + 1);
+ mark_object (kb->Vprefix_arg, depth + 1);
+ mark_object (kb->Vlast_prefix_arg, depth + 1);
+ mark_object (kb->kbd_queue, depth + 1);
+ mark_object (kb->defining_kbd_macro, depth + 1);
+ mark_object (kb->Vlast_kbd_macro, depth + 1);
+ mark_object (kb->Vsystem_key_alist, depth + 1);
+ mark_object (kb->system_key_syms, depth + 1);
+ mark_object (kb->Vdefault_minibuffer_frame, depth + 1);
+ mark_object (kb->echo_string, depth + 1);
}
{
struct input_event *event;
@@ -11455,11 +11456,11 @@
event = kbd_buffer;
if (event->kind != SELECTION_REQUEST_EVENT)
{
- mark_object (event->x);
- mark_object (event->y);
+ mark_object (event->x, depth + 1);
+ mark_object (event->y, depth + 1);
}
- mark_object (event->frame_or_window);
- mark_object (event->arg);
+ mark_object (event->frame_or_window, depth + 1);
+ mark_object (event->arg, depth + 1);
}
}
}
- Debugging memory leaks/stale references, Florian Weimer, 2004/09/21
- Re: Debugging memory leaks/stale references, Simon Josefsson, 2004/09/21
- Re: Debugging memory leaks/stale references, Richard Stallman, 2004/09/28
- Re: Debugging memory leaks/stale references, Florian Weimer, 2004/09/28
- Re: Debugging memory leaks/stale references,
Florian Weimer <=
- Re: Debugging memory leaks/stale references, Richard Stallman, 2004/09/29
- Re: Debugging memory leaks/stale references, Kenichi Handa, 2004/09/29
- Re: Debugging memory leaks/stale references, Kim F. Storm, 2004/09/28
Re: Debugging memory leaks/stale references, Stefan Monnier, 2004/09/21