Mercurial > hg > xemacs-beta

changeset 5143:186aebf7f6c6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merge
author Ben Wing <ben@xemacs.org>
date Sat, 13 Mar 2010 11:38:54 -0600
parents e5380fdaf8f1 (current diff) f965e31a35f0 (diff)
children 9f2f39c80660
files modules/ChangeLog src/ChangeLog src/event-stream.c src/events.c src/lisp.h
diffstat 43 files changed, 309 insertions(+), 217 deletions(-) [+]
line wrap: on
line diff
--- a/man/ChangeLog	Sat Mar 13 05:38:34 2010 -0600
+++ b/man/ChangeLog	Sat Mar 13 11:38:54 2010 -0600
@@ -1,3 +1,11 @@
+2010-03-13  Ben Wing  <ben@xemacs.org>
+
+	* internals/internals.texi (Working with Lisp Objects):
+	* internals/internals.texi (Writing Macros):
+	* internals/internals.texi (lrecords):
+	More rewriting to correspond with changes from
+	*LRECORD* to *LISP_OBJECT*.
+
 2010-03-05  Ben Wing  <ben@xemacs.org>
 
 	* internals/internals.texi (Introduction to Allocation):
--- a/man/internals/internals.texi	Sat Mar 13 05:38:34 2010 -0600
+++ b/man/internals/internals.texi	Sat Mar 13 11:38:54 2010 -0600
@@ -5275,8 +5275,8 @@
 returned (created using @samp{wrap_<type>}, if necessary).
 
 @c #### declaration
-@item DECLARE_LRECORD (<type>, Lisp_<Type>)
-Declares an @samp{lrecord} for @samp{<Type>}, which is the unit of
+@item DECLARE_LISP_OBJECT (<type>, Lisp_<Type>)
+Declares a Lisp object for @samp{<Type>}, which is the unit of
 allocation.
 
 @item #define X<TYPE>(x) XRECORD (x, <type>, Lisp_<Type>)
@@ -5342,24 +5342,24 @@
 
 @enumerate
 @item
-create @var{foo}.h
-@item
-create @var{foo}.c
-@item
-add definitions of @code{syms_of_@var{foo}}, etc. to @file{@var{foo}.c}
-@item
-add declarations of @code{syms_of_@var{foo}}, etc. to @file{symsinit.h}
-@item
-add calls to @code{syms_of_@var{foo}}, etc. to @file{emacs.c}
-@item
-add definitions of macros like @code{CHECK_@var{FOO}} and
+Create @var{foo}.h
+@item
+Create @var{foo}.c
+@item
+Add definitions of @code{syms_of_@var{foo}}, etc. to @file{@var{foo}.c}
+@item
+Add declarations of @code{syms_of_@var{foo}}, etc. to @file{symsinit.h}
+@item
+Add calls to @code{syms_of_@var{foo}}, etc. to @file{emacs.c}
+@item
+Add definitions of macros like @code{CHECK_@var{FOO}} and
 @code{@var{FOO}P} to @file{@var{foo}.h}
 @item
-add the new type index to @code{enum lrecord_type}
-@item
-add a DEFINE_LRECORD_IMPLEMENTATION call to @file{@var{foo}.c}
-@item
-add an INIT_LRECORD_IMPLEMENTATION call to @code{syms_of_@var{foo}.c}
+Add the new type index to @code{enum lrecord_type}
+@item
+Add a @code{DEFINE_*_LISP_OBJECT()} to @file{@var{foo}.c}
+@item
+Add an @code{INIT_LISP_OBJECT} call to @code{syms_of_@var{foo}.c}
 @end enumerate
 
 
@@ -5842,11 +5842,12 @@
 @cindex inline functions, headers
 @cindex header files, inline functions
 Every header which contains inline functions, either directly by using
-@code{DECLARE_INLINE_HEADER} or indirectly by using @code{DECLARE_LRECORD} must
-be added to @file{inline.c}'s includes to make the optimization
-described above work.  (Optimization note: if all INLINE_HEADER
-functions are in fact inlined in all translation units, then the linker
-can just discard @code{inline.o}, since it contains only unreferenced code).
+@code{DECLARE_INLINE_HEADER} or indirectly by using
+@code{DECLARE_LISP_OBJECT} must be added to @file{inline.c}'s includes
+to make the optimization described above work.  (Optimization note: if
+all INLINE_HEADER functions are in fact inlined in all translation
+units, then the linker can just discard @code{inline.o}, since it
+contains only unreferenced code).
 
 The three golden rules of macros:
 
@@ -8551,10 +8552,7 @@
 beginning.  lcrecords, however, actually have a
 @code{struct old_lcrecord_header}.  This, in turn, has a @code{struct
 lrecord_header} at its beginning, so sanity is preserved; but it also
-has a pointer used to chain all lcrecords together, and a special ID
-field used to distinguish one lcrecord from another. (This field is used
-only for debugging and could be removed, but the space gain is not
-significant.)
+has a pointer used to chain all lcrecords together.
 
 @strong{lcrecords are now obsolete when using the write-barrier-based
 collector.}
--- a/modules/ChangeLog	Sat Mar 13 05:38:34 2010 -0600
+++ b/modules/ChangeLog	Sat Mar 13 11:38:54 2010 -0600
@@ -7,6 +7,25 @@
 	Fix file to follow GNU coding standards for indentation, spacing
 	before parens.
 
+2010-03-13  Ben Wing  <ben@xemacs.org>
+
+	* postgresql/postgresql.c (print_pgconn):
+	* postgresql/postgresql.c (print_pgresult):
+	printing_unreadable_object -> printing_unreadable_object_fmt.
+
+2010-03-13  Ben Wing  <ben@xemacs.org>
+
+	* ldap/eldap.c (print_ldap):
+	printing_unreadable_object -> printing_unreadable_object_fmt.
+
+2010-03-07  Ben Wing  <ben@xemacs.org>
+
+	* postgresql/postgresql.c (finalize_pgconn):
+	* postgresql/postgresql.c (finalize_pgresult):
+	* ldap/eldap.c (finalize_ldap):
+	Fix the finalizers to go with the new calling sequence.  Done
+	previously but somehow got lost.
+
 2010-03-05  Ben Wing  <ben@xemacs.org>
 
 	* postgresql/postgresql.c (allocate_pgconn):
--- a/modules/ldap/eldap.c	Sat Mar 13 05:38:34 2010 -0600
+++ b/modules/ldap/eldap.c	Sat Mar 13 11:38:54 2010 -0600
@@ -130,7 +130,7 @@
   Lisp_LDAP *ldap = XLDAP (obj);
 
   if (print_readably)
-    printing_unreadable_object ("#<ldap %s>", XSTRING_DATA (ldap->host));
+    printing_unreadable_object_fmt ("#<ldap %s>", XSTRING_DATA (ldap->host));
 
   write_fmt_string_lisp (printcharfun, "#<ldap %S", 1, ldap->host);
   if (!ldap->ld)
@@ -149,9 +149,9 @@
 }
 
 static void
-finalize_ldap (void *header)
+finalize_ldap (Lisp_Object obj)
 {
-  Lisp_LDAP *ldap = (Lisp_LDAP *) header;
+  Lisp_LDAP *ldap = XLDAP (obj);
 
   if (ldap->ld)
     ldap_unbind (ldap->ld);
--- a/modules/postgresql/postgresql.c	Sat Mar 13 05:38:34 2010 -0600
+++ b/modules/postgresql/postgresql.c	Sat Mar 13 11:38:54 2010 -0600
@@ -253,7 +253,7 @@
     strcpy (buf, "#<PGconn connecting>"); /* evil! */
 
   if (print_readably)
-    printing_unreadable_object ("%s", buf);
+    printing_unreadable_object_fmt ("%s", buf);
   else
     write_cistring (printcharfun, buf);
 }
@@ -295,9 +295,9 @@
 #else /* not RUNNING_XEMACS_21_4 */
 
 static void
