--- a/src/lrecord.h	Mon Aug 13 11:19:22 2007 +0200
+++ b/src/lrecord.h	Mon Aug 13 11:20:41 2007 +0200
@@ -21,18 +21,18 @@
 
 /* Synched up with: Not in FSF. */
 
-#ifndef INCLUDED_lrecord_h_
-#define INCLUDED_lrecord_h_
+#ifndef _XEMACS_LRECORD_H_
+#define _XEMACS_LRECORD_H_
 
 /* The "lrecord" type of Lisp object is used for all object types
    other than a few simple ones.  This allows many types to be
-   implemented but only a few bits required in a Lisp object for type
-   information. (The tradeoff is that each object has its type marked
-   in it, thereby increasing its size.) All lrecords begin with a
-   `struct lrecord_header', which identifies the lisp object type, by
-   providing an index into a table of `struct lrecord_implementation',
-   which describes the behavior of the lisp object.  It also contains
-   some other data bits.
+   implemented but only a few bits required in a Lisp object for
+   type information. (The tradeoff is that each object has its
+   type marked in it, thereby increasing its size.) The first
+   four bytes of all lrecords is either a pointer to a struct
+   lrecord_implementation, which contains methods describing how
+   to process this object, or an index into an array of pointers
+   to struct lrecord_implementations plus some other data bits.
 
    Lrecords are of two types: straight lrecords, and lcrecords.
    Straight lrecords are used for those types of objects that have
@@ -42,12 +42,12 @@
    the lrecord_implementation for the object.  There are special
    routines in alloc.c to deal with each such object type.
 
-   Lcrecords are used for less common sorts of objects that don't do
-   their own allocation.  Each such object is malloc()ed individually,
-   and the objects are chained together through a `next' pointer.
-   Lcrecords have a `struct lcrecord_header' at the top, which
-   contains a `struct lrecord_header' and a `next' pointer, and are
-   allocated using alloc_lcrecord().
+   Lcrecords are used for less common sorts of objects that don't
+   do their own allocation.  Each such object is malloc()ed
+   individually, and the objects are chained together through
+   a `next' pointer.  Lcrecords have a `struct lcrecord_header'
+   at the top, which contains a `struct lrecord_header' and
+   a `next' pointer, and are allocated using alloc_lcrecord().
 
    Creating a new lcrecord type is fairly easy; just follow the
    lead of some existing type (e.g. hash tables).  Note that you
@@ -60,41 +60,35 @@
 struct lrecord_header
 {
   /* index into lrecord_implementations_table[] */
-  unsigned int type :8;
-
-  /* If `mark' is 0 after the GC mark phase, the object will be freed
-     during the GC sweep phase.  There are 2 ways that `mark' can be 1:
-     - by being referenced from other objects during the GC mark phase
-     - because it is permanently on, for c_readonly objects */
-  unsigned int mark :1;
-
-  /* 1 if the object resides in logically read-only space, and does not
-     reference other non-c_readonly objects.
-     Invariant: if (c_readonly == 1), then (mark == 1 && lisp_readonly == 1) */
-  unsigned int c_readonly :1;
-
-  /* 1 if the object is readonly from lisp */
-  unsigned int lisp_readonly :1;
+  unsigned char type;
+  struct {
+    /* 1 if the object is marked during GC. */
+    unsigned mark :1;
+    /* 1 if the object resides in read-only space */
+    unsigned c_readonly : 1;
+    /* 1 if the object is readonly from lisp */
+    unsigned lisp_readonly : 1;
+  } flags;
 };
 
 struct lrecord_implementation;
-int lrecord_type_index (const struct lrecord_implementation *implementation);
+int lrecord_type_index (CONST struct lrecord_implementation *implementation);
 
-#define set_lheader_implementation(header,imp) do {	\
+# define set_lheader_implementation(header,imp) do {	\
   struct lrecord_header* SLI_header = (header);		\
