XEmacs 21.2.30 "Hygeia".

[chise/xemacs-chise.git.1] / src / lrecord.h

diff --git a/src/lrecord.h b/src/lrecord.h
index 0dc5e05..d222ca3 100644 (file)
--- a/src/lrecord.h
+++ b/src/lrecord.h
@@ -21,18 +21,18 @@ Boston, MA 02111-1307, USA.  */
 
 /* Synched up with: Not in FSF. */
 
 
 /* Synched up with: Not in FSF. */
 

-#ifndef _XEMACS_LRECORD_H_
-#define _XEMACS_LRECORD_H_
+#ifndef INCLUDED_lrecord_h_
+#define INCLUDED_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
 
 /* 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.) 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.
+   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.

 
    Lrecords are of two types: straight lrecords, and lcrecords.
    Straight lrecords are used for those types of objects that have
 
    Lrecords are of two types: straight lrecords, and lcrecords.
    Straight lrecords are used for those types of objects that have

@@ -42,12 +42,12 @@ Boston, MA 02111-1307, USA.  */
    the lrecord_implementation for the object.  There are special
    routines in alloc.c to deal with each such object type.
 
    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
 
    Creating a new lcrecord type is fairly easy; just follow the
    lead of some existing type (e.g. hash tables).  Note that you

@@ -60,21 +60,29 @@ Boston, MA 02111-1307, USA.  */
 struct lrecord_header
 {
   /* index into lrecord_implementations_table[] */
 struct lrecord_header
 {
   /* index into lrecord_implementations_table[] */

-  unsigned type :8;
-  /* 1 if the object is marked during GC. */
-  unsigned mark :1;
-  /* 1 if the object resides in read-only space */
-  unsigned c_readonly : 1;
+  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 */
   /* 1 if the object is readonly from lisp */

-  unsigned lisp_readonly : 1;
+  unsigned int lisp_readonly :1;

 };
 
 struct lrecord_implementation;
 };
 
 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 {    \
   struct lrecord_header* SLI_header = (header);                \
 
 #define set_lheader_implementation(header,imp) do {    \
   struct lrecord_header* SLI_header = (header);                \

-  SLI_header->type = lrecord_type_index (imp);         \
+  SLI_header->type = (imp)->lrecord_type_index;                \

   SLI_header->mark = 0;                                        \
   SLI_header->c_readonly = 0;                          \
   SLI_header->lisp_readonly = 0;                       \
   SLI_header->mark = 0;                                        \
   SLI_header->c_readonly = 0;                          \
   SLI_header->lisp_readonly = 0;                       \

@@ -84,9 +92,9 @@ struct lcrecord_header
 {
   struct lrecord_header lheader;
 
 {
   struct lrecord_header lheader;
 

-  /* The `next' field is normally used to chain all lrecords together
+  /* The `next' field is normally used to chain all lcrecords together

      so that the GC can find (and free) all of them.
      so that the GC can find (and free) all of them.

-     `alloc_lcrecord' threads records together.
+     `alloc_lcrecord' threads lcrecords 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.
 
      The `next' field may be used for other purposes as long as some
      other mechanism is provided for letting the GC do its work.

@@ -118,13 +126,72 @@ struct free_lcrecord_header
   Lisp_Object chain;
 };
 
   Lisp_Object chain;
 };
 

-/* see alloc.c for an explanation */
-Lisp_Object this_one_is_unmarkable (Lisp_Object obj);
+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_count
+};

 
 struct lrecord_implementation
 {
 
 struct lrecord_implementation
 {

-  CONST char *name;
-  /* This function is called at GC time, to make sure that all Lisp_Objects
+  const char *name;
+
+  /* `marker' 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
      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

@@ -134,71 +201,85 @@ struct lrecord_implementation
      with the deepest level of Lisp_Object pointers.  This function
      can be NULL, meaning no GC marking is necessary. */
   Lisp_Object (*marker) (Lisp_Object);
      with the deepest level of Lisp_Object pointers.  This function
      can be NULL, meaning no GC marking is necessary. */
   Lisp_Object (*marker) (Lisp_Object);

-  /* This can be NULL if the object is an lcrecord; the
-     default_object_printer() in print.c will be used. */
+
+  /* `printer' converts the object to a printed representation.
+     This can be NULL; in this case default_object_printer() will be
+     used instead. */

   void (*printer) (Lisp_Object, Lisp_Object printcharfun, int escapeflag);
   void (*printer) (Lisp_Object, Lisp_Object printcharfun, int escapeflag);

-  /* This function is called at GC time when the object is about to
+
+  /* `finalizer' 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
      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.
 
      finalization is necessary.
 

-     WARNING: remember that the finalizer is called at dump time even
+     WARNING: remember that `finalizer' is called at dump time even

      though the object is not being freed. */
   void (*finalizer) (void *header, int for_disksave);
      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);
   /* This can be NULL, meaning compare objects with EQ(). */
   int (*equal) (Lisp_Object obj1, Lisp_Object obj2, int depth);

-  /* 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). */
+
+  /* `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. */

   unsigned long (*hash) (Lisp_Object, int);
 
   /* External data layout description */
   const struct lrecord_description *description;
 
   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);
 
   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 these is non-0.  If both are 0, it means that this type
-     is not instantiable by alloc_lcrecord(). */
+  /* 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(). */

   size_t static_size;
   size_t static_size;

-  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;
+  size_t (*size_in_bytes_method) (const void *header);
+
+  /* The (constant) index into lrecord_implementations_table */
+  enum lrecord_type 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. */
   /* 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. */

-  int basic_p;
+  unsigned int basic_p :1;

 };
 
 };
 