-finalize_pgconn (void *header)
+finalize_pgconn (Lisp_Object obj)
 {
-  Lisp_PGconn *pgconn = (Lisp_PGconn *)header;
+  Lisp_PGconn *pgconn = XPGCONN (obj);
 
   if (pgconn->pgconn)
     {
@@ -401,7 +401,7 @@
     strcpy (buf, "#<PGresult DEAD>"); /* evil! */
 
   if (print_readably)
-    printing_unreadable_object ("%s", buf);
+    printing_unreadable_object_fmt ("%s", buf);
   else
     write_cistring (printcharfun, buf);
 }
@@ -447,9 +447,9 @@
 #else /* not RUNNING_XEMACS_21_4 */
 
 static void
-finalize_pgresult (void *header)
+finalize_pgresult (Lisp_Object obj)
 {
-  Lisp_PGresult *pgresult = (Lisp_PGresult *)header;
+  Lisp_PGresult *pgresult = XPGRESULT (obj);
 
   if (pgresult->pgresult)
     {
--- a/src/ChangeLog	Sat Mar 13 05:38:34 2010 -0600
+++ b/src/ChangeLog	Sat Mar 13 11:38:54 2010 -0600
@@ -43,6 +43,137 @@
 	jitter, apparently as first the image gets moved then redrawn in
 	the correct offset position.  #### Not sure how to fix this.
 
+2010-03-13  Ben Wing  <ben@xemacs.org>
+
+	* alloc.c (alloc_sized_lrecord_1):
+	* alloc.c (alloc_sized_lrecord_array):
+	* alloc.c (old_alloc_sized_lcrecord):
+	* alloc.c (disksave_object_finalization_1):
+	* alloc.c (mark_lcrecord_list):
+	* alloc.c (alloc_managed_lcrecord):
+	* alloc.c (free_managed_lcrecord):
+	* alloc.c (tick_lcrecord_stats):
+	* alloc.c (sweep_lcrecords_1):
+	* buffer.c (print_buffer):
+	* buffer.c (DEFVAR_BUFFER_LOCAL_1):
+	* casetab.c:
+	* casetab.c (print_case_table):
+	* console.c (print_console):
+	* console.c (DEFVAR_CONSOLE_LOCAL_1):
+	* data.c (print_weak_list):
+	* data.c (print_weak_box):
+	* data.c (print_ephemeron):
+	* data.c (ephemeron_equal):
+	* database.c (print_database):
+	* database.c (finalize_database):
+	* device-msw.c (sync_printer_with_devmode):
+	* device-msw.c (print_devmode):
+	* device-msw.c (finalize_devmode):
+	* device.c:
+	* device.c (print_device):
+	* elhash.c:
+	* elhash.c (print_hash_table):
+	* eval.c (print_subr):
+	* eval.c (print_multiple_value):
+	* event-stream.c (event_stream_resignal_wakeup):
+	* events.c (clear_event_resource):
+	* events.c (zero_event):
+	* events.c (print_event):
+	* extents.c:
+	* extents.c (print_extent):
+	* file-coding.c (print_coding_system):
+	* font-mgr.c:
+	* font-mgr.c (Ffc_init):
+	* frame.c:
+	* frame.c (print_frame):
+	* gc.c:
+	* gc.c (GC_CHECK_NOT_FREE):
+	* glyphs.c:
+	* glyphs.c (print_image_instance):
+	* glyphs.c (print_glyph):
+	* gui.c (print_gui_item):
+	* gui.c (copy_gui_item):
+	* keymap.c (print_keymap):
+	* keymap.c (MARKED_SLOT):
+	* lisp.h:
+	* lisp.h (struct Lisp_String):
+	* lisp.h (DEFUN):
+	* lisp.h (DEFUN_NORETURN):
+	* lrecord.h:
+	* lrecord.h (NORMAL_LISP_OBJECT_UID):
+	* lrecord.h (struct lrecord_header):
+	* lrecord.h (set_lheader_implementation):
+	* lrecord.h (struct old_lcrecord_header):
+	* lrecord.h (struct free_lcrecord_header):
+	* marker.c (print_marker):
+	* mule-charset.c:
+	* mule-charset.c (print_charset):
+	* objects.c (print_color_instance):
+	* objects.c (print_font_instance):
+	* objects.c (finalize_font_instance):
+	* print.c (print_cons):
+	* print.c (printing_unreadable_object_fmt):
+	* print.c (printing_unreadable_lisp_object):
+	* print.c (external_object_printer):
+	* print.c (internal_object_printer):
+	* print.c (debug_p4):
+	* print.c (ext_print_begin):
+	* process.c (print_process):
+	* rangetab.c (print_range_table):
+	* rangetab.c (range_table_equal):
+	* scrollbar.c (free_scrollbar_instance):
+	* specifier.c (print_specifier):
+	* specifier.c (finalize_specifier):
+	* symbols.c (guts_of_unbound_marker):
+	* symeval.h:
+	* symeval.h (DEFVAR_SYMVAL_FWD):
+	* tooltalk.c:
+	* tooltalk.c (print_tooltalk_message):
+	* tooltalk.c (print_tooltalk_pattern):
+	* ui-gtk.c (ffi_object_printer):
+	* ui-gtk.c (emacs_gtk_object_printer):
+	* ui-gtk.c (emacs_gtk_boxed_printer):
+	* window.c (print_window):
+	* window.c (free_window_mirror):
+	* window.c (debug_print_window):
+	* xemacs.def.in.in:
+	(1) printing_unreadable_object -> printing_unreadable_object_fmt.
+	(2) printing_unreadable_lcrecord -> printing_unreadable_lisp_object
+	    and fix up so it no longer requires an lcrecord.
+
+	These previous changes eliminate most of the remaining places where
+	the terms `lcrecord' and `lrecord' occurred outside of specialized
+	code.
+
+	(3) Fairly major change: Reduce the number of words in an lcrecord
+	from 3 to 2.  The third word consisted of a uid that duplicated the
+	lrecord uid, and a single free bit, which was moved into the lrecord
+	structure.  This reduces the size of the `uid' slot from 21 bits to
+	20 bits.  Arguably this isn't enough -- we could easily have more than
+	1,000,000 or so objects created in a session.  The answer is
+	   (a) It doesn't really matter if we overflow the uid field because
+	       it's only used for debugging, to identify an object uniquely
+	       (or pretty much so).
+	   (b) If we cared about it overflowing and wanted to reduce this,
+	       we could make it so that cons, string, float and certain other
+	       frob-block types that never print out the uid simply don't
+	       store a uid in them and don't increment the lrecord_uid_counter.
+
+	(4) In conjunction with (3), create new macro NORMAL_LISP_OBJECT_UID()
+	    and use it to abstract out the differences between NEWGC and old-GC
+	    in accessing the `uid' value from a "normal Lisp Object pointer".
+
+	(5) In events.c, use zero_nonsized_lisp_object() in place of custom-
+	    written equivalent.  In font-mgr.c use external_object_printer()
+	    in place of custom-written equivalents.
+2010-03-07  Ben Wing  <ben@xemacs.org>
+
+	* number.c (bignum_finalize):
+	* number.c (ratio_finalize):
+	* number.c (bigfloat_finalize):
+	Fix the finalizers to go with the new calling sequence.  Done
+	previously but somehow got lost.
+
 2010-03-06  Ben Wing  <ben@xemacs.org>
 
 	* frame.c (change_frame_size_1):
--- a/src/alloc.c	Sat Mar 13 05:38:34 2010 -0600
+++ b/src/alloc.c	Sat Mar 13 11:38:54 2010 -0600
@@ -590,7 +590,6 @@
   lheader = (struct lrecord_header *) mc_alloc (size);
   gc_checking_assert (LRECORD_FREE_P (lheader));
   set_lheader_implementation (lheader, implementation);
-  lheader->uid = lrecord_uid_counter++;
 #ifdef ALLOC_TYPE_STATS
   inc_lrecord_stats (size, lheader);
 #endif /* ALLOC_TYPE_STATS */
@@ -651,7 +650,6 @@
     {
       struct lrecord_header *lh = (struct lrecord_header *) start;
       set_lheader_implementation (lh, implementation);
-      lh->uid = lrecord_uid_counter++;
 #ifdef ALLOC_TYPE_STATS
       inc_lrecord_stats (size, lh);
 #endif /* not ALLOC_TYPE_STATS */
@@ -693,12 +691,6 @@
   lcheader = (struct old_lcrecord_header *) allocate_lisp_storage (size);
   set_lheader_implementation (&lcheader->lheader, implementation);
   lcheader->next = all_lcrecords;
-#if 1                           /* mly prefers to see small ID numbers */
-  lcheader->uid = lrecord_uid_counter++;
-#else				/* jwz prefers to see real addrs */
-  lcheader->uid = (int) &lcheader;
-#endif
-  lcheader->free = 0;
   all_lcrecords = lcheader;
   INCREMENT_CONS_COUNTER (size, implementation->name);
   return wrap_pointer_1 (lcheader);
@@ -765,13 +757,13 @@
       struct lrecord_header *objh = &header->lheader;
       const struct lrecord_implementation *imp = LHEADER_IMPLEMENTATION (objh);
 #if 0 /* possibly useful for debugging */
-      if (!RECORD_DUMPABLE (objh) && !header->free)
+      if (!RECORD_DUMPABLE (objh) && !objh->free)
 	{
 	  stderr_out ("Disksaving a non-dumpable object: ");
 	  debug_print (wrap_pointer_1 (header));
 	}
 #endif
-      if (imp->disksaver && !header->free)
+      if (imp->disksaver && !objh->free)
 	(imp->disksaver) (wrap_pointer_1 (header));
     }
 #endif /* not NEW_GC */
@@ -3175,7 +3167,7 @@
 	 ! list->implementation->frob_block_p
 	 &&
 	 /* Only free lcrecords should be here. */
-	 free_header->lcheader.free
+	 lheader->free
 	 &&
 	 /* The type of the lcrecord must be right. */
 	 lheader->type == lrecord_type_free
@@ -3228,7 +3220,7 @@
       /* There should be no other pointers to the free list. */
       assert (! MARKED_RECORD_HEADER_P (lheader));
       /* Only free lcrecords should be here. */
-      assert (free_header->lcheader.free);
+      assert (lheader->free);
       assert (lheader->type == lrecord_type_free);
       /* Only lcrecords should be here. */
       assert (! (list->implementation->frob_block_p));
@@ -3243,7 +3235,7 @@
 #endif /* ERROR_CHECK_GC */
 
       list->free = free_header->chain;
-      free_header->lcheader.free = 0;
+      lheader->free = 0;
       /* Put back the correct type, as we set it to lrecord_type_free. */
       lheader->type = list->implementation->lrecord_type_index;
       zero_sized_lisp_object (val, list->size);
@@ -3297,7 +3289,7 @@
      putting a window configuration on the wrong free list. */
   gc_checking_assert (lisp_object_size (lcrecord) == list->size);
   /* Make sure the object isn't already freed. */
-  gc_checking_assert (!free_header->lcheader.free);
+  gc_checking_assert (!lheader->free);
   /* Freeing stuff in dumped memory is bad.  If you trip this, you
      may need to check for this before freeing. */
   gc_checking_assert (!OBJECT_DUMPED_P (lcrecord));
@@ -3311,7 +3303,7 @@
      around an lrecord of apparently correct type but bogus junk in it. */
   MARK_LRECORD_AS_FREE (lheader);
   free_header->chain = list->free;
-  free_header->lcheader.free = 1;
+  lheader->free = 1;
   list->free = lcrecord;
 }
 
@@ -3630,7 +3622,7 @@
 inline static void
 tick_lcrecord_stats (const struct lrecord_header *h, int free_p)
 {
-  if (((struct old_lcrecord_header *) h)->free)
+  if (h->free)
     {
       gc_checking_assert (!free_p);
       tick_lrecord_stats (h, ALLOC_ON_FREE_LIST);
@@ -3666,7 +3658,7 @@
 
       GC_CHECK_LHEADER_INVARIANTS (h);
 
-      if (! MARKED_RECORD_HEADER_P (h) && ! header->free)
+      if (! MARKED_RECORD_HEADER_P (h) && !h->free)
 	{
 	  if (LHEADER_IMPLEMENTATION (h)->finalizer)
 	    LHEADER_IMPLEMENTATION (h)->finalizer (wrap_pointer_1 (h));
--- a/src/buffer.c	Sat Mar 13 05:38:34 2010 -0600
+++ b/src/buffer.c	Sat Mar 13 11:38:54 2010 -0600
@@ -302,9 +302,9 @@
   if (print_readably)
     {
       if (!BUFFER_LIVE_P (b))
-	printing_unreadable_object ("#<killed buffer>");
+	printing_unreadable_object_fmt ("#<killed buffer>");
       else
-	printing_unreadable_object ("#<buffer %s>", XSTRING_DATA (b->name));
+	printing_unreadable_object_fmt ("#<buffer %s>", XSTRING_DATA (b->name));
     }
   else if (!BUFFER_LIVE_P (b))
     write_ascstring (printcharfun, "#<killed buffer>");
@@ -2175,8 +2175,6 @@
 	  1  /* lisp_readonly bit */					 \
 	},								 \
 	0, /* next */							 \
-	0, /* uid  */							 \
-	0  /* free */							 \
       },								 \
       &(buffer_local_flags.field_name),					 \
       forward_type							 \
--- a/src/casetab.c	Sat Mar 13 05:38:34 2010 -0600
+++ b/src/casetab.c	Sat Mar 13 11:38:54 2010 -0600
@@ -105,12 +105,12 @@
 {
   Lisp_Case_Table *ct = XCASE_TABLE (obj);
   if (print_readably)
-    printing_unreadable_lcrecord (obj, 0);
+    printing_unreadable_lisp_object (obj, 0);
   write_fmt_string_lisp
     (printcharfun, "#<case-table downcase=%s upcase=%s canon=%s eqv=%s ", 4,
      CASE_TABLE_DOWNCASE (ct), CASE_TABLE_UPCASE (ct),
      CASE_TABLE_CANON (ct), CASE_TABLE_EQV (ct));
-  write_fmt_string (printcharfun, "0x%x>", ct->header.uid);
+  write_fmt_string (printcharfun, "0x%x>", NORMAL_LISP_OBJECT_UID (ct));
 }
 
 static const struct memory_description case_table_description [] = {
--- a/src/console.c	Sat Mar 13 05:38:34 2010 -0600
+++ b/src/console.c	Sat Mar 13 11:38:54 2010 -0600
@@ -163,14 +163,14 @@
   struct console *con = XCONSOLE (obj);
 
   if (print_readably)
-    printing_unreadable_lcrecord (obj, XSTRING_DATA (con->name));
+    printing_unreadable_lisp_object (obj, XSTRING_DATA (con->name));
 
   write_fmt_string (printcharfun, "#<%s-console",
 		    !CONSOLE_LIVE_P (con) ? "dead" : CONSOLE_TYPE_NAME (con));
   if (CONSOLE_LIVE_P (con) && !NILP (CONSOLE_CONNECTION (con)))
     write_fmt_string_lisp (printcharfun, " on %S", 1,
 			   CONSOLE_CONNECTION (con));
-  write_fmt_string (printcharfun, " 0x%x>", con->header.uid);
+  write_fmt_string (printcharfun, " 0x%x>", NORMAL_LISP_OBJECT_UID (con));
 }
 
 DEFINE_NODUMP_LISP_OBJECT ("console", console, mark_console,
@@ -1351,8 +1351,6 @@
 	  1  /* lisp_readonly bit */					    \
 	},								    \
 	0, /* next */							    \
-	0, /* uid  */							    \
-	0  /* free */							    \
       },								    \
       &(console_local_flags.field_name),				    \
       forward_type							    \
--- a/src/data.c	Sat Mar 13 05:38:34 2010 -0600
+++ b/src/data.c	Sat Mar 13 11:38:54 2010 -0600
@@ -2614,7 +2614,7 @@
 		 int UNUSED (escapeflag))
 {
   if (print_readably)
-    printing_unreadable_lcrecord (obj, 0);
+    printing_unreadable_lisp_object (obj, 0);
 
   write_fmt_string_lisp (printcharfun, "#<weak-list %s %S>", 2,
 			 encode_weak_list_type (XWEAK_LIST (obj)->type),
@@ -3090,7 +3090,7 @@
 		int UNUSED (escapeflag))
 {
   if (print_readably)
-    printing_unreadable_lcrecord (obj, 0);
+    printing_unreadable_lisp_object (obj, 0);
   write_fmt_string (printcharfun, "#<weak-box>"); /* #### fix */
 }
 
@@ -3312,7 +3312,7 @@
 		 int UNUSED (escapeflag))
 {
   if (print_readably)
-    printing_unreadable_lcrecord (obj, 0);
+    printing_unreadable_lisp_object (obj, 0);
   write_fmt_string (printcharfun, "#<ephemeron>"); /* #### fix */
 }
 
--- a/src/database.c	Sat Mar 13 05:38:34 2010 -0600
+++ b/src/database.c	Sat Mar 13 11:38:54 2010 -0600
@@ -217,7 +217,7 @@
   Lisp_Database *db = XDATABASE (obj);
 
   if (print_readably)
-    printing_unreadable_lcrecord (obj, 0);
+    printing_unreadable_lisp_object (obj, 0);
 
   write_fmt_string_lisp (printcharfun, "#<database \"%s\" (%s/%s/",
 			 3, db->fname, db->funcs->get_type (db),
@@ -232,7 +232,7 @@
                          XSYMBOL_NAME (XCODING_SYSTEM_NAME
                                        (db->coding_system)));
 
-  write_fmt_string (printcharfun, "0x%x>", db->header.uid);
+  write_fmt_string (printcharfun, "0x%x>", NORMAL_LISP_OBJECT_UID (db));
 }
 
 static void
