From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: Florian Weimer Newsgroups: gmane.emacs.devel Subject: Re: Debugging memory leaks/stale references Date: Mon, 27 Sep 2004 21:40:57 +0200 Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Message-ID: <871xgnmree.fsf@deneb.enyo.de> References: <87d60fjzdg.fsf@deneb.enyo.de> NNTP-Posting-Host: deer.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-Trace: sea.gmane.org 1096314143 18579 80.91.229.6 (27 Sep 2004 19:42:23 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Mon, 27 Sep 2004 19:42:23 +0000 (UTC) Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Mon Sep 27 21:42:01 2004 Return-path: Original-Received: from lists.gnu.org ([199.232.76.165]) by deer.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 1CC1Nb-0008BA-00 for ; Mon, 27 Sep 2004 21:41:49 +0200 Original-Received: from localhost ([127.0.0.1] helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.33) id 1CC1Tk-00082X-GE for ged-emacs-devel@m.gmane.org; Mon, 27 Sep 2004 15:48:08 -0400 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.33) id 1CC1Tb-000822-UN for emacs-devel@gnu.org; Mon, 27 Sep 2004 15:48:00 -0400 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.33) id 1CC1TY-00081b-II for emacs-devel@gnu.org; Mon, 27 Sep 2004 15:47:59 -0400 Original-Received: from [199.232.76.173] (helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.33) id 1CC1TY-00081Y-FF for emacs-devel@gnu.org; Mon, 27 Sep 2004 15:47:56 -0400 Original-Received: from [212.9.189.167] (helo=mail.enyo.de) by monty-python.gnu.org with esmtp (TLSv1:RC4-SHA:128) (Exim 4.34) id 1CC1Mt-0002v7-1A for emacs-devel@gnu.org; Mon, 27 Sep 2004 15:41:04 -0400 Original-Received: (debugging) helo=deneb.enyo.de ip=212.9.189.171 name=deneb.enyo.de Original-Received: from deneb.enyo.de ([212.9.189.171]) by mail.enyo.de with esmtp id 1CC1Mo-0002EU-MS for emacs-devel@gnu.org; Mon, 27 Sep 2004 21:40:58 +0200 Original-Received: from fw by deneb.enyo.de with local (Exim 4.34) id 1CC1Mn-0001Ya-JR for emacs-devel@gnu.org; Mon, 27 Sep 2004 21:40:57 +0200 Original-To: emacs-devel@gnu.org In-Reply-To: (Simon Josefsson's message of "Tue, 21 Sep 2004 21:49:01 +0200") X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: main.gmane.org gmane.emacs.devel:27624 X-Report-Spam: http://spam.gmane.org/gmane.emacs.devel:27624 * 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);