-extern CONST struct lrecord_implementation *lrecord_implementations_table[];
+extern const struct lrecord_implementation *lrecord_implementations_table[];

 
 #define XRECORD_LHEADER_IMPLEMENTATION(obj) \
 
 #define XRECORD_LHEADER_IMPLEMENTATION(obj) \

-   (lrecord_implementations_table[XRECORD_LHEADER (obj)->type])
-#define LHEADER_IMPLEMENTATION(lh) (lrecord_implementations_table[(lh)->type])
+   LHEADER_IMPLEMENTATION (XRECORD_LHEADER (obj))
+#define LHEADER_IMPLEMENTATION(lh) lrecord_implementations_table[(lh)->type]

 
 extern int gc_in_progress;
 
 
 extern int gc_in_progress;
 

-#define MARKED_RECORD_P(obj) (gc_in_progress && XRECORD_LHEADER (obj)->mark)
+#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 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 UNMARKABLE_RECORD_HEADER_P(lheader) \
-  (LHEADER_IMPLEMENTATION (lheader)->marker == this_one_is_unmarkable)
-

 #define C_READONLY_RECORD_HEADER_P(lheader)  ((lheader)->c_readonly)
 #define LISP_READONLY_RECORD_HEADER_P(lheader)  ((lheader)->lisp_readonly)
 #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) \
-  ((void) ((lheader)->c_readonly = (lheader)->lisp_readonly = 1))
+#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 SET_LISP_READONLY_RECORD_HEADER(lheader) \
   ((void) ((lheader)->lisp_readonly = 1))