--- a/src/device-msw.c	Sat Mar 13 05:38:34 2010 -0600
+++ b/src/device-msw.c	Sat Mar 13 11:38:54 2010 -0600
@@ -665,7 +665,7 @@
 	     suffix. */
 	  Ibyte new_connext[20];
 
-	  qxesprintf (new_connext, ":%X", d->header.uid);
+	  qxesprintf (new_connext, ":%X", NORMAL_LISP_OBJECT_UID (d));
 	  new_connection = concat2 (devname, build_istring (new_connext));
 	}
       DEVICE_CONNECTION (d) = new_connection;
@@ -1148,13 +1148,13 @@
 {
   Lisp_Devmode *dm = XDEVMODE (obj);
   if (print_readably)
-    printing_unreadable_lcrecord (obj, 0);
+    printing_unreadable_lisp_object (obj, 0);
   write_ascstring (printcharfun, "#<msprinter-settings");
   if (!NILP (dm->printer_name))
     write_fmt_string_lisp (printcharfun, " for %S", 1, dm->printer_name);
   if (!NILP (dm->device))
     write_fmt_string_lisp (printcharfun, " (currently on %s)", 1, dm->device);
-  write_fmt_string (printcharfun, " 0x%x>", dm->header.uid);
+  write_fmt_string (printcharfun, " 0x%x>", NORMAL_LISP_OBJECT_UID (dm));
 }
 
 static void
