Re: Debugging memory leaks/stale references

[Florian Weimer <fw@deneb.enyo.de>]

* Simon Josefsson:

> I'm using CVS Emacs, and can confirm that the behavior is the same.
> When I notice that emacs feel sluggish, it is often the case that ps
> report that emacs is using nearly all physical amount memory (1GB
> here).  Tracking down this would be good.  I think someone said that
> disabling the gnus agent at least reduce the problem.

Okay, I've done some debugging, mainly by instrumenting the garbage
collector.  Basically, the patch below is a hook into mark_object()
and prints object types, address, and also contents (for symbols)
while they are traversed.  Unfortunately, no major leak turned up,
just a few thousand cons cells which can't cause the massive leak I
see (in the order of dozens of megabytes after entering/exiting a
large NNTP group with Gnus).

So I'm back to the drawing board and have a few further questions.

Is it possible to run a full-featured Emacs (including X11 support) on
a target that does not support dumping?  (In case you wonder,
x86/valgrind is such a target. 8-)

Is there a method to determine the (approximate) size of a buffer?
Are there any other objects that can change their size after
allocation?  (I'm pretty sure that there are no additional Lisp
objects allocated, but maybe an existing object grows without bounds.)

Oh, and for your amusement, I've appended by debugging patch below.
Basically, this is straight from the "you do not want to need this,
really" department.  Of course, it's not intended for inclusion in to
Emacs (except for the first hunk, maybe).

--- orig/src/.arch-inventory
+++ mod/src/.arch-inventory
@@ -4,6 +4,6 @@
 # Auto-generated files, which ignore
 precious ^(config\.stamp|config\.h|epaths\.h)$
 
-backup ^(stamp-oldxmenu|prefix-args|temacs|emacs|emacs-[0-9.]*)$
+backup ^(stamp-oldxmenu|prefix-args|temacs|emacs|TAGS-LISP|emacs-[0-9.]*)$
 
 # arch-tag: 277cc7ae-b3f5-44af-abf1-84c073164543


--- orig/src/alloc.c
+++ mod/src/alloc.c
@@ -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);
     }
 }
 
@@ -5792,6 +5903,7 @@
   defsubr (&Smake_marker);
   defsubr (&Spurecopy);
   defsubr (&Sgarbage_collect);
+  defsubr (&Sgarbage_collect_dump);
   defsubr (&Smemory_limit);
   defsubr (&Smemory_use_counts);
 


--- orig/src/bytecode.c
+++ mod/src/bytecode.c
@@ -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);
     }
 }
 


--- orig/src/eval.c
+++ mod/src/eval.c
@@ -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);
     }
 }
 


--- orig/src/fns.c
+++ mod/src/fns.c
@@ -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;
 		    }
 		}


--- orig/src/keyboard.c
+++ mod/src/keyboard.c
@@ -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);
       }
   }
 }


--- orig/src/lisp.h
+++ mod/src/lisp.h
@@ -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);