-  SLI_header->type = (imp)->lrecord_type_index;		\
-  SLI_header->mark = 0;					\
-  SLI_header->c_readonly = 0;				\
-  SLI_header->lisp_readonly = 0;			\
+  (SLI_header)->type = lrecord_type_index (imp);	\
+  (SLI_header)->flags.mark = 0;				\
+  (SLI_header)->flags.c_readonly = 0;			\
+  (SLI_header)->flags.lisp_readonly = 0;		\
 } while (0)
 
 struct lcrecord_header
 {
   struct lrecord_header lheader;
 
-  /* The `next' field is normally used to chain all lcrecords together
+  /* The `next' field is normally used to chain all lrecords together
      so that the GC can find (and free) all of them.
-     `alloc_lcrecord' threads lcrecords together.
+     `alloc_lcrecord' threads records together.
 
      The `next' field may be used for other purposes as long as some
      other mechanism is provided for letting the GC do its work.
@@ -126,75 +120,14 @@
   Lisp_Object chain;
 };
 
-enum lrecord_type
-{
-  /* Symbol value magic types come first to make SYMBOL_VALUE_MAGIC_P fast.
-     #### This should be replaced by a symbol_value_magic_p flag
-     in the Lisp_Symbol lrecord_header. */
-  lrecord_type_symbol_value_forward,
-  lrecord_type_symbol_value_varalias,
-  lrecord_type_symbol_value_lisp_magic,
-  lrecord_type_symbol_value_buffer_local,
-  lrecord_type_max_symbol_value_magic = lrecord_type_symbol_value_buffer_local,
-  
-  lrecord_type_symbol,
-  lrecord_type_subr,
-  lrecord_type_cons,
-  lrecord_type_vector,
-  lrecord_type_string,
-  lrecord_type_lcrecord_list,
-  lrecord_type_compiled_function,
-  lrecord_type_weak_list,
-  lrecord_type_bit_vector,
-  lrecord_type_float,
-  lrecord_type_hash_table,
-  lrecord_type_lstream,
-  lrecord_type_process,
-  lrecord_type_charset,
-  lrecord_type_coding_system,
-  lrecord_type_char_table,
-  lrecord_type_char_table_entry,
-  lrecord_type_range_table,
-  lrecord_type_opaque,
-  lrecord_type_opaque_ptr,
-  lrecord_type_buffer,
-  lrecord_type_extent,
-  lrecord_type_extent_info,
-  lrecord_type_extent_auxiliary,
-  lrecord_type_marker,
-  lrecord_type_event,
-  lrecord_type_keymap,
-  lrecord_type_command_builder,
-  lrecord_type_timeout,
-  lrecord_type_specifier,
-  lrecord_type_console,
-  lrecord_type_device,
-  lrecord_type_frame,
-  lrecord_type_window,
-  lrecord_type_window_configuration,
-  lrecord_type_gui_item,
-  lrecord_type_popup_data,
-  lrecord_type_toolbar_button,
-  lrecord_type_color_instance,
-  lrecord_type_font_instance,
-  lrecord_type_image_instance,
-  lrecord_type_glyph,
-  lrecord_type_face,
-  lrecord_type_database,
-  lrecord_type_tooltalk_message,
-  lrecord_type_tooltalk_pattern,
-  lrecord_type_ldap,
-  lrecord_type_pgconn,
-  lrecord_type_pgresult,
-  lrecord_type_devmode,
-  lrecord_type_count /* must be last */
-};
+/* see alloc.c for an explanation */
+Lisp_Object this_one_is_unmarkable (Lisp_Object obj,
+				    void (*markobj) (Lisp_Object));
 
 struct lrecord_implementation
 {
-  const char *name;
-
-  /* `marker' is called at GC time, to make sure that all Lisp_Objects
+  CONST char *name;
+  /* This function is called at GC time, to make sure that all Lisp_Objects
      pointed to by this object get properly marked.  It should call
      the mark_object function on all Lisp_Objects in the object.  If
      the return value is non-nil, it should be a Lisp_Object to be
@@ -203,219 +136,79 @@
      recursion, so the object returned should preferably be the one
      with the deepest level of Lisp_Object pointers.  This function
      can be NULL, meaning no GC marking is necessary. */
-  Lisp_Object (*marker) (Lisp_Object);
-
-  /* `printer' converts the object to a printed representation.
-     This can be NULL; in this case default_object_printer() will be
-     used instead. */
+  Lisp_Object (*marker) (Lisp_Object, void (*mark_object) (Lisp_Object));
+  /* This can be NULL if the object is an lcrecord; the
+     default_object_printer() in print.c will be used. */
   void (*printer) (Lisp_Object, Lisp_Object printcharfun, int escapeflag);
-
-  /* `finalizer' is called at GC time when the object is about to
+  /* This function is called at GC time when the object is about to
      be freed, and at dump time (FOR_DISKSAVE will be non-zero in this
      case).  It should perform any necessary cleanup (e.g. freeing
-     malloc()ed memory).  This can be NULL, meaning no special
+     malloc()ed memory.  This can be NULL, meaning no special
      finalization is necessary.
 
-     WARNING: remember that `finalizer' is called at dump time even
+     WARNING: remember that the finalizer is called at dump time even
      though the object is not being freed. */
   void (*finalizer) (void *header, int for_disksave);
-
   /* This can be NULL, meaning compare objects with EQ(). */
   int (*equal) (Lisp_Object obj1, Lisp_Object obj2, int depth);
-
-  /* `hash' generates hash values for use with hash tables that have
-     `equal' as their test function.  This can be NULL, meaning use
-     the Lisp_Object itself as the hash.  But, you must still satisfy
-     the constraint that if two objects are `equal', then they *must*
-     hash to the same value in order for hash tables to work properly.
-     This means that `hash' can be NULL only if the `equal' method is
-     also NULL. */
+  /* This can be NULL, meaning use the Lisp_Object itself as the hash;
+     but *only* if the `equal' function is EQ (if two objects are
+     `equal', they *must* hash to the same value or the hashing won't
+     work). */
   unsigned long (*hash) (Lisp_Object, int);
-
-  /* External data layout description */
-  const struct lrecord_description *description;
-
-  /* These functions allow any object type to have builtin property
-     lists that can be manipulated from the lisp level with
-     `get', `put', `remprop', and `object-plist'. */
   Lisp_Object (*getprop) (Lisp_Object obj, Lisp_Object prop);
   int (*putprop) (Lisp_Object obj, Lisp_Object prop, Lisp_Object val);
   int (*remprop) (Lisp_Object obj, Lisp_Object prop);
   Lisp_Object (*plist) (Lisp_Object obj);
 
-  /* Only one of `static_size' and `size_in_bytes_method' is non-0.
-     If both are 0, this type is not instantiable by alloc_lcrecord(). */
+  /* Only one of these is non-0.  If both are 0, it means that this type
+     is not instantiable by alloc_lcrecord(). */
   size_t static_size;
-  size_t (*size_in_bytes_method) (const void *header);
-
-  /* The (constant) index into lrecord_implementations_table */
-  enum lrecord_type lrecord_type_index;
-
+  size_t (*size_in_bytes_method) (CONST void *header);
+  /* A unique subtag-code (dynamically) assigned to this datatype. */
+  /* (This is a pointer so the rest of this structure can be read-only.) */
+  int *lrecord_type_index;
   /* A "basic" lrecord is any lrecord that's not an lcrecord, i.e.
      one that does not have an lcrecord_header at the front and which
      is (usually) allocated in frob blocks.  We only use this flag for
      some consistency checking, and that only when error-checking is
      enabled. */
-  unsigned int basic_p :1;
+  int basic_p;
 };
 