--- a/src/device.c	Sat Mar 13 05:38:34 2010 -0600
+++ b/src/device.c	Sat Mar 13 11:38:54 2010 -0600
@@ -160,13 +160,13 @@
   struct device *d = XDEVICE (obj);
 
   if (print_readably)
-    printing_unreadable_lcrecord (obj, XSTRING_DATA (d->name));
+    printing_unreadable_lisp_object (obj, XSTRING_DATA (d->name));
 
   write_fmt_string (printcharfun, "#<%s-device", !DEVICE_LIVE_P (d) ? "dead" :
 		    DEVICE_TYPE_NAME (d));
   if (DEVICE_LIVE_P (d) && !NILP (DEVICE_CONNECTION (d)))
     write_fmt_string_lisp (printcharfun, " on %S", 1, DEVICE_CONNECTION (d));
-  write_fmt_string (printcharfun, " 0x%x>", d->header.uid);
+  write_fmt_string (printcharfun, " 0x%x>", NORMAL_LISP_OBJECT_UID (d));
 }
 
 DEFINE_NODUMP_LISP_OBJECT ("device", device,
--- a/src/elhash.c	Sat Mar 13 05:38:34 2010 -0600
+++ b/src/elhash.c	Sat Mar 13 11:38:54 2010 -0600
@@ -395,7 +395,7 @@
   if (print_readably)
     write_ascstring (printcharfun, ")");
   else
-    write_fmt_string (printcharfun, " 0x%x>", ht->header.uid);
+    write_fmt_string (printcharfun, " 0x%x>", NORMAL_LISP_OBJECT_UID (ht));
 }
 
 #ifndef NEW_GC
--- a/src/eval.c	Sat Mar 13 05:38:34 2010 -0600
+++ b/src/eval.c	Sat Mar 13 11:38:54 2010 -0600
@@ -455,7 +455,7 @@
   const Ascbyte *trailer = subr->prompt ? " (interactive)>" : ">";
 
   if (print_readably)
-    printing_unreadable_object ("%s%s%s", header, name, trailer);
+    printing_unreadable_object_fmt ("%s%s%s", header, name, trailer);
 
   write_ascstring (printcharfun, header);
   write_ascstring (printcharfun, name);