+#define RECORD_MARKER(lheader) lrecord_markers[(lheader)->type]

 
 /* External description stuff
 
 
 /* External description stuff
 

@@ -210,17 +291,19 @@ extern int gc_in_progress;
    The description ends with a "XD_END" or "XD_SPECIFIER_END" record.
 
    Some example descriptions :
    The description ends with a "XD_END" or "XD_SPECIFIER_END" record.
 
    Some example descriptions :

+

    static const struct lrecord_description cons_description[] = {
    static const struct lrecord_description cons_description[] = {

-     { XD_LISP_OBJECT, offsetof(struct Lisp_Cons, car), 2 },
+     { XD_LISP_OBJECT, offsetof (Lisp_Cons, car) },
+     { XD_LISP_OBJECT, offsetof (Lisp_Cons, cdr) },

      { XD_END }
    };
 
      { XD_END }
    };
 

-   Which means "two lisp objects starting at the 'car' element"
+   Which means "two lisp objects starting at the 'car' and 'cdr' elements"

 
   static const struct lrecord_description string_description[] = {
 
   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), 1 },
+    { 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
     { XD_END }
   };
   "A pointer to string data at 'data', the size of the pointed array being the value

@@ -228,8 +311,11 @@ extern int gc_in_progress;
 
   The existing types :
     XD_LISP_OBJECT
 
   The existing types :
     XD_LISP_OBJECT

-  Lisp objects.  The third element is the count.  This is also the type to use
-  for pointers to other lrecords.
+  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
 
     XD_LO_RESET_NIL
   Lisp objects which will be reset to Qnil when dumping.  Useful for cleaning

@@ -287,6 +373,7 @@ extern int gc_in_progress;
 */
 
 enum lrecord_description_type {
 */
 
 enum lrecord_description_type {

+  XD_LISP_OBJECT_ARRAY,

   XD_LISP_OBJECT,
   XD_LO_RESET_NIL,
   XD_LO_LINK,
   XD_LISP_OBJECT,
   XD_LO_RESET_NIL,
   XD_LO_LINK,

@@ -323,20 +410,9 @@ struct struct_description {
 #define XD_INDIRECT_DELTA(code) (((-1-code)>>8) & 255)
 
 #define XD_DYNARR_DESC(base_type, sub_desc) \
 #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) }
-
-/* 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 */
-
-#ifdef DEBUG_XEMACS
-#define CONST_IF_NOT_DEBUG
-#else
-#define CONST_IF_NOT_DEBUG CONST
-#endif
+  { 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) }

 
 /* DEFINE_LRECORD_IMPLEMENTATION is for objects with constant size.
    DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION is for objects whose size varies.
 
 /* DEFINE_LRECORD_IMPLEMENTATION is for objects with constant size.
    DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION is for objects whose size varies.

@@ -351,35 +427,44 @@ struct struct_description {
 #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,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_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,props,structtype) \
-MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,props,sizeof(structtype),0,1,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_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_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,props,structtype) \
-MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,props,sizeof (structtype),0,0,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_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_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_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,props,sizer,structtype) \
-MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,props,0,sizer,0,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_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 MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,props,size,sizer,basic_p,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)                      \
 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 =    \
+const struct lrecord_implementation lrecord_##c_name =                 \

   { name, marker, printer, nuker, equal, hash, desc,                   \
   { name, marker, printer, nuker, equal, hash, desc,                   \

-    getprop, putprop, remprop, props, size, sizer,                     \
-    &(lrecord_##c_name##_lrecord_type_index), basic_p }                        \
+    getprop, putprop, remprop, plist, size, sizer,                     \
+    lrecord_type_##c_name, basic_p }
+
+extern Lisp_Object (*lrecord_markers[]) (Lisp_Object);
+
+#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 XRECORD_LHEADER(a) ((struct lrecord_header *) XPNTR (a))
 
 #define RECORD_TYPEP(x, ty) \
 
 #define LRECORDP(a) (XTYPE (a) == Lisp_Type_Record)
 #define XRECORD_LHEADER(a) ((struct lrecord_header *) XPNTR (a))
 
 #define RECORD_TYPEP(x, ty) \

-  (LRECORDP (x) && \
-   lrecord_implementations_table[XRECORD_LHEADER (x)->type] == (ty))
+  (LRECORDP (x) && XRECORD_LHEADER (x)->type == (ty))

 
 /* NOTE: the DECLARE_LRECORD() must come before the associated
    DEFINE_LRECORD_*() or you will get compile errors.
 
 /* NOTE: the DECLARE_LRECORD() must come before the associated
    DEFINE_LRECORD_*() or you will get compile errors.

@@ -393,13 +478,12 @@ CONST_IF_NOT_DEBUG struct lrecord_implementation lrecord_##c_name =       \
 #ifdef ERROR_CHECK_TYPECHECK
 
 # define DECLARE_LRECORD(c_name, structtype)                   \
 #ifdef ERROR_CHECK_TYPECHECK
 
 # define DECLARE_LRECORD(c_name, structtype)                   \

-extern CONST_IF_NOT_DEBUG struct lrecord_implementation                \
-  lrecord_##c_name;                                            \
+extern const struct lrecord_implementation lrecord_##c_name;   \

 INLINE structtype *error_check_##c_name (Lisp_Object obj);     \
 INLINE structtype *                                            \
 error_check_##c_name (Lisp_Object obj)                         \
 {                                                              \
 INLINE structtype *error_check_##c_name (Lisp_Object obj);     \
 INLINE structtype *                                            \
 error_check_##c_name (Lisp_Object obj)                         \
 {                                                              \

-  assert (RECORD_TYPEP (obj, &lrecord_##c_name));              \
+  assert (RECORD_TYPEP (obj, lrecord_type_##c_name));          \

   return (structtype *) XPNTR (obj);                           \
 }                                                              \
 extern Lisp_Object Q##c_name##p
   return (structtype *) XPNTR (obj);                           \
 }                                                              \
 extern Lisp_Object Q##c_name##p

@@ -420,15 +504,14 @@ extern Lisp_Object Q##c_name##p
 # define XSETRECORD(var, p, c_name) do                         \
 {                                                              \
   XSETOBJ (var, Lisp_Type_Record, p);                          \
 # define XSETRECORD(var, p, c_name) do                         \
 {                                                              \
   XSETOBJ (var, Lisp_Type_Record, p);                          \

-  assert (RECORD_TYPEP (var, &lrecord_##c_name));              \
+  assert (RECORD_TYPEP (var, lrecord_type_##c_name));          \

 } while (0)
 
 #else /* not ERROR_CHECK_TYPECHECK */
 
 # define DECLARE_LRECORD(c_name, structtype)                   \
 extern Lisp_Object Q##c_name##p;                               \
 } while (0)
 
 #else /* not ERROR_CHECK_TYPECHECK */
 
 # define DECLARE_LRECORD(c_name, structtype)                   \
 extern Lisp_Object Q##c_name##p;                               \

-extern CONST_IF_NOT_DEBUG struct lrecord_implementation                \
-  lrecord_##c_name
+extern const 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))
 # define DECLARE_NONRECORD(c_name, type_enum, structtype)      \
 extern Lisp_Object Q##c_name##p
 # define XRECORD(x, c_name, structtype) ((structtype *) XPNTR (x))