-extern const struct lrecord_implementation *lrecord_implementations_table[];
+extern CONST struct lrecord_implementation *lrecord_implementations_table[];
 
 #define XRECORD_LHEADER_IMPLEMENTATION(obj) \
-   LHEADER_IMPLEMENTATION (XRECORD_LHEADER (obj))
-#define LHEADER_IMPLEMENTATION(lh) lrecord_implementations_table[(lh)->type]
+   (lrecord_implementations_table[XRECORD_LHEADER (obj)->type])
+#define LHEADER_IMPLEMENTATION(lh) (lrecord_implementations_table[(lh)->type])
 
 extern int gc_in_progress;
 
-#define MARKED_RECORD_P(obj) (XRECORD_LHEADER (obj)->mark)
-#define MARKED_RECORD_HEADER_P(lheader) ((lheader)->mark)
-#define MARK_RECORD_HEADER(lheader)   ((void) ((lheader)->mark = 1))
-#define UNMARK_RECORD_HEADER(lheader) ((void) ((lheader)->mark = 0))
-
-#define C_READONLY_RECORD_HEADER_P(lheader)  ((lheader)->c_readonly)
-#define LISP_READONLY_RECORD_HEADER_P(lheader)  ((lheader)->lisp_readonly)
-#define SET_C_READONLY_RECORD_HEADER(lheader) do {	\
-  struct lrecord_header *SCRRH_lheader = (lheader);	\
-  SCRRH_lheader->c_readonly = 1;			\
-  SCRRH_lheader->lisp_readonly = 1;			\
-  SCRRH_lheader->mark = 1;				\
-} while (0)
-#define SET_LISP_READONLY_RECORD_HEADER(lheader) \
-  ((void) ((lheader)->lisp_readonly = 1))
-#define RECORD_MARKER(lheader) lrecord_markers[(lheader)->type]
-
-/* External description stuff
-
-   A lrecord external description  is an array  of values.  The  first
-   value of each line is a type, the second  the offset in the lrecord
-   structure.  Following values  are parameters, their  presence, type
-   and number is type-dependant.
-
-   The description ends with a "XD_END" or "XD_SPECIFIER_END" record.
-
-   Some example descriptions :
-
-   static const struct lrecord_description cons_description[] = {
-     { XD_LISP_OBJECT, offsetof (Lisp_Cons, car) },
-     { XD_LISP_OBJECT, offsetof (Lisp_Cons, cdr) },
-     { XD_END }
-   };
-
-   Which means "two lisp objects starting at the 'car' and 'cdr' elements"
+#define MARKED_RECORD_P(obj) (gc_in_progress && XRECORD_LHEADER (obj)->flags.mark)
+#define MARKED_RECORD_HEADER_P(lheader) ((lheader)->flags.mark)
+#define MARK_RECORD_HEADER(lheader)   ((void) ((lheader)->flags.mark = 1))
+#define UNMARK_RECORD_HEADER(lheader) ((void) ((lheader)->flags.mark = 0))
 
-  static const struct lrecord_description string_description[] = {
-    { XD_BYTECOUNT,       offsetof (Lisp_String, size) },
-    { XD_OPAQUE_DATA_PTR, offsetof (Lisp_String, data), XD_INDIRECT(0, 1) },
-    { XD_LISP_OBJECT,     offsetof (Lisp_String, plist) },
-    { XD_END }
-  };
-  "A pointer to string data at 'data', the size of the pointed array being the value
-   of the size variable plus 1, and one lisp object at 'plist'"
-
-  The existing types :
-    XD_LISP_OBJECT
-  A Lisp object.  This is also the type to use for pointers to other lrecords.
-
-    XD_LISP_OBJECT_ARRAY
-  An array of Lisp objects or pointers to lrecords.
-  The third element is the count.
-
-    XD_LO_RESET_NIL
-  Lisp objects which will be reset to Qnil when dumping.  Useful for cleaning
-  up caches.
-
-    XD_LO_LINK
-  Link in a linked list of objects of the same type.
-
-    XD_OPAQUE_PTR
-  Pointer to undumpable data.  Must be NULL when dumping.
-
-    XD_STRUCT_PTR
-  Pointer to described struct.  Parameters are number of structures and
-  struct_description.
-
-    XD_OPAQUE_DATA_PTR
-  Pointer to dumpable opaque data.  Parameter is the size of the data.
-  Pointed data must be relocatable without changes.
-
-    XD_C_STRING
-  Pointer to a C string.
+#define UNMARKABLE_RECORD_HEADER_P(lheader) \
+  (LHEADER_IMPLEMENTATION (lheader)->marker == this_one_is_unmarkable)
 
-    XD_DOC_STRING
-  Pointer to a doc string (C string if positive, opaque value if negative)
-
-    XD_INT_RESET
-  An integer which will be reset to a given value in the dump file.
-
-
-    XD_SIZE_T
-  size_t value.  Used for counts.
-
-    XD_INT
-  int value.  Used for counts.
-
-    XD_LONG
-  long value.  Used for counts.
-
-    XD_BYTECOUNT
-  bytecount value.  Used for counts.
-
-    XD_END
-  Special type indicating the end of the array.
-
-    XD_SPECIFIER_END
-  Special type indicating the end of the array for a specifier.  Extra
-  description is going to be fetched from the specifier methods.
-
-
-  Special macros:
-    XD_INDIRECT(line, delta)
-  Usable where  a "count" or "size"  is requested.  Gives the value of
-  the element which is at line number 'line' in the description (count
-  starts at zero) and adds delta to it.
-*/
+#define C_READONLY_RECORD_HEADER_P(lheader)  ((lheader)->flags.c_readonly)
+#define LISP_READONLY_RECORD_HEADER_P(lheader)  ((lheader)->flags.lisp_readonly)
+#define SET_C_READONLY_RECORD_HEADER(lheader) \
+  ((void) ((lheader)->flags.c_readonly = (lheader)->flags.lisp_readonly = 1))
+#define SET_LISP_READONLY_RECORD_HEADER(lheader) \
+  ((void) ((lheader)->flags.lisp_readonly = 1))
 