@@ -4605,7 +4605,7 @@
 
   if (print_readably)
     {
-      printing_unreadable_object ("multiple values");
+      printing_unreadable_object_fmt ("multiple values");
     }
 
   write_fmt_string (printcharfun,
--- a/src/event-stream.c	Sat Mar 13 05:38:34 2010 -0600
+++ b/src/event-stream.c	Sat Mar 13 11:38:54 2010 -0600
@@ -1121,7 +1121,7 @@
   op = XCAR (rest);
   timeout = XTIMEOUT (op);
   /* We make sure to snarf the data out of the timeout object before
-     we free it with free_managed_lcrecord(). */
+     we free it with free_normal_lisp_object(). */
   id = timeout->id;
   *function = timeout->function;
   *object = timeout->object;
--- a/src/events.c	Sat Mar 13 05:38:34 2010 -0600
+++ b/src/events.c	Sat Mar 13 11:38:54 2010 -0600
@@ -62,7 +62,7 @@
 /*                       definition of event object                     */
 /************************************************************************/
 
-/* #### Ad-hoc hack.  Should be part of define_lrecord_implementation */
+/* #### Ad-hoc hack.  Should be part of DEFINE_*_GENERAL_LISP_OBJECT. */
 void
 clear_event_resource (void)
 {
@@ -91,12 +91,7 @@
 void
 zero_event (Lisp_Event *e)
 {
-  /* Preserve the old UID for this event, for tracking it */
-  unsigned int old_uid = e->lheader.uid;
-
-  xzero (*e);
-  set_lheader_implementation (&e->lheader, &lrecord_event);
-  e->lheader.uid = old_uid;
+  zero_nonsized_lisp_object (wrap_event (e));
   set_event_type (e, empty_event);
   SET_EVENT_CHANNEL (e, Qnil);
   SET_EVENT_NEXT (e, Qnil);
@@ -313,7 +308,7 @@
 	     int UNUSED (escapeflag))
 {
   if (print_readably)
-    printing_unreadable_object ("#<event>");
+    printing_unreadable_object_fmt ("#<event>");
 
   switch (XEVENT (obj)->event_type)
     {
--- a/src/extents.c	Sat Mar 13 05:38:34 2010 -0600
+++ b/src/extents.c	Sat Mar 13 11:38:54 2010 -0600
@@ -3231,7 +3231,7 @@
 
 /* These are the basic helper functions for handling the allocation of
    extent objects.  They are similar to the functions for other
-   lrecord objects.  allocate_extent() is in alloc.c, not here. */
+   frob-block objects.  allocate_extent() is in alloc.c, not here. */
 
 static Lisp_Object
 mark_extent (Lisp_Object obj)
@@ -3333,9 +3333,9 @@
       if (print_readably)
 	{
 	  if (!EXTENT_LIVE_P (XEXTENT (obj)))
-	    printing_unreadable_object ("#<destroyed extent>");
+	    printing_unreadable_object_fmt ("#<destroyed extent>");
 	  else
-	    printing_unreadable_object ("#<extent 0x%lx>",
+	    printing_unreadable_object_fmt ("#<extent 0x%lx>",
 		   (long) XEXTENT (obj));
 	}
 
@@ -3353,7 +3353,7 @@
   else
     {
       if (print_readably)
-	printing_unreadable_object ("#<extent>");
+	printing_unreadable_object_fmt ("#<extent>");
       write_ascstring (printcharfun, "#<extent");
     }
   write_ascstring (printcharfun, ">");
--- a/src/file-coding.c	Sat Mar 13 05:38:34 2010 -0600
+++ b/src/file-coding.c	Sat Mar 13 11:38:54 2010 -0600
@@ -297,7 +297,7 @@
 {
   Lisp_Coding_System *c = XCODING_SYSTEM (obj);
   if (print_readably)
-    printing_unreadable_lcrecord (obj, 0);
+    printing_unreadable_lisp_object (obj, 0);
 
   write_fmt_string_lisp (printcharfun, "#<coding-system %s ", 1, c->name);
   print_coding_system_properties (obj, printcharfun);
--- a/src/font-mgr.c	Sat Mar 13 05:38:34 2010 -0600
+++ b/src/font-mgr.c	Sat Mar 13 11:38:54 2010 -0600
@@ -104,16 +104,6 @@
     }
 }
 
-static void
-print_fc_pattern (Lisp_Object obj, Lisp_Object printcharfun,
-		  int UNUSED(escapeflag))
-{
-  struct fc_pattern *c = XFC_PATTERN (obj);
-  if (print_readably)
-    printing_unreadable_object ("#<fc-pattern 0x%x>", c->header.uid);
-  write_fmt_string (printcharfun, "#<fc-pattern 0x%x>", c->header.uid);
-}
-
 /* #### We really need an equal method and a hash method (required if you
    have an equal method).  For the equal method, we can probably use one
    or both of
@@ -144,7 +134,7 @@
 };
 
 DEFINE_NODUMP_LISP_OBJECT ("fc-pattern", fc_pattern,
-			   0, print_fc_pattern, finalize_fc_pattern,
+			   0, external_object_printer, finalize_fc_pattern,
 			   0, 0, fcpattern_description,
 			   struct fc_pattern);
 
@@ -1106,24 +1096,14 @@
   p->fccfgPtr = 0;
 }
 
-static void
-print_fc_config (Lisp_Object obj, Lisp_Object printcharfun,
-		 int UNUSED(escapeflag))
-{
-  struct fc_config *c = XFC_CONFIG (obj);
-  if (print_readably)
-    printing_unreadable_object ("#<fc-config 0x%x>", c->header.uid);
-  write_fmt_string (printcharfun, "#<fc-config 0x%x>", c->header.uid);
-}
-
 static const struct memory_description fcconfig_description [] = {
   /* #### nothing here, is this right?? */
   { XD_END }
 };
 
 DEFINE_NODUMP_LISP_OBJECT ("fc-config", fc_config,
-			   0, print_fc_config, finalize_fc_config, 0, 0,
-			   fcconfig_description,
+			   0, external_object_printer, finalize_fc_config,
+			   0, 0, fcconfig_description,
 			   struct fc_config);
 
 DEFUN("fc-init", Ffc_init, 0, 0, 0, /*
--- a/src/frame.c	Sat Mar 13 05:38:34 2010 -0600
+++ b/src/frame.c	Sat Mar 13 11:38:54 2010 -0600
@@ -637,12 +637,12 @@
   struct frame *frm = XFRAME (obj);
 
   if (print_readably)
-    printing_unreadable_lcrecord (obj, XSTRING_DATA (frm->name));
+    printing_unreadable_lisp_object (obj, XSTRING_DATA (frm->name));
 
   write_fmt_string (printcharfun, "#<%s-frame ", !FRAME_LIVE_P (frm) ? "dead" :
 		    FRAME_TYPE_NAME (frm));
   print_internal (frm->name, printcharfun, 1);
-  write_fmt_string (printcharfun, " 0x%x>", frm->header.uid);
+  write_fmt_string (printcharfun, " 0x%x>", NORMAL_LISP_OBJECT_UID (frm));
 }
 
 DEFINE_NODUMP_LISP_OBJECT ("frame", frame,
--- a/src/gc.c	Sat Mar 13 05:38:34 2010 -0600
+++ b/src/gc.c	Sat Mar 13 11:38:54 2010 -0600
@@ -589,8 +589,8 @@
 #else /* not NEW_GC */
 #define GC_CHECK_NOT_FREE(lheader)					\
       gc_checking_assert (! LRECORD_FREE_P (lheader));			\
-      gc_checking_assert (LHEADER_IMPLEMENTATION (lheader)->frob_block_p ||	\
-			  ! ((struct old_lcrecord_header *) lheader)->free)
+      gc_checking_assert (LHEADER_IMPLEMENTATION (lheader)->frob_block_p || \
+			  ! (lheader)->free)
 #endif /* not NEW_GC */
 
 #ifdef USE_KKCC
--- a/src/glyphs.c	Sat Mar 13 05:38:34 2010 -0600
+++ b/src/glyphs.c	Sat Mar 13 11:38:54 2010 -0600
@@ -992,7 +992,7 @@
   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (obj);
 
   if (print_readably)
-    printing_unreadable_lcrecord (obj, 0);
+    printing_unreadable_lisp_object (obj, 0);
   write_fmt_string_lisp (printcharfun, "#<image-instance (%s) ", 1,
 			 Fimage_instance_type (obj));
   if (!NILP (ii->name))
@@ -1108,7 +1108,7 @@
 
   MAYBE_DEVMETH (DOMAIN_XDEVICE (ii->domain), print_image_instance,
 		 (ii, printcharfun, escapeflag));
-  write_fmt_string (printcharfun, " 0x%x>", ii->header.uid);
+  write_fmt_string (printcharfun, " 0x%x>", NORMAL_LISP_OBJECT_UID (ii));
 }
 
 static void
@@ -3707,11 +3707,11 @@
   Lisp_Glyph *glyph = XGLYPH (obj);
 
   if (print_readably)
-    printing_unreadable_lcrecord (obj, 0);
+    printing_unreadable_lisp_object (obj, 0);
 
   write_fmt_string_lisp (printcharfun, "#<glyph (%s", 1, Fglyph_type (obj));
   write_fmt_string_lisp (printcharfun, ") %S", 1, glyph->image);
-  write_fmt_string (printcharfun, "0x%x>", glyph->header.uid);
+  write_fmt_string (printcharfun, "0x%x>", NORMAL_LISP_OBJECT_UID (glyph));
 }
 
 /* Glyphs are equal if all of their display attributes are equal.  We
--- a/src/gui.c	Sat Mar 13 05:38:34 2010 -0600
+++ b/src/gui.c	Sat Mar 13 11:38:54 2010 -0600
@@ -693,9 +693,9 @@
   Lisp_Gui_Item *g = XGUI_ITEM (obj);
 
   if (print_readably)
-    printing_unreadable_lcrecord (obj, 0);
+    printing_unreadable_lisp_object (obj, 0);
 
-  write_fmt_string (printcharfun, "#<gui-item 0x%x>", g->header.uid);
+  write_fmt_string (printcharfun, "#<gui-item 0x%x>", NORMAL_LISP_OBJECT_UID (g));
 }
 
 Lisp_Object
--- a/src/keymap.c	Sat Mar 13 05:38:34 2010 -0600
+++ b/src/keymap.c	Sat Mar 13 11:38:54 2010 -0600
@@ -284,14 +284,14 @@
   /* This function can GC */
   Lisp_Keymap *keymap = XKEYMAP (obj);
   if (print_readably)
-    printing_unreadable_lcrecord (obj, 0);
+    printing_unreadable_lisp_object (obj, 0);
   write_ascstring (printcharfun, "#<keymap ");
   if (!NILP (keymap->name))
     {
       write_fmt_string_lisp (printcharfun, "%S ", 1, keymap->name);
     }
   write_fmt_string (printcharfun, "size %ld 0x%x>",
-		    (long) XINT (Fkeymap_fullness (obj)), keymap->header.uid);
+		    (long) XINT (Fkeymap_fullness (obj)), NORMAL_LISP_OBJECT_UID (keymap));
 }
 
 static const struct memory_description keymap_description[] = {
--- a/src/lisp.h	Sat Mar 13 05:38:34 2010 -0600
+++ b/src/lisp.h	Sat Mar 13 11:38:54 2010 -0600
@@ -3088,7 +3088,9 @@
       struct
 	{
 	  /* WARNING: Everything before ascii_begin must agree exactly with
-	     struct lrecord_header */
+	     struct lrecord_header. (Actually, the `free' field in old-GC
+	     overlaps with ascii_begin there; we can get away with this
+	     because in old-GC the `free' field is used only for lcrecords. */
 	  unsigned int type :8;
 #ifdef NEW_GC
 	  unsigned int lisp_readonly :1;
@@ -3938,7 +3940,6 @@
       1, /* mark bit */							\
       1, /* c_readonly bit */						\
       1, /* lisp_readonly bit */					\
-      0  /* unused */                                                   \
     },									\
     min_args,								\
     max_args,								\
@@ -3958,7 +3959,6 @@
       1, /* mark bit */							\
       1, /* c_readonly bit */						\
       1, /* lisp_readonly bit */					\
-      0  /* unused */                                                   \
     },									\
     min_args,								\
     max_args,								\
@@ -6055,10 +6055,10 @@
 			      int UNUSED (escapeflag));
 void external_object_printer (Lisp_Object obj, Lisp_Object printcharfun,
 			      int UNUSED (escapeflag));