@@ -438,7 +521,7 @@ extern Lisp_Object Q##c_name##p
 
 #endif /* not ERROR_CHECK_TYPECHECK */
 
 
 #endif /* not ERROR_CHECK_TYPECHECK */
 

-#define RECORDP(x, c_name) RECORD_TYPEP (x, &lrecord_##c_name)
+#define RECORDP(x, c_name) RECORD_TYPEP (x, lrecord_type_##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
 
 /* Note: we now have two different kinds of type-checking macros.
    The "old" kind has now been renamed CONCHECK_foo.  The reason for

@@ -464,7 +547,7 @@ extern Lisp_Object Q##c_name##p
    way out and disabled returning from a signal entirely. */
 
 #define CONCHECK_RECORD(x, c_name) do {                        \
    way out and disabled returning from a signal entirely. */
 
 #define CONCHECK_RECORD(x, c_name) do {                        \

- if (!RECORD_TYPEP (x, &lrecord_##c_name))             \
+ if (!RECORD_TYPEP (x, lrecord_type_##c_name))         \

    x = wrong_type_argument (Q##c_name##p, x);          \
 }  while (0)
 #define CONCHECK_NONRECORD(x, lisp_enum, predicate) do {\
    x = wrong_type_argument (Q##c_name##p, x);          \
 }  while (0)
 #define CONCHECK_NONRECORD(x, lisp_enum, predicate) do {\

@@ -472,7 +555,7 @@ extern Lisp_Object Q##c_name##p
    x = wrong_type_argument (predicate, x);             \
  } while (0)
 #define CHECK_RECORD(x, c_name) do {                   \
    x = wrong_type_argument (predicate, x);             \
  } while (0)
 #define CHECK_RECORD(x, c_name) do {                   \

- if (!RECORD_TYPEP (x, &lrecord_##c_name))             \
+ if (!RECORD_TYPEP (x, lrecord_type_##c_name))         \

    dead_wrong_type_argument (Q##c_name##p, x);         \
  } while (0)
 #define CHECK_NONRECORD(x, lisp_enum, predicate) do {  \
    dead_wrong_type_argument (Q##c_name##p, x);         \
  } while (0)
 #define CHECK_NONRECORD(x, lisp_enum, predicate) do {  \

@@ -480,7 +563,7 @@ extern Lisp_Object Q##c_name##p
    dead_wrong_type_argument (predicate, x);            \
  } while (0)
 
    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))
 
 #define alloc_lcrecord_type(type, lrecord_implementation) \
   ((type *) alloc_lcrecord (sizeof (type), lrecord_implementation))

@@ -497,4 +580,4 @@ void *alloc_lcrecord (size_t size, CONST struct lrecord_implementation *);
    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 /* _XEMACS_LRECORD_H_ */
+#endif /* INCLUDED_lrecord_h_ */