-enum lrecord_description_type {
-  XD_LISP_OBJECT_ARRAY,
-  XD_LISP_OBJECT,
-  XD_LO_RESET_NIL,
-  XD_LO_LINK,
-  XD_OPAQUE_PTR,
-  XD_STRUCT_PTR,
-  XD_OPAQUE_DATA_PTR,
-  XD_C_STRING,
-  XD_DOC_STRING,
-  XD_INT_RESET,
-  XD_SIZE_T,
-  XD_INT,
-  XD_LONG,
-  XD_BYTECOUNT,
-  XD_END,
-  XD_SPECIFIER_END
-};
+/* Declaring the following structures as const puts them in the
+   text (read-only) segment, which makes debugging inconvenient
+   because this segment is not mapped when processing a core-
+   dump file */
 
-struct lrecord_description {
-  enum lrecord_description_type type;
-  int offset;
-  EMACS_INT data1;
-  const struct struct_description *data2;
-};
-
-struct struct_description {
-  size_t size;
-  const struct lrecord_description *description;
-};
-
-#define XD_INDIRECT(val, delta) (-1-((val)|(delta<<8)))
-
-#define XD_IS_INDIRECT(code) (code<0)
-#define XD_INDIRECT_VAL(code) ((-1-code) & 255)
-#define XD_INDIRECT_DELTA(code) (((-1-code)>>8) & 255)
-
-#define XD_DYNARR_DESC(base_type, sub_desc) \
-  { XD_STRUCT_PTR, offsetof (base_type, base), XD_INDIRECT(1, 0), sub_desc }, \
-  { XD_INT,        offsetof (base_type, cur) }, \
-  { XD_INT_RESET,  offsetof (base_type, max), XD_INDIRECT(1, 0) }
+#ifdef DEBUG_XEMACS
+#define CONST_IF_NOT_DEBUG
+#else
+#define CONST_IF_NOT_DEBUG CONST
+#endif
 
 /* DEFINE_LRECORD_IMPLEMENTATION is for objects with constant size.
    DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION is for objects whose size varies.
@@ -427,47 +220,38 @@
 # define DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype)
 #endif
 
-#define DEFINE_BASIC_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \
-DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype)
+#define DEFINE_BASIC_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,structtype) \
+DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,0,0,0,0,structtype)
 
-#define DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \
-MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof(structtype),0,1,structtype)
-
-#define DEFINE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \
-DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype)
+#define DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,structtype) \
+MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,sizeof(structtype),0,1,structtype)
 
-#define DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \
-MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof (structtype),0,0,structtype)
+#define DEFINE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,structtype) \
+DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,0,0,0,0,structtype)
 
-#define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \
-DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,sizer,structtype)
-
-#define DEFINE_BASIC_LRECORD_SEQUENCE_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \
-MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,sizer,1,structtype)
+#define DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,structtype) \
+MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,sizeof (structtype),0,0,structtype)
 
-#define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizer,structtype) \
-MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,0,sizer,0,structtype) \
+#define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,sizer,structtype) \
+DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,0,0,0,0,sizer,structtype)
 
-#define MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \
-DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype)			\
-const struct lrecord_implementation lrecord_##c_name =			\
-  { name, marker, printer, nuker, equal, hash, desc,			\
-    getprop, putprop, remprop, plist, size, sizer,			\
-    lrecord_type_##c_name, basic_p }
+#define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,sizer,structtype) \
+MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,0,sizer,0,structtype) \
 
-extern Lisp_Object (*lrecord_markers[]) (Lisp_Object);
+#define MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,size,sizer,basic_p,structtype) \
+DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype)			\
+static int lrecord_##c_name##_lrecord_type_index;			\
+CONST_IF_NOT_DEBUG struct lrecord_implementation lrecord_##c_name =	\
+  { name, marker, printer, nuker, equal, hash,				\
+    getprop, putprop, remprop, props, size, sizer,			\
+    &(lrecord_##c_name##_lrecord_type_index), basic_p }			\
 
-#define INIT_LRECORD_IMPLEMENTATION(type) do {				\
-  lrecord_implementations_table[lrecord_type_##type] = &lrecord_##type;	\
-  lrecord_markers[lrecord_type_##type] =				\
-    lrecord_implementations_table[lrecord_type_##type]->marker;		\
-} while (0)
-
-#define LRECORDP(a) (XTYPE (a) == Lisp_Type_Record)
+#define LRECORDP(a) (XTYPE ((a)) == Lisp_Type_Record)
 #define XRECORD_LHEADER(a) ((struct lrecord_header *) XPNTR (a))
 
 #define RECORD_TYPEP(x, ty) \
-  (LRECORDP (x) && XRECORD_LHEADER (x)->type == (ty))
+  (LRECORDP (x) && \
+   lrecord_implementations_table[XRECORD_LHEADER (x)->type] == (ty))
 
 /* NOTE: the DECLARE_LRECORD() must come before the associated
    DEFINE_LRECORD_*() or you will get compile errors.
@@ -481,24 +265,24 @@
 #ifdef ERROR_CHECK_TYPECHECK
 
 # define DECLARE_LRECORD(c_name, structtype)			\
-extern const struct lrecord_implementation lrecord_##c_name;	\
-INLINE_HEADER structtype *					\
-error_check_##c_name (Lisp_Object obj);				\
-INLINE_HEADER structtype *					\
+extern CONST_IF_NOT_DEBUG struct lrecord_implementation		\
+  lrecord_##c_name;						\
+INLINE structtype *error_check_##c_name (Lisp_Object obj);	\
+INLINE structtype *						\
 error_check_##c_name (Lisp_Object obj)				\
 {								\
-  assert (RECORD_TYPEP (obj, lrecord_type_##c_name));		\
+  assert (RECORD_TYPEP (obj, &lrecord_##c_name) ||		\
+	  MARKED_RECORD_P (obj));				\
   return (structtype *) XPNTR (obj);				\
 }								\
 extern Lisp_Object Q##c_name##p
 
 # define DECLARE_NONRECORD(c_name, type_enum, structtype)	\
-INLINE_HEADER structtype *					\
-error_check_##c_name (Lisp_Object obj);				\
-INLINE_HEADER structtype *					\
+INLINE structtype *error_check_##c_name (Lisp_Object obj);	\
+INLINE structtype *						\
 error_check_##c_name (Lisp_Object obj)				\
 {								\
-  assert (XTYPE (obj) == type_enum);				\
+  assert (XGCTYPE (obj) == type_enum);				\
   return (structtype *) XPNTR (obj);				\
 }								\
 extern Lisp_Object Q##c_name##p
@@ -509,14 +293,16 @@
 # define XSETRECORD(var, p, c_name) do				\
 {								\
   XSETOBJ (var, Lisp_Type_Record, p);				\
-  assert (RECORD_TYPEP (var, lrecord_type_##c_name));		\
+  assert (RECORD_TYPEP (var, &lrecord_##c_name) ||		\
+	  MARKED_RECORD_P (var));				\
 } while (0)
 
 #else /* not ERROR_CHECK_TYPECHECK */
 
 # define DECLARE_LRECORD(c_name, structtype)			\
 extern Lisp_Object Q##c_name##p;				\