-MODULE_API DECLARE_DOESNT_RETURN (printing_unreadable_object (const CIbyte *,
+MODULE_API DECLARE_DOESNT_RETURN (printing_unreadable_object_fmt (const CIbyte *,
 							      ...))
        PRINTF_ARGS (1, 2);
-DECLARE_DOESNT_RETURN (printing_unreadable_lcrecord (Lisp_Object obj,
+DECLARE_DOESNT_RETURN (printing_unreadable_lisp_object (Lisp_Object obj,
 						     const Ibyte *name));
 
 extern Lisp_Object Qexternal_debugging_output;
--- a/src/lrecord.h	Sat Mar 13 05:38:34 2010 -0600
+++ b/src/lrecord.h	Sat Mar 13 11:38:54 2010 -0600
@@ -57,17 +57,13 @@
    Under NEW_GC, NORMAL_LISP_OBJECT_HEADER also resolves to `struct
    lrecord_header'.  Under old-GC, however, NORMAL_LISP_OBJECT_HEADER
    resolves to a `struct old_lcrecord_header' (note the `c'), which is a
-   larger structure -- on 32-bit machines it occupies 3 machine words
+   larger structure -- on 32-bit machines it occupies 2 machine words
    instead of 1.  Such an object is known internally as an "lcrecord".  The
    first word of `struct old_lcrecord_header' is an embedded `struct
    lrecord_header' with the same information as for frob-block objects;
    that way, all objects can be cast to a `struct lrecord_header' to
-   determine their type or other info.  The other words consist of a
-   pointer, used to thread all lcrecords together in one big linked list,
-   and a 32-bit structure that contains another UID field (#### which
-   should be deleted, as it is redundant; it dates back to the days when
-   the lrecord_header consisted of a pointer to an object's implementation
-   structure rather than an index).
+   determine their type or other info.  The other word is a pointer, used
+   to thread all lcrecords together in one big linked list.
 
    Under old-GC, normal objects (i.e. lcrecords) are allocated in
    individual chunks using the underlying allocator (i.e. xmalloc(), which
@@ -191,6 +187,7 @@
 #define NORMAL_LISP_OBJECT_HEADER struct lrecord_header
 #define FROB_BLOCK_LISP_OBJECT_HEADER struct lrecord_header
 #define LISP_OBJECT_FROB_BLOCK_P(obj) 0
+#define NORMAL_LISP_OBJECT_UID(obj) ((obj)->header.uid)
 #else /* not NEW_GC */
 #define ALLOC_NORMAL_LISP_OBJECT(type) alloc_automanaged_lcrecord (&lrecord_##type)
 #define ALLOC_SIZED_LISP_OBJECT(size, type) \
@@ -198,6 +195,7 @@
 #define NORMAL_LISP_OBJECT_HEADER struct old_lcrecord_header
 #define FROB_BLOCK_LISP_OBJECT_HEADER struct lrecord_header
 #define LISP_OBJECT_FROB_BLOCK_P(obj) (XRECORD_LHEADER_IMPLEMENTATION(obj)->frob_block_p)
+#define NORMAL_LISP_OBJECT_UID(obj) ((obj)->header.lheader.uid)
 #endif /* not NEW_GC */
 
 BEGIN_C_DECLS
@@ -238,10 +236,20 @@
   /* 1 if the object is readonly from lisp */
   unsigned int lisp_readonly :1;
 
+  /* The `free' field is currently used only for lcrecords under old-GC.
+     It is a flag that indicates whether this lcrecord is on a "free list".
+     Free lists are used to minimize the number of calls to malloc() when
+     we're repeatedly allocating and freeing a number of the same sort of
+     lcrecord.  Lcrecords on a free list always get marked in a different
+     fashion, so we can use this flag as a sanity check to make sure that
+     free lists only have freed lcrecords and there are no freed lcrecords
+     elsewhere. */
+  unsigned int free :1;
+
   /* The `uid' field is just for debugging/printing convenience.  Having
      this slot doesn't hurt us spacewise, since the bits are unused
      anyway. (The bits are used for strings, though.) */
-  unsigned int uid :21;
+  unsigned int uid :20;
 
 #endif /* not NEW_GC */
 };
@@ -265,6 +273,7 @@
   SLI_header->mark = 0;					\
   SLI_header->c_readonly = 0;				\
   SLI_header->lisp_readonly = 0;			\
+  SLI_header->free = 0;					\
   SLI_header->uid = lrecord_uid_counter++;		\
 } while (0)
 #endif /* not NEW_GC */
@@ -285,20 +294,6 @@
      out of memory chunks, and are able to find all unmarked members
      by sweeping through the elements of the list of chunks.  */
   struct old_lcrecord_header *next;
-
-  /* The `uid' field is just for debugging/printing convenience.
-     Having this slot doesn't hurt us much spacewise, since an
-     lcrecord already has the above slots plus malloc overhead. */
-  unsigned int uid :31;
-
-  /* The `free' field is a flag that indicates whether this lcrecord
-     is on a "free list".  Free lists are used to minimize the number
-     of calls to malloc() when we're repeatedly allocating and freeing
-     a number of the same sort of lcrecord.  Lcrecords on a free list
-     always get marked in a different fashion, so we can use this flag
-     as a sanity check to make sure that free lists only have freed
-     lcrecords and there are no freed lcrecords elsewhere. */
-  unsigned int free :1;
 };
 
 /* Used for lcrecords in an lcrecord-list. */
--- a/src/marker.c	Sat Mar 13 05:38:34 2010 -0600
+++ b/src/marker.c	Sat Mar 13 11:38:54 2010 -0600
@@ -60,7 +60,7 @@
   Lisp_Marker *marker = XMARKER (obj);
 
   if (print_readably)
-    printing_unreadable_object ("#<marker 0x%lx>", (long) marker);
+    printing_unreadable_object_fmt ("#<marker 0x%lx>", (long) marker);
 
   write_ascstring (printcharfun, GETTEXT ("#<marker "));
   if (!marker->buffer)
--- a/src/mule-charset.c	Sat Mar 13 05:38:34 2010 -0600
+++ b/src/mule-charset.c	Sat Mar 13 11:38:54 2010 -0600
@@ -141,7 +141,7 @@
   Lisp_Charset *cs = XCHARSET (obj);
 
   if (print_readably)
-    printing_unreadable_lcrecord
+    printing_unreadable_lisp_object
       (obj, XSTRING_DATA (XSYMBOL (XCHARSET_NAME (obj))->name));
 
   write_fmt_string_lisp (printcharfun, "#<charset %s %S %S %S", 4,
@@ -158,7 +158,7 @@
 		    CHARSET_GRAPHIC (cs),
 		    CHARSET_FINAL (cs));
   print_internal (CHARSET_REGISTRIES (cs), printcharfun, 0);
-  write_fmt_string (printcharfun, " 0x%x>", cs->header.uid);
+  write_fmt_string (printcharfun, " 0x%x>", NORMAL_LISP_OBJECT_UID (cs));
 }
 
 static const struct memory_description charset_description[] = {
--- a/src/number.c	Sat Mar 13 05:38:34 2010 -0600
+++ b/src/number.c	Sat Mar 13 11:38:54 2010 -0600
@@ -61,9 +61,9 @@
 
 #ifdef NEW_GC
 static void
-bignum_finalize (void *header)
+bignum_finalize (Lisp_Object obj)
 {
-  struct Lisp_Bignum *num = (struct Lisp_Bignum *) header;
+  struct Lisp_Bignum *num = XBIGNUM (obj);
   /* #### WARNING: It would be better to put some sort of check to make
      sure this doesn't happen more than once, just in case ---
      e.g. checking if it's zero before finalizing and then setting it to
@@ -155,9 +155,9 @@
 
 #ifdef NEW_GC
 static void
-ratio_finalize (void *header)
+ratio_finalize (Lisp_Object obj)
 {
-  struct Lisp_Ratio *num = (struct Lisp_Ratio *) header;
+  struct Lisp_Ratio *num = XRATIO (obj);
   /* #### WARNING: It would be better to put some sort of check to make
      sure this doesn't happen more than once, just in case ---
      e.g. checking if it's zero before finalizing and then setting it to
@@ -261,9 +261,9 @@
 
 #ifdef NEW_GC
 static void
-bigfloat_finalize (void *header)
+bigfloat_finalize (Lisp_Object obj)
 {
-  struct Lisp_Bigfloat *num = (struct Lisp_Bigfloat *) header;
+  struct Lisp_Bigfloat *num = XBIGFLOAT (obj);
   /* #### WARNING: It would be better to put some sort of check to make
      sure this doesn't happen more than once, just in case ---
      e.g. checking if it's zero before finalizing and then setting it to
--- a/src/objects.c	Sat Mar 13 05:38:34 2010 -0600
+++ b/src/objects.c	Sat Mar 13 11:38:54 2010 -0600
@@ -104,13 +104,13 @@
 {
   Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj);
   if (print_readably)
-    printing_unreadable_lcrecord (obj, 0);
+    printing_unreadable_lisp_object (obj, 0);
   write_fmt_string_lisp (printcharfun, "#<color-instance %s", 1, c->name);
   write_fmt_string_lisp (printcharfun, " on %s", 1, c->device);
   if (!NILP (c->device)) /* Vthe_null_color_instance */
     MAYBE_DEVMETH (XDEVICE (c->device), print_color_instance,
 		   (c, printcharfun, escapeflag));
-  write_fmt_string (printcharfun, " 0x%x>", c->header.uid);
+  write_fmt_string (printcharfun, " 0x%x>", NORMAL_LISP_OBJECT_UID (c));
 }
 
 static void
@@ -319,7 +319,7 @@
 {
   Lisp_Font_Instance *f = XFONT_INSTANCE (obj);
   if (print_readably)
-    printing_unreadable_lcrecord (obj, 0);
+    printing_unreadable_lisp_object (obj, 0);
   write_fmt_string_lisp (printcharfun, "#<font-instance %S", 1, f->name);
   write_fmt_string_lisp (printcharfun, " on %s", 1, f->device);
   if (!NILP (f->device))
@@ -328,7 +328,7 @@
 		     (f, printcharfun, escapeflag));
 
     }
-  write_fmt_string (printcharfun, " 0x%x>", f->header.uid);
+  write_fmt_string (printcharfun, " 0x%x>", NORMAL_LISP_OBJECT_UID (f));
 }
 
 static void
--- a/src/print.c	Sat Mar 13 05:38:34 2010 -0600
+++ b/src/print.c	Sat Mar 13 11:38:54 2010 -0600
@@ -1415,7 +1415,7 @@
 	if (EQ (obj, tortoise) && len > 0)
 	  {
 	    if (print_readably)
-	      printing_unreadable_object ("circular list");
+	      printing_unreadable_object_fmt ("circular list");
 	    else
 	      write_ascstring (printcharfun, "... <circular list>");
 	    break;
@@ -1523,7 +1523,7 @@
 }
 
 DOESNT_RETURN
-printing_unreadable_object (const Ascbyte *fmt, ...)
+printing_unreadable_object_fmt (const Ascbyte *fmt, ...)
 {
   Lisp_Object obj;
   va_list args;
@@ -1537,38 +1537,28 @@
 }
 
 DOESNT_RETURN
-printing_unreadable_lcrecord (Lisp_Object obj, const Ibyte *name)
+printing_unreadable_lisp_object (Lisp_Object obj, const Ibyte *name)
 {
-  NORMAL_LISP_OBJECT_HEADER *header = (NORMAL_LISP_OBJECT_HEADER *) XPNTR (obj);
+  struct lrecord_header *header = (struct lrecord_header *) XPNTR (obj);
   const struct lrecord_implementation *imp =
     XRECORD_LHEADER_IMPLEMENTATION (obj);
 
-#ifndef NEW_GC
-  /* This must be a real lcrecord */
-  assert (!imp->frob_block_p);
-#endif
-
   if (name)
-    printing_unreadable_object ("#<%s %s 0x%x>", imp->name, name, header->uid);
+    printing_unreadable_object_fmt ("#<%s %s 0x%x>", imp->name, name, header->uid);
   else
-    printing_unreadable_object ("#<%s 0x%x>", imp->name, header->uid);
+    printing_unreadable_object_fmt ("#<%s 0x%x>", imp->name, header->uid);
 }
 
 void
 external_object_printer (Lisp_Object obj, Lisp_Object printcharfun,
 			 int UNUSED (escapeflag))
 {
-  NORMAL_LISP_OBJECT_HEADER *header = (NORMAL_LISP_OBJECT_HEADER *) XPNTR (obj);
+  struct lrecord_header *header = (struct lrecord_header *) XPNTR (obj);
   const struct lrecord_implementation *imp =
     XRECORD_LHEADER_IMPLEMENTATION (obj);
 
-#ifndef NEW_GC
-  /* This must be a real lcrecord */
-  assert (!imp->frob_block_p);
-#endif
-
   if (print_readably)
-    printing_unreadable_lcrecord (obj, 0);
+    printing_unreadable_lisp_object (obj, 0);
 
   write_fmt_string (printcharfun, "#<%s 0x%x>", imp->name, header->uid);
 }
@@ -1578,7 +1568,7 @@
 			 int UNUSED (escapeflag))
 {
   if (print_readably)
-    printing_unreadable_object
+    printing_unreadable_object_fmt
       ("#<INTERNAL OBJECT (XEmacs bug?) (%s) 0x%lx>",
        XRECORD_LHEADER_IMPLEMENTATION (obj)->name,
        (unsigned long) XPNTR (obj));
@@ -2428,19 +2418,10 @@
 	debug_out ("<< bad object type=%d 0x%lx>>", header->type,
 		   (EMACS_INT) header);
       else
-#ifdef NEW_GC
 	debug_out ("#<%s addr=0x%lx uid=0x%lx>",
 		   LHEADER_IMPLEMENTATION (header)->name,
 		   (EMACS_INT) header,
 		   (EMACS_INT) ((struct lrecord_header *) header)->uid);
-#else /* not NEW_GC */
-	debug_out ("#<%s addr=0x%lx uid=0x%lx>",
-		   LHEADER_IMPLEMENTATION (header)->name,
-		   (EMACS_INT) header,
-		   (EMACS_INT) (LHEADER_IMPLEMENTATION (header)->frob_block_p ?
-				((struct lrecord_header *) header)->uid :
-				((struct old_lcrecord_header *) header)->uid));
-#endif /* not NEW_GC */
     }
 }
 
--- a/src/process.c	Sat Mar 13 05:38:34 2010 -0600
+++ b/src/process.c	Sat Mar 13 11:38:54 2010 -0600
@@ -150,7 +150,7 @@
   Lisp_Process *process = XPROCESS (obj);
 
   if (print_readably)
-    printing_unreadable_lcrecord (obj, XSTRING_DATA (process->name));
+    printing_unreadable_lisp_object (obj, XSTRING_DATA (process->name));
 
   if (!escapeflag)
     {
--- a/src/rangetab.c	Sat Mar 13 05:38:34 2010 -0600
+++ b/src/rangetab.c	Sat Mar 13 11:38:54 2010 -0600
@@ -133,7 +133,7 @@
   if (print_readably)
     write_ascstring (printcharfun, "))");
   else
-    write_fmt_string (printcharfun, " 0x%x>", rt->header.uid);
+    write_fmt_string (printcharfun, " 0x%x>", NORMAL_LISP_OBJECT_UID (rt));
 }
 
 static int