-extern const struct lrecord_implementation lrecord_##c_name
+extern CONST_IF_NOT_DEBUG struct lrecord_implementation		\
+  lrecord_##c_name
 # define DECLARE_NONRECORD(c_name, type_enum, structtype)	\
 extern Lisp_Object Q##c_name##p
 # define XRECORD(x, c_name, structtype) ((structtype *) XPNTR (x))
@@ -526,7 +312,8 @@
 
 #endif /* not ERROR_CHECK_TYPECHECK */
 
-#define RECORDP(x, c_name) RECORD_TYPEP (x, lrecord_type_##c_name)
+#define RECORDP(x, c_name) RECORD_TYPEP (x, &lrecord_##c_name)
+#define GC_RECORDP(x, c_name) gc_record_type_p (x, &lrecord_##c_name)
 
 /* Note: we now have two different kinds of type-checking macros.
    The "old" kind has now been renamed CONCHECK_foo.  The reason for
@@ -552,7 +339,7 @@
    way out and disabled returning from a signal entirely. */
 
 #define CONCHECK_RECORD(x, c_name) do {			\
- if (!RECORD_TYPEP (x, lrecord_type_##c_name))		\
+ if (!RECORD_TYPEP (x, &lrecord_##c_name))		\
    x = wrong_type_argument (Q##c_name##p, x);		\
 }  while (0)
 #define CONCHECK_NONRECORD(x, lisp_enum, predicate) do {\
@@ -560,7 +347,7 @@
    x = wrong_type_argument (predicate, x);		\
  } while (0)
 #define CHECK_RECORD(x, c_name) do {			\
- if (!RECORD_TYPEP (x, lrecord_type_##c_name))		\
+ if (!RECORD_TYPEP (x, &lrecord_##c_name))		\
    dead_wrong_type_argument (Q##c_name##p, x);		\
  } while (0)
 #define CHECK_NONRECORD(x, lisp_enum, predicate) do {	\
@@ -568,21 +355,24 @@
    dead_wrong_type_argument (predicate, x);		\
  } while (0)
 
-void *alloc_lcrecord (size_t size, const struct lrecord_implementation *);
+void *alloc_lcrecord (size_t size, CONST struct lrecord_implementation *);
 
 #define alloc_lcrecord_type(type, lrecord_implementation) \
   ((type *) alloc_lcrecord (sizeof (type), lrecord_implementation))
 
+int gc_record_type_p (Lisp_Object frob,
+		      CONST struct lrecord_implementation *type);
+
 /* Copy the data from one lcrecord structure into another, but don't
    overwrite the header information. */
 
 #define copy_lcrecord(dst, src)					\
-  memcpy ((char *) (dst) + sizeof (struct lcrecord_header),	\
-	  (char *) (src) + sizeof (struct lcrecord_header),	\
-	  sizeof (*(dst)) - sizeof (struct lcrecord_header))
+  memcpy ((char *) dst + sizeof (struct lcrecord_header),	\
+	  (char *) src + sizeof (struct lcrecord_header),	\
+	  sizeof (*dst) - sizeof (struct lcrecord_header))
 
 #define zero_lcrecord(lcr)					\
-   memset ((char *) (lcr) + sizeof (struct lcrecord_header), 0,	\
-	   sizeof (*(lcr)) - sizeof (struct lcrecord_header))
+   memset ((char *) lcr + sizeof (struct lcrecord_header), 0,	\
+	   sizeof (*lcr) - sizeof (struct lcrecord_header))
 
-#endif /* INCLUDED_lrecord_h_ */
+#endif /* _XEMACS_LRECORD_H_ */