--- a/src/scrollbar.c	Sat Mar 13 05:38:34 2010 -0600
+++ b/src/scrollbar.c	Sat Mar 13 11:38:54 2010 -0600
@@ -112,7 +112,7 @@
       struct device *d = XDEVICE (frame->device);
 
       MAYBE_DEVMETH (d, free_scrollbar_instance, (instance));
-      /* not worth calling free_managed_lcrecord() -- scrollbar instances
+      /* not worth calling free_normal_lisp_object() -- scrollbar instances
 	 are not created that frequently and it's dangerous. */
     }
 }
--- a/src/specifier.c	Sat Mar 13 05:38:34 2010 -0600
+++ b/src/specifier.c	Sat Mar 13 11:38:54 2010 -0600
@@ -280,8 +280,8 @@
   Lisp_Object the_specs;
 
   if (print_readably)
-    printing_unreadable_object ("#<%s-specifier 0x%x>",
-				sp->methods->name, sp->header.uid);
+    printing_unreadable_object_fmt ("#<%s-specifier 0x%x>",
+				sp->methods->name, NORMAL_LISP_OBJECT_UID (sp));
 
   write_fmt_string (printcharfun, "#<%s-specifier global=", sp->methods->name);
 #if 0
@@ -302,7 +302,7 @@
       write_fmt_string_lisp (printcharfun, " fallback=%S", 1, sp->fallback);
     }
   unbind_to (count);
-  write_fmt_string (printcharfun, " 0x%x>", sp->header.uid);
+  write_fmt_string (printcharfun, " 0x%x>", NORMAL_LISP_OBJECT_UID (sp));
 }
 
 #ifndef NEW_GC
--- a/src/symbols.c	Sat Mar 13 05:38:34 2010 -0600
+++ b/src/symbols.c	Sat Mar 13 11:38:54 2010 -0600
@@ -3521,8 +3521,6 @@
       1, /* lisp_readonly bit */
     },
     0, /* next */
-    0, /* uid  */
-    0, /* free */
   },
   0, /* value */
   SYMVAL_UNBOUND_MARKER
--- a/src/symeval.h	Sat Mar 13 05:38:34 2010 -0600
+++ b/src/symeval.h	Sat Mar 13 11:38:54 2010 -0600
@@ -1,6 +1,6 @@
 /* Definitions of symbol-value forwarding for XEmacs Lisp interpreter.
    Copyright (C) 1985, 1986, 1987, 1992, 1993 Free Software Foundation, Inc.
-   Copyright (C) 2000, 2001, 2002 Ben Wing.
+   Copyright (C) 2000, 2001, 2002, 2010 Ben Wing.
 
 This file is part of XEmacs.
 
@@ -425,11 +425,8 @@
 	  1, /* mark bit */						\
 	  1, /* c_readonly bit */					\
 	  1, /* lisp_readonly bit */					\
-          0  /* unused */                                               \
 	},								\
 	0, /* next */							\
-	0, /* uid  */							\
-	0  /* free */							\
       },								\
       c_location,							\
       forward_type							\
--- a/src/tooltalk.c	Sat Mar 13 05:38:34 2010 -0600
+++ b/src/tooltalk.c	Sat Mar 13 11:38:54 2010 -0600
@@ -172,10 +172,10 @@
   Lisp_Tooltalk_Message *p = XTOOLTALK_MESSAGE (obj);
 
   if (print_readably)
-    printing_unreadable_lcrecord (obj, 0);
+    printing_unreadable_lisp_object (obj, 0);
 
   write_fmt_string (printcharfun, "#<tooltalk-message id:0x%lx 0x%x>",
-		    (long) (p->m), p->header.uid);
+		    (long) (p->m), NORMAL_LISP_OBJECT_UID (p));
 }
 
 DEFINE_NODUMP_LISP_OBJECT ("tooltalk-message", tooltalk_message,
@@ -247,10 +247,10 @@
   Lisp_Tooltalk_Pattern *p = XTOOLTALK_PATTERN (obj);
 
   if (print_readably)
-    printing_unreadable_lcrecord (obj, 0);
+    printing_unreadable_lisp_object (obj, 0);
 
   write_fmt_string (printcharfun, "#<tooltalk-pattern id:0x%lx 0x%x>",
-		    (long) (p->p), p->header.uid);
+		    (long) (p->p), NORMAL_LISP_OBJECT_UID (p));
 }
 
 DEFINE_NODUMP_LISP_OBJECT ("tooltalk-pattern", tooltalk_pattern,
--- a/src/ui-gtk.c	Sat Mar 13 05:38:34 2010 -0600
+++ b/src/ui-gtk.c	Sat Mar 13 11:38:54 2010 -0600
@@ -327,7 +327,7 @@
 		    int UNUSED (escapeflag))
 {
   if (print_readably)
-    printing_unreadable_lcrecord (obj, 0);
+    printing_unreadable_lisp_object (obj, 0);
 
   write_fmt_string_lisp (printcharfun, "#<ffi %S", 1, XFFI (obj)->function_name);
   if (XFFI (obj)->n_args)
@@ -796,7 +796,7 @@
 			  int UNUSED (escapeflag))
 {
   if (print_readably)
-    printing_unreadable_lcrecord (obj, 0);
+    printing_unreadable_lisp_object (obj, 0);
 
   write_ascstring (printcharfun, "#<GtkObject (");
   if (XGTK_OBJECT (obj)->alive_p)
@@ -1104,7 +1104,7 @@
 			 int UNUSED (escapeflag))
 {
   if (print_readably)
-    printing_unreadable_lcrecord (obj, 0);
+    printing_unreadable_lisp_object (obj, 0);
 
   write_ascstring (printcharfun, "#<GtkBoxed (");
   write_cistring (printcharfun, gtk_type_name (XGTK_BOXED (obj)->object_type));
--- a/src/window.c	Sat Mar 13 05:38:34 2010 -0600
+++ b/src/window.c	Sat Mar 13 11:38:54 2010 -0600
@@ -309,7 +309,7 @@
   Lisp_Object buf;
 
   if (print_readably)
-    printing_unreadable_lcrecord (obj, 0);
+    printing_unreadable_lisp_object (obj, 0);
 
   write_ascstring (printcharfun, "#<window");
   buf = XWINDOW_BUFFER (obj);
@@ -321,7 +321,8 @@
       Lisp_Object name = XBUFFER (buf)->name;
       write_fmt_string_lisp (printcharfun, " on %S", 1, name);
     }
-  write_fmt_string (printcharfun, " 0x%x>", XWINDOW (obj)->header.uid);
+  write_fmt_string (printcharfun, " 0x%x>",
+		    NORMAL_LISP_OBJECT_UID (XWINDOW (obj)));
 }
 
 static void
@@ -678,7 +679,7 @@
 #endif
       free_display_structs (mir);
       mir = mir->next;
-      /* not worth calling free_managed_lcrecord() -- window mirrors
+      /* not worth calling free_normal_lisp_object() -- window mirrors
 	 are not created that frequently and it's dangerous.  we don't
 	 know for sure that there aren't other pointers around -- e.g.
 	 in a scrollbar instance. */
@@ -5406,7 +5407,7 @@
     if (!NILP (buffer) && BUFFERP (buffer))
       stderr_out (" on %s", XSTRING_DATA (XBUFFER (buffer)->name));
   }
-  stderr_out (" 0x%x>", XWINDOW (window)->header.uid);
+  stderr_out (" 0x%x>", NORMAL_LISP_OBJECT_UID (XWINDOW (window)));
 
   while (!NILP (child))
     {
--- a/src/xemacs.def.in.in	Sat Mar 13 05:38:34 2010 -0600
+++ b/src/xemacs.def.in.in	Sat Mar 13 11:38:54 2010 -0600
@@ -164,7 +164,8 @@
 non_ascii_valid_ichar_p		/* valid_ichar_p */
 #endif
 out_of_memory			/* The postgresql module uses this */
-printing_unreadable_object
+printing_unreadable_lisp_object
+printing_unreadable_object_fmt
 #ifdef XEMACS_DEFS_NEEDS_INLINE_DECLS
 qxestrdup
 qxestrlen