/* The "lrecord" structure (header of a compound lisp object).
   Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
   Copyright (C) 1996, 2001, 2002, 2004, 2005, 2009, 2010 Ben Wing.

This file is part of XEmacs.

XEmacs is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the
Free Software Foundation; either version 2, or (at your option) any
later version.

XEmacs is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
for more details.

You should have received a copy of the GNU General Public License
along with XEmacs; see the file COPYING.  If not, write to
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */

/* Synched up with: Not in FSF. */

/* This file has been Mule-ized, Ben Wing, 10-13-04. */

#ifndef INCLUDED_lrecord_h_
#define INCLUDED_lrecord_h_

/* All objects other than char and int are implemented as structures and
   passed by reference.  Such objects are called "record objects" ("record"
   is another term for "structure").  The "wrapped" value of such an object
   (i.e. when stored in a variable of type Lisp_Object) is simply the raw
   pointer coerced to an integral type the same size as the pointer
   (usually `long').
   
   Under old-GC (i.e. when NEW_GC is not defined), there are two kinds of
   record objects: normal objects (those allocated on their own with
   xmalloc()) and frob-block objects (those allocated as pieces of large,
   usually 2K, chunks of memory known as "frob blocks").  Under NEW_GC,
   there is only one type of record object.  Stuff below that applies to
   frob-block objects is assumed to apply to the same type of object as
   normal objects under NEW_GC.

   Record objects have a header at the beginning of their structure, which
   is used internally to identify the type of the object (so that an
   object's type can be recovered from its pointer); in addition, it holds
   a few flags and a "UID", which for most objects is shown when it is
   printed, and is primarily useful for debugging purposes.  The header of
   a normal object is declared as NORMAL_LISP_OBJECT_HEADER and that of a
   frob-block object FROB_BLOCK_LISP_OBJECT_HEADER.

   FROB_BLOCK_LISP_OBJECT_HEADER boils down to a `struct lrecord_header'.
   This is a 32-bit value made up of bit fields, where 8 bits are used to
   hold the type, 2 or 3 bits are used for flags associated with the
   garbage collector, and the remaining 21 or 22 bits hold the UID.

   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 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 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
   is a thin wrapper around malloc()).  Frob-block objects are more
   efficient than normal objects, as they have a smaller header and don't
   have the additional memory overhead associated with malloc() -- instead,
   as mentioned above, they are carved out of 2K chunks of memory called
   "frob blocks").  However, it is slightly more tricky to create such
   objects, as they require special routines in alloc.c to create an object
   of each such type and to sweep them during garbage collection.  In
   addition, there is currently no mechanism for handling variable-sized
   frob-block objects (e.g. vectors), whereas variable-sized normal objects
   are not a problem.  Frob-block objects are typically used for basic
   objects that exist in large numbers, such as `cons' or `string'.

   Note that strings are an apparent exception to the statement above that
   variable-sized objects can't be handled.  Under old-GC strings work as
   follows.  A string consists of two parts -- a fixed-size "string header"
   that is allocated as a standard frob-block object, and a "string-chars"
   structure that is allocated out of special 8K-sized frob blocks that
   have a dedicated garbage-collection handler that compacts the blocks
   during the sweep stage, relocating the string-chars data (but not the
   string headers) to eliminate gaps.  Strings larger than 8K are not
   placed in frob blocks, but instead are stored as individually malloc()ed
   blocks of memory.  Strings larger than 8K are called "big strings" and
   those smaller than 8K are called "small strings".

   Under new-GC, there is no difference between big and small strings,
   just as there is no difference between normal and frob-block objects.
   There is only one allocation method, which is capable of handling
   variable-sized objects.  This apparently allocates all objects in
   frob blocks according to the size of the object.

   To create a new normal Lisp object, see the toolbar-button example
   below.  To create a new frob-block Lisp object, follow the lead of
   one of the existing frob-block objects, such as extents or events.
   Note that you do not need to supply all the methods (see below);
   reasonable defaults are provided for many of them.  Alternatively, if
   you're just looking for a way of encapsulating data (which possibly
   could contain Lisp_Objects in it), you may well be able to use the
   opaque type.
*/

/*
  How to declare a Lisp object:

   NORMAL_LISP_OBJECT_HEADER:
      Header for normal objects

   FROB_BLOCK_LISP_OBJECT_HEADER:
      Header for frob-block objects

  How to allocate a Lisp object:

   - For normal objects of a fixed size, simply call
     ALLOC_NORMAL_LISP_OBJECT (type), where TYPE is the name of the type
     (e.g. toolbar_button).  Such objects can be freed manually using
     free_normal_lisp_object.

   - For normal objects whose size can vary (and hence which have a
     size_in_bytes_method rather than a static_size), call
     ALLOC_SIZED_LISP_OBJECT (size, type), where TYPE is the
     name of the type. NOTE: You cannot call free_normal_lisp_object() on such
     on object! (At least when not NEW_GC)

   - For frob-block objects, use
     ALLOC_FROB_BLOCK_LISP_OBJECT (type, lisp_type, var, lrec_ptr).
     But these objects need special handling; if you don't understand this,
     just ignore it.

   - Some lrecords, which are used totally internally, use the
     noseeum-* functions for debugging reasons.

  Other operations:

   - copy_lisp_object (dst, src)

   - zero_nonsized_lisp_object (obj), zero_sized_lisp_object (obj, size):
     BUT NOTE, it is not necessary to zero out newly allocated Lisp objects.
     This happens automatically.

   - lisp_object_size (obj): Return the size of a Lisp object. NOTE: This
     requires that the object is properly initialized.

   - lisp_object_storage_size (obj, stats): Return the storage size of a
     Lisp objcet, including malloc or frob-block overhead; also, if STATS
     is non-NULL, accumulate info about the size and overhead into STATS.
 */

#ifdef NEW_GC
/*
  There are some limitations under New-GC that lead to the creation of a
  large number of new internal object types.  I'm not completely sure what
  all of them are, but they are at least partially related to limitations
  on finalizers.  Something else must be going on as well, because
  non-dumpable, non-finalizable objects like devices and frames also have
  their window-system-specific substructures converted into Lisp objects.
  It must have something to do with the fact that these substructures
  contain pointers to Lisp objects, but it's not completely clear why --
  object descriptions exist to indicate the size of these structures and
  the Lisp object pointers within them.

  At least one definite issue is that under New-GC dumpable objects cannot
  contain any finalizers (see pdump_register_object()).  This means that
  any substructures in dumpable objects that are allocated separately and
  normally freed in a finalizer need instead to be made into actual Lisp
  objects.  If those structures are Dynarrs, they need to be made into
  Dynarr Lisp objects (e.g. face-cachel-dynarr or glyph-cachel-dynarr),
  which are created using Dynarr_lisp_new() or Dynarr_new_new2().
  Furthermore, the objects contained in the Dynarr also need to be Lisp
  objects (e.g. face-cachel or glyph-cachel).

 --ben
 */
#endif

#ifdef NEW_GC
#define ALLOC_NORMAL_LISP_OBJECT(type) alloc_lrecord (&lrecord_##type)
#define ALLOC_SIZED_LISP_OBJECT(size, type) \
  alloc_sized_lrecord (size, &lrecord_##type)
#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 IF_NEW_GC(x) x
#define IF_OLD_GC(x) 0
#else /* not NEW_GC */
#define ALLOC_NORMAL_LISP_OBJECT(type) alloc_automanaged_lcrecord (&lrecord_##type)
#define ALLOC_SIZED_LISP_OBJECT(size, type) \
  old_alloc_sized_lcrecord (size, &lrecord_##type)
#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 IF_NEW_GC(x) 0
#define IF_OLD_GC(x) x
#endif /* not NEW_GC */

#define LISP_OBJECT_UID(obj) (XRECORD_LHEADER (obj)->uid)

BEGIN_C_DECLS

struct lrecord_header
{
  /* Index into lrecord_implementations_table[].  Objects that have been
     explicitly freed using e.g. free_cons() have lrecord_type_free in this
     field. */
  unsigned int type :8;

#ifdef NEW_GC
  /* 1 if the object is readonly from lisp */
  unsigned int lisp_readonly :1;

  /* The `free' field is a flag that indicates whether this lrecord
     is currently free or not. This is used for error checking and
     debugging. */
  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 :22;

#else /* not NEW_GC */
  /* 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;

  /* 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 :20;

#endif /* not NEW_GC */
};

struct lrecord_implementation;
int lrecord_type_index (const struct lrecord_implementation *implementation);
extern int lrecord_uid_counter[];

#ifdef NEW_GC
#define set_lheader_implementation(header,imp) do {			\
  struct lrecord_header* SLI_header = (header);				\
  SLI_header->type = (imp)->lrecord_type_index;				\
  SLI_header->lisp_readonly = 0;					\
  SLI_header->free = 0;							\
  SLI_header->uid = lrecord_uid_counter[(imp)->lrecord_type_index]++;   \
} while (0)
#else /* not NEW_GC */
#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->free = 0;							\
  SLI_header->uid = lrecord_uid_counter[(imp)->lrecord_type_index]++;   \
} while (0)
#endif /* not NEW_GC */

#ifndef NEW_GC
struct old_lcrecord_header
{
  struct lrecord_header lheader;

  /* The `next' field is normally used to chain all lcrecords together
     so that the GC can find (and free) all of them.
     `old_alloc_sized_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.

     For example, the event and marker object types allocate members
     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;
};

/* Used for lcrecords in an lcrecord-list. */
struct free_lcrecord_header
{
  struct old_lcrecord_header lcheader;
  Lisp_Object chain;
};
#endif /* not NEW_GC */

/* DON'T FORGET to update .gdbinit.in if you change this list. */
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. */
  /* Don't assign any type to 0, so in case we come across zeroed memory
     it will be more obvious when printed */
  lrecord_type_symbol_value_forward = 1,
  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_multiple_value,
  lrecord_type_cons,
  lrecord_type_vector,
  lrecord_type_string,
#ifndef NEW_GC
  lrecord_type_lcrecord_list,
#endif /* not NEW_GC */
  lrecord_type_compiled_function,
  lrecord_type_weak_list,
  lrecord_type_bit_vector,
  lrecord_type_float,
  lrecord_type_hash_table_test,
  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,
#ifdef EVENT_DATA_AS_OBJECTS /* not defined */
  lrecord_type_key_data,
  lrecord_type_button_data,
  lrecord_type_motion_data,
  lrecord_type_process_data,
  lrecord_type_timeout_data,
  lrecord_type_eval_data,
  lrecord_type_misc_user_data,
  lrecord_type_magic_eval_data,
  lrecord_type_magic_data,
#endif /* EVENT_DATA_AS_OBJECTS */
  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_mirror,
  lrecord_type_gui_item,
  lrecord_type_toolbar_button,
  lrecord_type_scrollbar_instance,
  lrecord_type_color_instance,
  lrecord_type_font_instance,
  lrecord_type_image_instance,
  lrecord_type_glyph,
  lrecord_type_face,
  lrecord_type_fc_config,
  lrecord_type_fc_pattern,
  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_mswindows_dialog_id,
  lrecord_type_case_table,
  lrecord_type_emacs_ffi,
  lrecord_type_emacs_gtk_object,
  lrecord_type_emacs_gtk_boxed,
  lrecord_type_weak_box,
  lrecord_type_ephemeron,
  lrecord_type_bignum,
  lrecord_type_ratio,
  lrecord_type_bigfloat,
#ifndef NEW_GC
  lrecord_type_free, /* only used for "free" lrecords */
  lrecord_type_undefined, /* only used for debugging */
#endif /* not NEW_GC */
#ifdef NEW_GC
  /* See comment up top explaining why these extra object types must exist. */
  lrecord_type_string_indirect_data,
  lrecord_type_string_direct_data,
  lrecord_type_hash_table_entry,
  lrecord_type_syntax_cache,
  lrecord_type_buffer_text,
  lrecord_type_compiled_function_args,
  lrecord_type_tty_console,
  lrecord_type_stream_console,
  lrecord_type_dynarr,
  lrecord_type_face_cachel,
  lrecord_type_face_cachel_dynarr,
  lrecord_type_glyph_cachel,
  lrecord_type_glyph_cachel_dynarr,
  lrecord_type_x_device,
  lrecord_type_gtk_device,
  lrecord_type_tty_device,
  lrecord_type_mswindows_device,
  lrecord_type_msprinter_device,
  lrecord_type_x_frame,
  lrecord_type_gtk_frame,
  lrecord_type_mswindows_frame,
  lrecord_type_gap_array_marker,
  lrecord_type_gap_array,
  lrecord_type_extent_list_marker,
  lrecord_type_extent_list,
  lrecord_type_stack_of_extents,
  lrecord_type_tty_color_instance_data,
  lrecord_type_tty_font_instance_data,
  lrecord_type_specifier_caching,
  lrecord_type_expose_ignore,
#endif /* NEW_GC */
  lrecord_type_last_built_in_type         /* must be last */
};

extern MODULE_API int lrecord_type_count;

struct lrecord_implementation
{
  const Ascbyte *name;

  /* information for the dumper: is the object dumpable and should it 
     be dumped. */
  unsigned int dumpable :1;

  /* `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
     marked (don't call the mark_object function explicitly on it,
     because the GC routines will do this).  Doing it this way reduces
     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.

     NOTE NOTE NOTE: This is not used by KKCC (which uses the data
     description below instead), unless the data description is missing.
     Yes, this currently means there is logic duplication.  Eventually the
     mark methods will be removed. */
  Lisp_Object (*marker) (Lisp_Object);

  /* `printer' converts the object to a printed representation.  `printer'
     should never be NULL (if so, you will get an assertion failure when
     trying to print such an object).  Either supply a specific printing
     method, or use the default methods internal_object_printer() (for
     internal objects that should not be visible at Lisp level) or
     external_object_printer() (for objects visible at Lisp level). */
  void (*printer) (Lisp_Object, Lisp_Object printcharfun, int escapeflag);

  /* `finalizer' is called at GC time when the object is about to be freed.
     It should perform any necessary cleanup, such as freeing malloc()ed
     memory or releasing pointers or handles to objects created in external
     libraries, such as window-system windows or file handles.  This can be
     NULL, meaning no special finalization is necessary. */
  void (*finalizer) (Lisp_Object obj);

  /* This can be NULL, meaning compare objects with EQ(). */
  int (*equal) (Lisp_Object obj1, Lisp_Object obj2, int depth,
		int foldcase);

  /* `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. */
  Hashcode (*hash) (Lisp_Object, int, Boolint);

  /* Data layout description for your object.  See long comment below. */
  const struct memory_description *description;

  /* Only one of `static_size' and `size_in_bytes_method' is non-0.  If
     `static_size' is 0, this type is not instantiable by
     ALLOC_NORMAL_LISP_OBJECT().  If both are 0 (this should never happen),
     this object cannot be instantiated; you will get an abort() if you
     try.*/
  Bytecount static_size;
  Bytecount (*size_in_bytes_method) (Lisp_Object);

  /* The (constant) index into lrecord_implementations_table */
  enum lrecord_type lrecord_type_index;

#ifndef NEW_GC
  /* A "frob-block" lrecord is any lrecord that's not an lcrecord, i.e.
     one that does not have an old_lcrecord_header at the front and which
     is (usually) allocated in frob blocks. */
  unsigned int frob_block_p :1;
#endif /* not NEW_GC */

  /**********************************************************************/
  /* Remaining stuff is not assignable statically using
     DEFINE_*_LISP_OBJECT, but must be assigned with OBJECT_HAS_METHOD,
     OBJECT_HAS_PROPERTY or the like. */

  /* 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 (*setplist) (Lisp_Object obj, Lisp_Object newplist);

  /* `disksave' is called at dump time.  It is used for objects that
     contain pointers or handles to objects created in external libraries,
     such as window-system windows or file handles.  Such external objects
     cannot be dumped, so it is necessary to release them at dump time and
     arrange somehow or other for them to be resurrected if necessary later
     on.

     It seems that even non-dumpable objects may be around at dump time,
     and a disksave may be provided. (In fact, the only object currently
     with a disksave, lstream, is non-dumpable.)
     
     Objects rarely need to provide this method; most of the time it will
     be NULL. */
  void (*disksave) (Lisp_Object);

#ifdef MEMORY_USAGE_STATS
  /* Return memory-usage information about the object in question, stored
     into STATS.

     Two types of information are stored: storage (including overhead) for
     ancillary non-Lisp structures attached to the object, and storage
     (including overhead) for ancillary Lisp objects attached to the
     object.  The third type of memory-usage information (storage for the
     object itself) is not noted here, because it's computed automatically
     by the calling function.  Also, the computed storage for ancillary
     Lisp objects is the sum of all three source of memory associated with
     the Lisp object: the object itself, ancillary non-Lisp structures and
     ancillary Lisp objects.  Note also that the `struct usage_stats u' at
     the beginning of the STATS structure is for ancillary non-Lisp usage
     *ONLY*; do not store any memory into it related to ancillary Lisp
     objects.

     Note that it may be subjective which Lisp objects are considered
     "attached" to the object.  Some guidelines:

     -- Lisp objects which are "internal" to the main object and not
        accessible except through the main object should be included
     -- Objects linked by a weak reference should *NOT* be included
  */
  void (*memory_usage) (Lisp_Object obj, struct generic_usage_stats *stats);

  /* List of tags to be given to the extra statistics, one per statistic.
     Qnil or Qt can be present to separate off different slices.  Qnil
     separates different slices within the same group of statistics.
     These represent different ways of partitioning the same memory space.
     Qt separates different groups; these represent different spaces of
     memory.

     If Qt is not present, all slices describe extra non-Lisp-Object memory
     associated with a Lisp object.  If Qt is present, slices before Qt
     describe non-Lisp-Object memory, as before, and slices after Qt
     describe ancillary Lisp-Object memory logically associated with the
     object.  For example, if the object is a table, then ancillary
     Lisp-Object memory might be the entries in the table.  This info is
     only advisory since it will duplicate memory described elsewhere and
     since it may not be possible to be completely accurate, e.g. it may
     not be clear what to count in "ancillary objects", and the value may
     be too high if the same object occurs multiple times in the table. */
  Lisp_Object memusage_stats_list;

  /* --------------------------------------------------------------------- */

  /* The following are automatically computed based on the value in
     `memusage_stats_list' (see compute_memusage_stats_length()). */

  /* Total number of additional type-specific statistics related to memory
     usage. */
  Elemcount num_extra_memusage_stats;

  /* Number of additional type-specific statistics belonging to the first
     slice of the group describing non-Lisp-Object memory usage for this
     object.  These stats occur starting at offset 0. */
  Elemcount num_extra_nonlisp_memusage_stats;

  /* The offset into the extra statistics at which the Lisp-Object
     memory-usage statistics begin. */
  Elemcount offset_lisp_ancillary_memusage_stats;

  /* Number of additional type-specific statistics belonging to the first
     slice of the group describing Lisp-Object memory usage for this
     object.  These stats occur starting at offset
     `offset_lisp_ancillary_memusage_stats'. */
  Elemcount num_extra_lisp_ancillary_memusage_stats;

#endif /* MEMORY_USAGE_STATS */
};

/* All the built-in lisp object types are enumerated in `enum lrecord_type'.
   Additional ones may be defined by a module (none yet).  We leave some
   room in `lrecord_implementations_table' for such new lisp object types. */
#define MODULE_DEFINABLE_TYPE_COUNT 32

extern MODULE_API struct lrecord_implementation *
lrecord_implementations_table[lrecord_type_last_built_in_type + MODULE_DEFINABLE_TYPE_COUNT];

/* Given a Lisp object, return its implementation
   (struct lrecord_implementation) */
#define XRECORD_LHEADER_IMPLEMENTATION(obj) \
   LHEADER_IMPLEMENTATION (XRECORD_LHEADER (obj))
#define LHEADER_IMPLEMENTATION(lh) lrecord_implementations_table[(lh)->type]

#include "gc.h"

#ifdef NEW_GC
#include "vdb.h"
#endif /* NEW_GC */

extern int gc_in_progress;

#ifdef NEW_GC
#include "mc-alloc.h"

#ifdef ALLOC_TYPE_STATS
void init_lrecord_stats (void);
void inc_lrecord_stats (Bytecount size, const struct lrecord_header *h);
void dec_lrecord_stats (Bytecount size_including_overhead, 
			const struct lrecord_header *h);
int lrecord_stats_heap_size (void);
#endif /* ALLOC_TYPE_STATS */

/* Tell mc-alloc how to call a finalizer. */
#define MC_ALLOC_CALL_FINALIZER(ptr)					\
{									\
  Lisp_Object MCACF_obj = wrap_pointer_1 (ptr);				\
  struct lrecord_header *MCACF_lheader = XRECORD_LHEADER (MCACF_obj);   \
  if (XRECORD_LHEADER (MCACF_obj) && LRECORDP (MCACF_obj)		\
      && !LRECORD_FREE_P (MCACF_lheader)  )				\
    {									\
      const struct lrecord_implementation *MCACF_implementation		\
	= LHEADER_IMPLEMENTATION (MCACF_lheader);			\
      if (MCACF_implementation && MCACF_implementation->finalizer)	\
        {								\
	  GC_STAT_FINALIZED;						\
          MCACF_implementation->finalizer (MCACF_obj);			\
        }								\
    }									\
} while (0)

/* Tell mc-alloc how to call a finalizer for disksave. */
#define MC_ALLOC_CALL_FINALIZER_FOR_DISKSAVE(ptr)			\
{									\
  Lisp_Object MCACF_obj = wrap_pointer_1 (ptr);				\
  struct lrecord_header *MCACF_lheader = XRECORD_LHEADER (MCACF_obj);   \
  if (XRECORD_LHEADER (MCACF_obj) && LRECORDP (MCACF_obj)		\
      && !LRECORD_FREE_P (MCACF_lheader)  )				\
    {									\
      const struct lrecord_implementation *MCACF_implementation		\
	= LHEADER_IMPLEMENTATION (MCACF_lheader);			\
      if (MCACF_implementation && MCACF_implementation->disksave)	\
	MCACF_implementation->disksave (MCACF_obj);			\
    }									\
} while (0)

#define LRECORD_FREE_P(ptr)			\
(((struct lrecord_header *) ptr)->free)

#define MARK_LRECORD_AS_FREE(ptr)			\
((void) (((struct lrecord_header *) ptr)->free = 1))

#define MARK_LRECORD_AS_NOT_FREE(ptr)			\
((void) (((struct lrecord_header *) ptr)->free = 0))

#define MARKED_RECORD_P(obj) MARKED_P (obj)
#define MARKED_RECORD_HEADER_P(lheader) MARKED_P (lheader)
#define MARK_RECORD_HEADER(lheader)   MARK (lheader)
#define UNMARK_RECORD_HEADER(lheader) UNMARK (lheader)

#define LISP_READONLY_RECORD_HEADER_P(lheader)  ((lheader)->lisp_readonly)
#define SET_LISP_READONLY_RECORD_HEADER(lheader) \
  ((void) ((lheader)->lisp_readonly = 1))
#define MARK_LRECORD_AS_LISP_READONLY(ptr)			\
((void) (((struct lrecord_header *) ptr)->lisp_readonly = 1))

#else /* not NEW_GC */

enum lrecord_alloc_status
{
  ALLOC_IN_USE,
  ALLOC_FREE,
  ALLOC_ON_FREE_LIST
};

void tick_lrecord_stats (const struct lrecord_header *h,
			 enum lrecord_alloc_status status);

#define LRECORD_FREE_P(ptr)					\
(((struct lrecord_header *) ptr)->type == lrecord_type_free)

#define MARK_LRECORD_AS_FREE(ptr)					\
((void) (((struct lrecord_header *) ptr)->type = lrecord_type_free))

#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))
#endif /* not NEW_GC */

#ifdef USE_KKCC
#define RECORD_DESCRIPTION(lheader) lrecord_memory_descriptions[(lheader)->type]
#else /* not USE_KKCC */
#define RECORD_MARKER(lheader) lrecord_markers[(lheader)->type]
#endif /* not USE_KKCC */

#define RECORD_DUMPABLE(lheader) (lrecord_implementations_table[(lheader)->type])->dumpable

/* Data description stuff

   Data layout descriptions describe blocks of memory (in particular, Lisp
   objects and other objects on the heap, and global objects with pointers
   to such heap objects), including their size and a list of the elements
   that need relocating, marking or other special handling.  They are
   currently used in two places: by pdump [the new, portable dumper] and
   KKCC [the new garbage collector].  The two subsystems use the
   descriptions in different ways, and as a result some of the descriptions
   are appropriate only for one or the other, when it is known that only
   that subsystem will use the description. (This is particularly the case
   with objects that can't be dumped, because pdump needs more info than
   KKCC.) However, properly written descriptions are appropriate for both,
   and you should strive to write your descriptions that way, since the
   dumpable status of an object may change and new uses for the
   descriptions may be created. (An example that comes to mind is a
   facility for determining the memory usage of XEmacs data structures --
   like `buffer-memory-usage', `window-memory-usage', etc. but more
   general.)

   More specifically:

   Pdump (the portable dumper) needs to write out all objects in heap
   space, and later on (in another invocation of XEmacs) load them back
   into the heap, relocating all pointers to the heap objects in the global
   data space. ("Heap" means anything malloc()ed, including all Lisp
   objects, and "global data" means anything declared globally or
   `static'.) Pdump, then, needs to be told about the location of all
   global pointers to heap objects, all the description of all such
   objects, including their size and any pointers to other heap (aka
   "relocatable") objects. (Pdump assumes that the heap may occur in
   different places in different invocations -- therefore, it is not enough
   simply to write out the entire heap and later reload it at the same
   location -- but that global data is always in the same place, and hence
   pointers to it do not need to be relocated.  This assumption holds true
   in general for modern operating systems, but would be broken, for
   example, in a system without virtual memory, or when dealing with shared
   libraries.  Also, unlike unexec, pdump does not usually write out or
   restore objects in the global data space, and thus they need to be
   initialized every time XEmacs is loaded.  This is the purpose of the
   reinit_*() functions throughout XEmacs. [It's possible, however, to make
   pdump restore global data.  This must be done, of course, for heap
   pointers, but is also done for other values that are not easy to
   recompute -- in particular, values established by the Lisp code loaded
   at dump time.]) Note that the data type `Lisp_Object' is basically just
   a relocatable pointer disguised as a long, and in general pdump treats
   the Lisp_Object values and pointers to Lisp objects (e.g. Lisp_Object
   vs. `struct frame *') identically. (NOTE: This equivalence depends
   crucially on the current "minimal tagbits" implementation of Lisp_Object
   pointers.)

   Descriptions are used by pdump in three places: (a) descriptions of Lisp
   objects, referenced in the DEFINE_*LRECORD_*IMPLEMENTATION*() call; (b)
   descriptions of global objects to be dumped, registered by
   dump_add_root_block(); (c) descriptions of global pointers to
   non-Lisp_Object heap objects, registered by dump_add_root_block_ptr().
   The descriptions need to tell pdump which elements of your structure are
   Lisp_Objects or structure pointers, plus the descriptions in turn of the
   non-Lisp_Object structures pointed to.  If these structures are you own
   private ones, you will have to write these recursive descriptions
   yourself; otherwise, you are reusing a structure already in existence
   elsewhere and there is probably already a description for it.

   Pdump does not care about Lisp objects that cannot be dumped (the
   dumpable flag to DEFINE_*LRECORD_*IMPLEMENTATION*() is 0).

   KKCC also uses data layout descriptions, but differently.  It cares
   about all objects, dumpable or not, but specifically only wants to know
   about Lisp_Objects in your object and in structures pointed to.  Thus,
   it doesn't care about things like pointers to structures ot other blocks
   of memory with no Lisp Objects in them, which pdump would care a lot
   about.

   Technically, then, you could write your description differently
   depending on whether your object is dumpable -- the full pdump
   description if so, the abbreviated KKCC description if not.  In fact,
   some descriptions are written this way.  This is dangerous, though,
   because another use might come along for the data descriptions, that
   doesn't care about the dumper flag and makes use of some of the stuff
   normally omitted from the "abbreviated" description -- see above.

   A memory_description is an array of values.  The first value of each
   line is a type, the second the offset in the lrecord structure.  The
   third and following elements are parameters; their presence, type and
   number is type-dependent.

   The description ends with an "XD_END" record.

   The top-level description of an lrecord or lcrecord does not need
   to describe every element, just the ones that need to be relocated,
   since the size of the lrecord is known. (The same goes for nested
   structures, whenever the structure size is given, rather than being
   defaulted by specifying 0 for the size.)

   A sized_memory_description is a memory_description plus the size of the
   block of memory.  The size field in a sized_memory_description can be
   given as zero, i.e. unspecified, meaning that the last element in the
   structure is described in the description and the size of the block can
   therefore be computed from it. (This is useful for stretchy arrays.)

   memory_descriptions are used to describe lrecords (the size of the
   lrecord is elsewhere in its description, attached to its methods, so it
   does not need to be given here) and global objects, where the size is an
   argument to the call to dump_add_root_block().
   sized_memory_descriptions are used for pointers and arrays in
   memory_descriptions and for calls to dump_add_root_block_ptr(). (####
   It is not obvious why this is so in the latter case.  Probably, calls to
   dump_add_root_block_ptr() should use plain memory_descriptions and have
   the size be an argument to the call.)

   NOTE: Anywhere that a sized_memory_description occurs inside of a plain
   memory_description, a "description map" can be substituted.  Rather than
   being an actual description, this describes how to find the description
   by looking inside of the object being described.  This is a convenient
   way to describe Lisp objects with subtypes and corresponding
   type-specific data.

   Some example descriptions :

   struct Lisp_String
   {
     struct lrecord_header lheader;
     Bytecount size;
     Ibyte *data;
     Lisp_Object plist;
   };

   static const struct memory_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"

   static const struct memory_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'"

   If your object has a pointer to an array of Lisp_Objects in it, something
   like this:

   struct Lisp_Foo
   {
     ...;
     int count;
     Lisp_Object *objects;
     ...;
   }

   You'd use XD_BLOCK_PTR, something like:

   static const struct memory_description foo_description[] = {
     ...
     { XD_INT,		offsetof (Lisp_Foo, count) },
     { XD_BLOCK_PTR,	offsetof (Lisp_Foo, objects),
       XD_INDIRECT (0, 0), { &lisp_object_description } },
     ...
   };

   lisp_object_description is declared in gc.c, like this:

   static const struct memory_description lisp_object_description_1[] = {
     { XD_LISP_OBJECT, 0 },
     { XD_END }
   };

   const struct sized_memory_description lisp_object_description = {
     sizeof (Lisp_Object),
     lisp_object_description_1
   };

   Another example of XD_BLOCK_PTR:

   typedef struct htentry
   {
     Lisp_Object key;
     Lisp_Object value;
   } htentry;
   
   struct Lisp_Hash_Table
   {
     NORMAL_LISP_OBJECT_HEADER header;
     Elemcount size;
     Elemcount count;
     Elemcount rehash_count;
     double rehash_size;
     double rehash_threshold;
     Elemcount golden_ratio;
     hash_table_hash_function_t hash_function;
     hash_table_test_function_t test_function;
     htentry *hentries;
     enum hash_table_weakness weakness;
     Lisp_Object next_weak;     // Used to chain together all of the weak
   			        // hash tables.  Don't mark through this.
   };

   static const struct memory_description htentry_description_1[] = {
     { XD_LISP_OBJECT, offsetof (htentry, key) },
     { XD_LISP_OBJECT, offsetof (htentry, value) },
     { XD_END }
   };
   
   static const struct sized_memory_description htentry_description = {
     sizeof (htentry),
     htentry_description_1
   };
   
   const struct memory_description hash_table_description[] = {
     { XD_ELEMCOUNT,     offsetof (Lisp_Hash_Table, size) },
     { XD_BLOCK_PTR, offsetof (Lisp_Hash_Table, hentries), XD_INDIRECT (0, 1),
	 { &htentry_description } },
     { XD_LO_LINK,    offsetof (Lisp_Hash_Table, next_weak) },
     { XD_END }
   };

   Note that we don't need to declare all the elements in the structure, just
   the ones that need to be relocated (Lisp_Objects and structures) or that
   need to be referenced as counts for relocated objects.

   A description map looks like this:

   static const struct sized_memory_description specifier_extra_description_map [] = {
   { offsetof (Lisp_Specifier, methods) },
   { offsetof (struct specifier_methods, extra_description) },
   { -1 }
   };
 
   const struct memory_description specifier_description[] = {
     ...
     { XD_BLOCK_ARRAY, offset (Lisp_Specifier, data), 1,
       { specifier_extra_description_map } },
     ...
     { XD_END }
   };

   This would be appropriate for an object that looks like this:
 
   struct specifier_methods
   {
     ...
     const struct sized_memory_description *extra_description;
     ...
   };

   struct Lisp_Specifier
   {
     NORMAL_LISP_OBJECT_HEADER header;
     struct specifier_methods *methods;
   
     ...
     // type-specific extra data attached to a specifier
     max_align_t data[1];
   };

   The description map means "retrieve a pointer into the object at offset
   `offsetof (Lisp_Specifier, methods)' , then in turn retrieve a pointer
   into that object at offset `offsetof (struct specifier_methods,
   extra_description)', and that is the sized_memory_description to use." 
   There can be any number of indirections, which can be either into
   straight pointers or Lisp_Objects.  The way that description maps are
   distinguished from normal sized_memory_descriptions is that in the
   former, the memory_description pointer is NULL.

   --ben


   The existing types :


    XD_LISP_OBJECT

  A Lisp_Object.  This is also the type to use for pointers to other lrecords
  (e.g. struct frame *).

    XD_LISP_OBJECT_ARRAY

  An array of Lisp_Objects or (equivalently) pointers to lrecords.
  The parameter (i.e. third element) is the count.  This would be declared
  as Lisp_Object foo[666].  For something declared as Lisp_Object *foo,
  use XD_BLOCK_PTR, whose description parameter is a sized_memory_description
  consisting of only XD_LISP_OBJECT and XD_END.

    XD_INLINE_LISP_OBJECT_BLOCK_PTR

  An pointer to a contiguous block of inline Lisp objects -- i.e., the Lisp
  object itself rather than a Lisp_Object pointer is stored in the block.
  This is used only under NEW_GC and is useful for increased efficiency when
  an array of the same kind of object is needed.  Examples of the use of this
  type are Lisp dynarrs, where the array elements are inline Lisp objects
  rather than non-Lisp structures, as is normally the case; and hash tables,
  where the key/value pairs are encapsulated as hash-table-entry objects and
  an array of inline hash-table-entry objects is stored.

    XD_LO_LINK

  Weak link in a linked list of objects of the same type.  This is a
  link that does NOT generate a GC reference.  Thus the pdumper will
  not automatically add the referenced object to the table of all
  objects to be dumped, and when storing and loading the dumped data
  will automatically prune unreferenced objects in the chain and link
  each referenced object to the next referenced object, even if it's
  many links away.  We also need to special handling of a similar
  nature for the root of the chain, which will be a staticpro()ed
  object.

    XD_OPAQUE_PTR

  Pointer to undumpable data.  Must be NULL when dumping.

    XD_OPAQUE_PTR_CONVERTIBLE

  Pointer to data which is not directly dumpable but can be converted
  to a dumpable, opaque external representation.  The parameter is
  a pointer to an opaque_convert_functions struct.

    XD_OPAQUE_DATA_CONVERTIBLE

  Data which is not directly dumpable but can be converted to a
  dumpable, opaque external representation.  The parameter is a
  pointer to an opaque_convert_functions struct.

    XD_BLOCK_PTR

  Pointer to block of described memory. (This is misnamed: It is NOT
  necessarily a pointer to a struct foo.) Parameters are number of
  contiguous blocks and sized_memory_description.

    XD_BLOCK_ARRAY

  Array of blocks of described memory.  Parameters are number of
  structures and sized_memory_description.  This differs from XD_BLOCK_PTR
  in that the parameter is declared as struct foo[666] instead of
  struct *foo.  In other words, the block of memory holding the
  structures is within the containing structure, rather than being
  elsewhere, with a pointer in the containing structure.

  NOTE NOTE NOTE: Be sure that you understand the difference between
  XD_BLOCK_PTR and XD_BLOCK_ARRAY:
    - struct foo bar[666], i.e. 666 inline struct foos
        --> XD_BLOCK_ARRAY, argument 666, pointing to a description of
            struct foo
    - struct foo *bar, i.e. pointer to a block of 666 struct foos
        --> XD_BLOCK_PTR, argument 666, pointing to a description of
            struct foo
    - struct foo *bar[666], i.e. 666 pointers to separate blocks of struct foos
        --> XD_BLOCK_ARRAY, argument 666, pointing to a description of
	    a single pointer to struct foo; the description is a single
	    XD_BLOCK_PTR, argument 1, which in turn points to a description
	    of struct foo.

  NOTE also that an XD_BLOCK_PTR of 666 foos is equivalent to an
  XD_BLOCK_PTR of 1 bar, where the description of `bar' is an
  XD_BLOCK_ARRAY of 666 foos. 

    XD_OPAQUE_DATA_PTR

  Pointer to dumpable opaque data.  Parameter is the size of the data.
  Pointed data must be relocatable without changes.

    XD_UNION

  Union of two or more different types of data.  Parameters are a constant
  which determines which type the data is (this is usually an XD_INDIRECT,
  referring to one of the fields in the structure), and a "sizing lobby" (a
  sized_memory_description, which points to a memory_description and
  indicates its size).  The size field in the sizing lobby describes the
  size of the union field in the object, and the memory_description in it
  is referred to as a "union map" and has a special interpretation: The
  offset field is replaced by a constant, which is compared to the first
  parameter of the XD_UNION descriptor to determine if this description
  applies to the union data, and XD_INDIRECT references refer to the
  containing object and description.  Note that the description applies
  "inline" to the union data, like XD_BLOCK_ARRAY and not XD_BLOCK_PTR.
  If the union data is a pointer to different types of structures, each
  element in the memory_description should be an XD_BLOCK_PTR.  See
  unicode.c, redisplay.c and fontcolor.c for examples of XD_UNION.

    XD_UNION_DYNAMIC_SIZE

  Same as XD_UNION except that this is used for objects where the size of
  the object containing the union varies depending on the particular value
  of the union constant.  That is, an object with plain XD_UNION typically
  has the union declared as `union foo' or as `void *', where an object
  with XD_UNION_DYNAMIC_SIZE typically has the union as the last element,
  and declared as something like Rawbyte foo[1].  With plain XD_UNION, the
  object is (usually) of fixed size and always contains enough space for
  the data associated with all possible union constants, and thus the union
  constant can potentially change during the lifetime of the object.  With
  XD_UNION_DYNAMIC_SIZE, however, the union constant is fixed at the time
  of creation of the object, and the size of the object is computed
  dynamically at creation time based on the size of the data associated
  with the union constant.  Currently, the only difference between XD_UNION
  and XD_UNION_DYNAMIC_SIZE is how the size of the union data is
  calculated, when (a) the structure containing the union has no size
  given; (b) the union occurs as the last element in the structure; and (c)
  the union has no size given (in the first-level sized_memory_description
  pointed to).  In this circumstance, the size of XD_UNION comes from the
  max size of the data associated with all possible union constants,
  whereas the size of XD_UNION_DYNAMIC_SIZE comes from the size of the data
  associated with the currently specified (and unchangeable) union
  constant.

    XD_ASCII_STRING

  Pointer to a C string, purely ASCII.

    XD_DOC_STRING

  Pointer to a doc string (C string in pure ASCII if positive,
  opaque value if negative)

    XD_INT_RESET

  An integer which will be reset to a given value in the dump file.

    XD_ELEMCOUNT

  Elemcount value.  Used for counts.

    XD_BYTECOUNT

  Bytecount value.  Used for counts.

    XD_HASHCODE

  Hashcode value.  Used for the results of hashing functions.

    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.


  Special macros:

    XD_INDIRECT (line, delta)
  Usable where a count, size, offset or union constant 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, which must
  (currently) be positive.
*/

enum memory_description_type
{
  XD_LISP_OBJECT_ARRAY,
  XD_LISP_OBJECT,
#ifdef NEW_GC
  XD_INLINE_LISP_OBJECT_BLOCK_PTR,
#endif /* NEW_GC */
  XD_LO_LINK,
  XD_OPAQUE_PTR,
  XD_OPAQUE_PTR_CONVERTIBLE,
  XD_OPAQUE_DATA_CONVERTIBLE,
  XD_OPAQUE_DATA_PTR,
  XD_BLOCK_PTR,
  XD_BLOCK_ARRAY,
  XD_UNION,
  XD_UNION_DYNAMIC_SIZE,
  XD_ASCII_STRING,
  XD_DOC_STRING,
  XD_INT_RESET,
  XD_BYTECOUNT,
  XD_ELEMCOUNT,
  XD_HASHCODE,
  XD_INT,
  XD_LONG,
  XD_END
};

enum data_description_entry_flags
{
  /* If set, KKCC does not process this entry.

  (1) One obvious use is with things that pdump saves but which do not get
  marked normally -- for example the next and prev fields in a marker.  The
  marker chain is weak, with its entries removed when they are finalized.

  (2) This can be set on structures not containing any Lisp objects, or (more
  usefully) on structures that contain Lisp objects but where the objects
  always occur in another structure as well.  For example, the extent lists
  kept by a buffer keep the extents in two lists, one sorted by the start
  of the extent and the other by the end.  There's no point in marking
  both, since each contains the same objects as the other; but when dumping
  (if we were to dump such a structure), when computing memory size, etc.,
  it's crucial to tag both sides.
  */
  XD_FLAG_NO_KKCC = 1,
  /* If set, pdump does not process this entry. */
  XD_FLAG_NO_PDUMP = 2,
  /* Indicates that this is a "default" entry in a union map. */
  XD_FLAG_UNION_DEFAULT_ENTRY = 4,
#ifndef NEW_GC
  /* Indicates that this is a free Lisp object we're marking.
     Only relevant for ERROR_CHECK_GC.  This occurs when we're marking
     lcrecord-lists, where the objects have had their type changed to
     lrecord_type_free and also have had their free bit set, but we mark
     them as normal. */
  XD_FLAG_FREE_LISP_OBJECT = 8,
#endif /* not NEW_GC */
#if 0
  /* Suggestions for other possible flags: */

  /* Eliminate XD_UNION_DYNAMIC_SIZE and replace it with a flag, like this. */
  XD_FLAG_UNION_DYNAMIC_SIZE = 16,
  /* Require that everyone who uses a description map has to flag it, so
     that it's easy to tell, when looking through the code, where the
     description maps are and who's using them.  This might also become
     necessary if for some reason the format of the description map is
     expanded and we need to stick a pointer in the second slot (although
     we could still ensure that the second slot in the first entry was NULL
     or <0). */
  XD_FLAG_DESCRIPTION_MAP = 32,
#endif
};

union memory_contents_description
{
  /* The first element is used by static initializers only.  We always read
     from one of the other two pointers. */
  const void *write_only;
  const struct sized_memory_description *descr;
  const struct opaque_convert_functions *funcs;
};

struct memory_description
{
  enum memory_description_type type;
  Bytecount offset;
  EMACS_INT data1;
  union memory_contents_description data2;
  /* Indicates which subsystems process this entry, plus (potentially) other
     flags that apply to this entry. */
  int flags;
};

struct sized_memory_description
{
  Bytecount size;
  const struct memory_description *description;
};


struct opaque_convert_functions
{
  /* Used by XD_OPAQUE_PTR_CONVERTIBLE and
     XD_OPAQUE_DATA_CONVERTIBLE */

  /* Converter to external representation, for those objects from
     external libraries that can't be directly dumped as opaque data
     because they contain pointers.  This is called at dump time to
     convert to an opaque, pointer-less representation.

     This function must put a pointer to the opaque result in *data
     and its size in *size. */
  void (*convert) (const void *object, void **data, Bytecount *size);

  /* Post-conversion cleanup.  Optional (null if not provided).

     When provided it will be called post-dumping to free any storage
     allocated for the conversion results. */
  void (*convert_free) (const void *object, void *data, Bytecount size);

  /* De-conversion.

     At reload time, rebuilds the object from the converted form.
     "object" is 0 for the PTR case, return is ignored in the DATA
     case. */
  void *(*deconvert) (void *object, void *data, Bytecount size);

};

extern const struct sized_memory_description lisp_object_description;

#define XD_INDIRECT(val, delta) (-1 - (Bytecount) ((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)

/* DEFINE_*_LISP_OBJECT is for objects with constant size. (Either
   DEFINE_DUMPABLE_LISP_OBJECT for objects that can be saved in a dumped
   executable, or DEFINE_NODUMP_LISP_OBJECT for objects that cannot be
   saved -- e.g. that contain pointers to non-persistent external objects
   such as window-system windows.)

   DEFINE_*_SIZABLE_LISP_OBJECT is for objects whose size varies.

   DEFINE_*_FROB_BLOCK_LISP_OBJECT is for objects that are allocated in
   large blocks ("frob blocks"), which are parceled up individually.  Such
   objects need special handling in alloc.c.  This does not apply to
   NEW_GC, because it does this automatically.

   DEFINE_*_INTERNAL_LISP_OBJECT is for "internal" objects that should
   never be visible on the Lisp level.  This is a shorthand for the most
   common type of internal objects, which have no equal or hash method
   (since they generally won't appear in hash tables), no finalizer and
   internal_object_printer() as their print method (which prints that the
   object is internal and shouldn't be visible externally).  For internal
   objects needing a finalizer, equal or hash method, or wanting to
   customize the print method, use the normal DEFINE_*_LISP_OBJECT
   mechanism for defining these objects.

   DEFINE_MODULE_* is for objects defined in an external module.

   MAKE_LISP_OBJECT and MAKE_MODULE_LISP_OBJECT are what underlies all of
   these; they define a structure containing pointers to object methods
   and other info such as the size of the structure containing the object.
 */

/* #### FIXME What's going on here? */
#if defined (ERROR_CHECK_TYPES)
# define DECLARE_ERROR_CHECK_TYPES(c_name, structtype)
#else
# define DECLARE_ERROR_CHECK_TYPES(c_name, structtype)
#endif

/********* The dumpable versions *********** */

#define DEFINE_DUMPABLE_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \
MAKE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,sizeof (structtype),0,0,structtype)

#define DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \
MAKE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,0,sizer,0,structtype)

#define DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \
MAKE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,sizeof(structtype),0,1,structtype)

#define DEFINE_DUMPABLE_FROB_BLOCK_SIZABLE_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \
MAKE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,0,sizer,1,structtype)

#define DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT(name,c_name,marker,desc,structtype) \
DEFINE_DUMPABLE_LISP_OBJECT(name,c_name,marker,internal_object_printer,0,0,0,desc,structtype)

#define DEFINE_DUMPABLE_SIZABLE_INTERNAL_LISP_OBJECT(name,c_name,marker,desc,sizer,structtype) \
DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT(name,c_name,marker,internal_object_printer,0,0,0,desc,sizer,structtype)

/********* The non-dumpable versions *********** */

#define DEFINE_NODUMP_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \
MAKE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer,nuker,equal,hash,desc,sizeof (structtype),0,0,structtype)

#define DEFINE_NODUMP_SIZABLE_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \
MAKE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer,nuker,equal,hash,desc,0,sizer,0,structtype)

#define DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \
MAKE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer,nuker,equal,hash,desc,sizeof(structtype),0,1,structtype)

#define DEFINE_NODUMP_FROB_BLOCK_SIZABLE_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \
MAKE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer,nuker,equal,hash,desc,0,sizer,1,structtype)

#define DEFINE_NODUMP_INTERNAL_LISP_OBJECT(name,c_name,marker,desc,structtype) \
DEFINE_NODUMP_LISP_OBJECT(name,c_name,marker,internal_object_printer,0,0,0,desc,structtype)

#define DEFINE_NODUMP_SIZABLE_INTERNAL_LISP_OBJECT(name,c_name,marker,desc,sizer,structtype) \
DEFINE_NODUMP_SIZABLE_LISP_OBJECT(name,c_name,marker,internal_object_printer,0,0,0,desc,sizer,structtype)

/********* MAKE_LISP_OBJECT, the underlying macro *********** */

#ifdef NEW_GC
#define MAKE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,	\
equal,hash,desc,size,sizer,frob_block_p,structtype)			\
DECLARE_ERROR_CHECK_TYPES(c_name, structtype)				\
struct lrecord_implementation lrecord_##c_name =			\
  { name, dumpable, marker, printer, nuker, equal, hash, desc,		\
    size, sizer, lrecord_type_##c_name }
#else /* not NEW_GC */
#define MAKE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,size,sizer,frob_block_p,structtype) \
DECLARE_ERROR_CHECK_TYPES(c_name, structtype)				\
struct lrecord_implementation lrecord_##c_name =			\
  { name, dumpable, marker, printer, nuker, equal, hash, desc,		\
    size, sizer, lrecord_type_##c_name, frob_block_p }
#endif /* not NEW_GC */


/********* The module dumpable versions *********** */

#define DEFINE_DUMPABLE_MODULE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,structtype) \
MAKE_MODULE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,sizeof (structtype),0,0,structtype)

#define DEFINE_DUMPABLE_MODULE_SIZABLE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,sizer,structtype) \
MAKE_MODULE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,0,sizer,0,structtype)

/********* The module non-dumpable versions *********** */

#define DEFINE_NODUMP_MODULE_LISP_OBJECT(name,c_name,dumpable,marker,	\
printer,nuker,equal,hash,desc,structtype)				\
MAKE_MODULE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer,	\
nuker,equal,hash,desc,sizeof (structtype),0,0,structtype)

#define DEFINE_NODUMP_MODULE_SIZABLE_LISP_OBJECT(name,c_name,dumpable,	\
marker,printer,nuker,equal,hash,desc,sizer,structtype)			\
MAKE_MODULE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer,	\
nuker,equal,hash,desc,0,sizer,0,structtype)

/********* MAKE_MODULE_LISP_OBJECT, the underlying macro *********** */

#ifdef NEW_GC
#define MAKE_MODULE_LISP_OBJECT(name,c_name,dumpable,marker,printer,	\
nuker,equal,hash,desc,size,sizer,frob_block_p,structtype)		\
DECLARE_ERROR_CHECK_TYPES(c_name, structtype)				\
int lrecord_type_##c_name;						\
struct lrecord_implementation lrecord_##c_name =			\
  { name, dumpable, marker, printer, nuker, equal, hash, desc,		\
    size, sizer, lrecord_type_last_built_in_type }
#else /* not NEW_GC */
#define MAKE_MODULE_LISP_OBJECT(name,c_name,dumpable,marker,printer,	\
nuker,equal,hash,desc,size,sizer,frob_block_p,structtype)		\
DECLARE_ERROR_CHECK_TYPES(c_name, structtype)				\
int lrecord_type_##c_name;						\
struct lrecord_implementation lrecord_##c_name =			\
  { name, dumpable, marker, printer, nuker, equal, hash, desc,		\
    size, sizer, lrecord_type_last_built_in_type, frob_block_p }
#endif /* not NEW_GC */

#ifdef MEMORY_USAGE_STATS
#define INIT_MEMORY_USAGE_STATS(type)					\
do									\
{									\
  lrecord_implementations_table[lrecord_type_##type]->			\
    memusage_stats_list = Qnil;						\
  lrecord_implementations_table[lrecord_type_##type]->			\
    num_extra_memusage_stats = -1;					\
  lrecord_implementations_table[lrecord_type_##type]->			\
    num_extra_nonlisp_memusage_stats = -1;				\
  staticpro (&lrecord_implementations_table[lrecord_type_##type]->	\
	     memusage_stats_list);					\
} while (0)
#else
#define INIT_MEMORY_USAGE_STATS(type) DO_NOTHING
#endif /* (not) MEMORY_USAGE_STATS */

#define INIT_LISP_OBJECT_BEGINNING(type)				\
do									\
{									\
  lrecord_implementations_table[lrecord_type_##type] = &lrecord_##type;	\
  INIT_MEMORY_USAGE_STATS (type);					\
} while (0)

#ifdef USE_KKCC
extern MODULE_API const struct memory_description *lrecord_memory_descriptions[];

#define INIT_LISP_OBJECT(type) do {					\
  INIT_LISP_OBJECT_BEGINNING (type);					\
  lrecord_memory_descriptions[lrecord_type_##type] =			\
    lrecord_implementations_table[lrecord_type_##type]->description;	\
} while (0)
#else /* not USE_KKCC */
extern MODULE_API Lisp_Object (*lrecord_markers[]) (Lisp_Object);

#define INIT_LISP_OBJECT(type) do {				\
  INIT_LISP_OBJECT_BEGINNING (type);				\
  lrecord_markers[lrecord_type_##type] =			\
    lrecord_implementations_table[lrecord_type_##type]->marker;	\
} while (0)
#endif /* not USE_KKCC */

#define INIT_MODULE_LISP_OBJECT(type) do {			\
  lrecord_type_##type = lrecord_type_count++;			\
  lrecord_##type.lrecord_type_index = lrecord_type_##type;	\
  INIT_LISP_OBJECT (type);					\
} while (0)

#ifdef HAVE_SHLIB
/* Allow undefining types in order to support module unloading. */

#ifdef USE_KKCC
#define UNDEF_LISP_OBJECT(type) do {				\
  lrecord_implementations_table[lrecord_type_##type] = NULL;	\
  lrecord_memory_descriptions[lrecord_type_##type] = NULL;	\
} while (0)
#else /* not USE_KKCC */
#define UNDEF_LISP_OBJECT(type) do {				\
  lrecord_implementations_table[lrecord_type_##type] = NULL;	\
  lrecord_markers[lrecord_type_##type] = NULL;			\
} while (0)
#endif /* not USE_KKCC */

#define UNDEF_MODULE_LISP_OBJECT(type) do {				\
  if (lrecord_##type.lrecord_type_index == lrecord_type_count - 1) {	\
    /* This is the most recently defined type.  Clean up nicely. */	\
    lrecord_type_##type = lrecord_type_count--;				\
  } /* Else we can't help leaving a hole with this implementation. */	\
  UNDEF_LISP_OBJECT(type);						\
} while (0)

#endif /* HAVE_SHLIB */

/*************** Macros for declaring that a Lisp object has a
                 particular method, or for calling such a method. ********/

/* Declare that object-type TYPE has method M; used in
   initialization routines */
#define OBJECT_HAS_METHOD(type, m) \
  (lrecord_##type.m = type##_##m)
/* Same but the method name come before the type */
#define OBJECT_HAS_PREMETHOD(type, m) \
  (lrecord_##type.m = m##_##type)
/* Same but the name of the method is explicitly given */
#define OBJECT_HAS_NAMED_METHOD(type, m, func) \
  (lrecord_##type.m = (func))
/* Object type has a property with the given value. */
#define OBJECT_HAS_PROPERTY(type, prop, val) \
  (lrecord_##type.prop = (val))

/* Does the given object method exist? */
#define HAS_OBJECT_METH_P(obj, m) \
  (!!(XRECORD_LHEADER_IMPLEMENTATION (obj)->m))
/* Call an object method. */
#define OBJECT_METH(obj, m, args) \
  ((XRECORD_LHEADER_IMPLEMENTATION (obj)->m) args)

/* Call an object method, if it exists. */
#define MAYBE_OBJECT_METH(obj, m, args)			\
do							\
{							\
  const struct lrecord_implementation *_mom_imp =	\
    XRECORD_LHEADER_IMPLEMENTATION (obj);		\
  if (_mom_imp->m)					\
    ((_mom_imp->m) args);				\
} while (0)

/* Call an object method, if it exists, or return GIVEN.  NOTE:
   Multiply-evaluates OBJ. */
#define OBJECT_METH_OR_GIVEN(obj, m, args, given)  \
  (HAS_OBJECT_METH_P (obj, m) ?	OBJECT_METH (obj, m, args) : (given))

#define OBJECT_PROPERTY(obj, prop) (XRECORD_LHEADER_IMPLEMENTATION (obj)->prop)

/************** Other stuff **************/

#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 == (unsigned int) (ty)))

/* Steps to create a new object:

   1. Declare the struct for your object in a header file somewhere.
   Remember that it must begin with

   NORMAL_LISP_OBJECT_HEADER header;

   2. Put the "standard junk" (DECLARE_LISP_OBJECT()/XFOO/etc.) below the
      struct definition -- see below.

   3. Add this header file to inline.c.

   4. Create the methods for your object.  Note that technically you don't
   need any, but you will almost always want at least a mark method.

   4. Create the data layout description for your object.  See
   toolbar_button_description below; the comment above in `struct lrecord',
   describing the purpose of the descriptions; and comments elsewhere in
   this file describing the exact syntax of the description structures.

   6. Define your object with DEFINE_*_LISP_OBJECT() or some
   variant.  At the minimum, you need to decide whether your object can
   be dumped.  Objects that are created as part of the loadup process and
   need to be persistent across dumping should be created dumpable.
   Nondumpable objects are generally those associated with display,
   particularly those containing a pointer to an external library object
   (e.g. a window-system window).

   7. Include the header file in the .c file where you defined the object.

   8. Put a call to INIT_LISP_OBJECT() for the object in the
   .c file's syms_of_foo() function.

   9. Add a type enum for the object to enum lrecord_type, earlier in this
   file.

   --ben

  An example:

------------------------------ in toolbar.h -----------------------------

  struct toolbar_button
  {
    NORMAL_LISP_OBJECT_HEADER header;
  
    Lisp_Object next;
    Lisp_Object frame;
  
    Lisp_Object up_glyph;
    Lisp_Object down_glyph;
    Lisp_Object disabled_glyph;
  
    Lisp_Object cap_up_glyph;
    Lisp_Object cap_down_glyph;
    Lisp_Object cap_disabled_glyph;
  
    Lisp_Object callback;
    Lisp_Object enabled_p;
    Lisp_Object help_string;
  
    char enabled;
    char down;
    char pushright;
    char blank;
  
    int x, y;
    int width, height;
    int dirty;
    int vertical;
    int border_width;
  };
  
  [[ the standard junk: ]]
  
  DECLARE_LISP_OBJECT (toolbar_button, struct toolbar_button);
  #define XTOOLBAR_BUTTON(x) XRECORD (x, toolbar_button, struct toolbar_button)
  #define wrap_toolbar_button(p) wrap_record (p, toolbar_button)
  #define TOOLBAR_BUTTONP(x) RECORDP (x, toolbar_button)
  #define CHECK_TOOLBAR_BUTTON(x) CHECK_RECORD (x, toolbar_button)
  #define CONCHECK_TOOLBAR_BUTTON(x) CONCHECK_RECORD (x, toolbar_button)
  
------------------------------ in toolbar.c -----------------------------
  
  #include "toolbar.h"
  
  ...
  
  static const struct memory_description toolbar_button_description [] = {
    { XD_LISP_OBJECT, offsetof (struct toolbar_button, next) },
    { XD_LISP_OBJECT, offsetof (struct toolbar_button, frame) },
    { XD_LISP_OBJECT, offsetof (struct toolbar_button, up_glyph) },
    { XD_LISP_OBJECT, offsetof (struct toolbar_button, down_glyph) },
    { XD_LISP_OBJECT, offsetof (struct toolbar_button, disabled_glyph) },
    { XD_LISP_OBJECT, offsetof (struct toolbar_button, cap_up_glyph) },
    { XD_LISP_OBJECT, offsetof (struct toolbar_button, cap_down_glyph) },
    { XD_LISP_OBJECT, offsetof (struct toolbar_button, cap_disabled_glyph) },
    { XD_LISP_OBJECT, offsetof (struct toolbar_button, callback) },
    { XD_LISP_OBJECT, offsetof (struct toolbar_button, enabled_p) },
    { XD_LISP_OBJECT, offsetof (struct toolbar_button, help_string) },
    { XD_END }
  };
  
  static Lisp_Object
  allocate_toolbar_button (struct frame *f, int pushright)
  {
    struct toolbar_button *tb;
  
    tb = XTOOLBAR_BUTTON (ALLOC_NORMAL_LISP_OBJECT (toolbar_button));
    tb->next = Qnil;
    tb->frame = wrap_frame (f);
    tb->up_glyph = Qnil;
    tb->down_glyph = Qnil;
    tb->disabled_glyph = Qnil;
    tb->cap_up_glyph = Qnil;
    tb->cap_down_glyph = Qnil;
    tb->cap_disabled_glyph = Qnil;
    tb->callback = Qnil;
    tb->enabled_p = Qnil;
    tb->help_string = Qnil;
  
    tb->pushright = pushright;
    tb->x = tb->y = tb->width = tb->height = -1;
    tb->dirty = 1;
  
    return wrap_toolbar_button (tb);
  }
   
  static Lisp_Object
  mark_toolbar_button (Lisp_Object obj)
  {
    struct toolbar_button *data = XTOOLBAR_BUTTON (obj);
    mark_object (data->next);
    mark_object (data->frame);
    mark_object (data->up_glyph);
    mark_object (data->down_glyph);
    mark_object (data->disabled_glyph);
    mark_object (data->cap_up_glyph);
    mark_object (data->cap_down_glyph);
    mark_object (data->cap_disabled_glyph);
    mark_object (data->callback);
    mark_object (data->enabled_p);
    return data->help_string;
  }
  
  DEFINE_NODUMP_LISP_OBJECT ("toolbar-button", toolbar_button,
  			     mark_toolbar_button,
  			     external_object_printer, 0, 0, 0,
  			     toolbar_button_description,
  			     struct toolbar_button);
  
  ...
  
  void
  syms_of_toolbar (void)
  {
    INIT_LISP_OBJECT (toolbar_button);
  
    ...;
  }
  
------------------------------ in inline.c -----------------------------
  
  #ifdef HAVE_TOOLBARS
  #include "toolbar.h"
  #endif
  
------------------------------ in lrecord.h -----------------------------
  
  enum lrecord_type
  {
    ...
    lrecord_type_toolbar_button,
    ...
  };

------------------------------ in .gdbinit.in.in -----------------------------

  ...
  else
  if $lrecord_type == lrecord_type_toolbar_button
    pstructtype toolbar_button
  ...
  ...
  ...
  end

  --ben

*/

/*

Note: Object types defined in external dynamically-loaded modules (not
part of the XEmacs main source code) should use DECLARE_*_MODULE_LISP_OBJECT
and DEFINE_*_MODULE_LISP_OBJECT rather than DECLARE_*_LISP_OBJECT
and DEFINE_*_LISP_OBJECT.  The MODULE versions declare and
allocate an enumerator for the type being defined.

*/


#ifdef ERROR_CHECK_TYPES

# define DECLARE_LISP_OBJECT(c_name, structtype)			\
extern struct lrecord_implementation lrecord_##c_name;			\
DECLARE_INLINE_HEADER (							\
structtype *								\
error_check_##c_name (Lisp_Object obj, const Ascbyte *file, int line)	\
)									\
{									\
  assert_at_line (RECORD_TYPEP (obj, lrecord_type_##c_name), file, line); \
  return (structtype *) XPNTR (obj);					\
}									\
extern Lisp_Object Q##c_name##p

# define DECLARE_MODULE_API_LISP_OBJECT(c_name, structtype)		\
extern MODULE_API struct lrecord_implementation lrecord_##c_name;	\
DECLARE_INLINE_HEADER (							\
structtype *								\
error_check_##c_name (Lisp_Object obj, const Ascbyte *file, int line)	\
)									\
{									\
  assert_at_line (RECORD_TYPEP (obj, lrecord_type_##c_name), file, line); \
  return (structtype *) XPNTR (obj);					\
}									\
extern MODULE_API Lisp_Object Q##c_name##p

# define DECLARE_MODULE_LISP_OBJECT(c_name, structtype)			\
extern int lrecord_type_##c_name;					\
extern struct lrecord_implementation lrecord_##c_name;			\
DECLARE_INLINE_HEADER (							\
structtype *								\
error_check_##c_name (Lisp_Object obj, const Ascbyte *file, int line)	\
)									\
{									\
  assert_at_line (RECORD_TYPEP (obj, lrecord_type_##c_name), file, line); \
  return (structtype *) XPNTR (obj);					\
}									\
extern Lisp_Object Q##c_name##p

# define XRECORD(x, c_name, structtype) \
  error_check_##c_name (x, __FILE__, __LINE__)

DECLARE_INLINE_HEADER (
Lisp_Object
wrap_record_1 (const void *ptr, enum lrecord_type ty, const Ascbyte *file,
	       int line)
)
{
  Lisp_Object obj = wrap_pointer_1 (ptr);

  assert_at_line (RECORD_TYPEP (obj, ty), file, line);
  return obj;
}

#define wrap_record(ptr, ty) \
  wrap_record_1 (ptr, lrecord_type_##ty, __FILE__, __LINE__)

#else /* not ERROR_CHECK_TYPES */

# define DECLARE_LISP_OBJECT(c_name, structtype)		\
extern Lisp_Object Q##c_name##p;				\
extern struct lrecord_implementation lrecord_##c_name
# define DECLARE_MODULE_API_LISP_OBJECT(c_name, structtype)	\
extern MODULE_API Lisp_Object Q##c_name##p;			\
extern MODULE_API struct lrecord_implementation lrecord_##c_name
# define DECLARE_MODULE_LISP_OBJECT(c_name, structtype)		\
extern Lisp_Object Q##c_name##p;				\
extern int lrecord_type_##c_name;				\
extern struct lrecord_implementation lrecord_##c_name
# define XRECORD(x, c_name, structtype) ((structtype *) XPNTR (x))
/* wrap_pointer_1 is so named as a suggestion not to use it unless you
   know what you're doing. */
#define wrap_record(ptr, ty) wrap_pointer_1 (ptr)

#endif /* not ERROR_CHECK_TYPES */

#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
   this is that the CONCHECK_foo macros signal a continuable error,
   allowing the user (through debug-on-error) to substitute a different
   value and return from the signal, which causes the lvalue argument
   to get changed.  Quite a lot of code would crash if that happened,
   because it did things like

   foo = XCAR (list);
   CHECK_STRING (foo);

   and later on did XSTRING (XCAR (list)), assuming that the type
   is correct (when it might be wrong, if the user substituted a
   correct value in the debugger).

   To get around this, I made all the CHECK_foo macros signal a
   non-continuable error.  Places where a continuable error is OK
   (generally only when called directly on the argument of a Lisp
   primitive) should be changed to use CONCHECK().

   FSF Emacs does not have this problem because RMS took the cheesy
   way out and disabled returning from a signal entirely. */

#define CONCHECK_RECORD(x, c_name) do {			\
 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 {\
 if (XTYPE (x) != lisp_enum)				\
   x = wrong_type_argument (predicate, x);		\
 } while (0)
#define CHECK_RECORD(x, c_name) do {			\
 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 {	\
 if (XTYPE (x) != lisp_enum)				\
   dead_wrong_type_argument (predicate, x);		\
 } while (0)

#ifndef NEW_GC
/*-------------------------- lcrecord-list -----------------------------*/

struct lcrecord_list
{
  NORMAL_LISP_OBJECT_HEADER header;
  Lisp_Object free;
  Elemcount size;
  const struct lrecord_implementation *implementation;
};

DECLARE_LISP_OBJECT (lcrecord_list, struct lcrecord_list);
#define XLCRECORD_LIST(x) XRECORD (x, lcrecord_list, struct lcrecord_list)
#define wrap_lcrecord_list(p) wrap_record (p, lcrecord_list)
#define LCRECORD_LISTP(x) RECORDP (x, lcrecord_list)
/* #define CHECK_LCRECORD_LIST(x) CHECK_RECORD (x, lcrecord_list)
   Lcrecord lists should never escape to the Lisp level, so
   functions should not be doing this. */

/* Various ways of allocating lcrecords.  All bytes (except lcrecord
   header) are zeroed in returned structure.

   See above for a discussion of the difference between plain lrecords and
   lrecords.  lcrecords themselves are divided into three types: (1)
   auto-managed, (2) hand-managed, and (3) unmanaged.  "Managed" refers to
   using a special object called an lcrecord-list to keep track of freed
   lcrecords, which can freed with free_normal_lisp_object() or the like
   and later be recycled when a new lcrecord is required, rather than
   requiring new malloc().  Thus, allocation of lcrecords can be very
   cheap. (Technically, the lcrecord-list manager could divide up large
   chunks of memory and allocate out of that, mimicking what happens with
   lrecords.  At that point, however, we'd want to rethink the whole
   division between lrecords and lcrecords.)

   NOTE: There is a fundamental limitation of lcrecord-lists, which is that
   they only handle blocks of a particular, fixed size.  Thus, objects that
   can be of varying sizes need to do various tricks.  These considerations
   in particular dictate the various types of management:

   -- "Auto-managed" means that you just go ahead and allocate the lcrecord
   whenever you want, using ALLOC_NORMAL_LISP_OBJECT(), and the appropriate
   lcrecord-list manager is automatically created.  To free, you just call
   "free_normal_lisp_object()" and the appropriate lcrecord-list manager is
   automatically located and called.  The limitation here of course is that
   all your objects are of the same size. (#### Eventually we should have a
   more sophisticated system that tracks the sizes seen and creates one
   lcrecord list per size, indexed in a hash table.  Usually there are only
   a limited number of sizes, so this works well.)

   -- "Hand-managed" exists because we haven't yet written the more
   sophisticated scheme for auto-handling different-sized lcrecords, as
   described in the end of the last paragraph.  In this model, you go ahead
   and create the lcrecord-list objects yourself for the sizes you will
   need, using make_lcrecord_list().  Then, create lcrecords using
   alloc_managed_lcrecord(), passing in the lcrecord-list you created, and
   free them with free_managed_lcrecord().

   -- "Unmanaged" means you simply allocate lcrecords, period.  No
   lcrecord-lists, no way to free them.  This may be suitable when the
   lcrecords are variable-sized and (a) you're too lazy to write the code
   to hand-manage them, or (b) the objects you create are always or almost
   always Lisp-visible, and thus there's no point in freeing them (and it
   wouldn't be safe to do so).  You just create them with
   ALLOC_SIZED_LISP_OBJECT(), and that's it.

   --ben

   Here is an in-depth look at the steps required to create a allocate an
   lcrecord using the hand-managed style.  Since this is the most
   complicated, you will learn a lot about the other styles as well.  In
   addition, there is useful general information about what freeing an
   lcrecord really entails, and what are the precautions:

   1) Create an lcrecord-list object using make_lcrecord_list().  This is
      often done at initialization.  Remember to staticpro_nodump() this
      object!  The arguments to make_lcrecord_list() are the same as would be
      passed to ALLOC_SIZED_LISP_OBJECT().

   2) Instead of calling ALLOC_SIZED_LISP_OBJECT(), call
      alloc_managed_lcrecord() and pass the lcrecord-list earlier created.

   3) When done with the lcrecord, call free_managed_lcrecord().  The
      standard freeing caveats apply: ** make sure there are no pointers to
      the object anywhere! **

   4) Calling free_managed_lcrecord() is just like kissing the
      lcrecord goodbye as if it were garbage-collected.  This means:
      -- the contents of the freed lcrecord are undefined, and the
         contents of something produced by alloc_managed_lcrecord()
	 are undefined, just like for ALLOC_SIZED_LISP_OBJECT().
      -- the mark method for the lcrecord's type will *NEVER* be called
         on freed lcrecords.
      -- the finalize method for the lcrecord's type will be called
         at the time that free_managed_lcrecord() is called.
 */

/* UNMANAGED MODEL: */
Lisp_Object old_alloc_lcrecord (const struct lrecord_implementation *);
Lisp_Object old_alloc_sized_lcrecord (Bytecount size,
				      const struct lrecord_implementation *);

/* HAND-MANAGED MODEL: */
Lisp_Object make_lcrecord_list (Elemcount size,
				const struct lrecord_implementation
				*implementation);
Lisp_Object alloc_managed_lcrecord (Lisp_Object lcrecord_list);
void free_managed_lcrecord (Lisp_Object lcrecord_list, Lisp_Object lcrecord);

/* AUTO-MANAGED MODEL: */
MODULE_API Lisp_Object
alloc_automanaged_sized_lcrecord (Bytecount size,
				  const struct lrecord_implementation *imp);
MODULE_API Lisp_Object
alloc_automanaged_lcrecord (const struct lrecord_implementation *imp);

#define old_alloc_lcrecord_type(type, imp) \
  ((type *) XPNTR (alloc_automanaged_lcrecord (sizeof (type), imp)))

void old_free_lcrecord (Lisp_Object rec);

#else /* NEW_GC */

MODULE_API Lisp_Object alloc_sized_lrecord (Bytecount size,
					    const struct lrecord_implementation *imp);
Lisp_Object noseeum_alloc_sized_lrecord (Bytecount size,
					 const struct lrecord_implementation *imp);
MODULE_API Lisp_Object alloc_lrecord (const struct lrecord_implementation *imp);
Lisp_Object noseeum_alloc_lrecord (const struct lrecord_implementation *imp);

MODULE_API Lisp_Object alloc_lrecord_array (int elemcount,
				 const struct lrecord_implementation *imp);
MODULE_API Lisp_Object alloc_sized_lrecord_array (Bytecount size,
						  int elemcount,
						  const struct lrecord_implementation *imp);

#endif /* NEW_GC */

DECLARE_INLINE_HEADER (
Bytecount
detagged_lisp_object_size (const struct lrecord_header *h)
)
{
  const struct lrecord_implementation *imp = LHEADER_IMPLEMENTATION (h);

  return (imp->size_in_bytes_method ?
	  imp->size_in_bytes_method (wrap_pointer_1 (h)) :
	  imp->static_size);
}

DECLARE_INLINE_HEADER (
Bytecount
lisp_object_size (Lisp_Object o)
)
{
  return detagged_lisp_object_size (XRECORD_LHEADER (o));
}

struct usage_stats;

MODULE_API void copy_lisp_object (Lisp_Object dst, Lisp_Object src);
MODULE_API void zero_sized_lisp_object (Lisp_Object obj, Bytecount size);
MODULE_API void zero_nonsized_lisp_object (Lisp_Object obj);
Bytecount lisp_object_storage_size (Lisp_Object obj,
				    struct usage_stats *ustats);
Bytecount lisp_object_memory_usage_full (Lisp_Object object,
					 Bytecount *storage_size,
					 Bytecount *extra_nonlisp_storage,
					 Bytecount *extra_lisp_storage,
					 struct generic_usage_stats *stats);
Bytecount lisp_object_memory_usage (Lisp_Object object);
Bytecount tree_memory_usage (Lisp_Object arg, int vectorp);
void free_normal_lisp_object (Lisp_Object obj);


/************************************************************************/
/*		                 Dumping                		*/
/************************************************************************/

/* dump_add_root_block_ptr (&var, &desc) dumps the structure pointed to by
   `var'.  This is for a single relocatable pointer located in the data
   segment (i.e. the block pointed to is in the heap).

   If the structure pointed to is not a `struct' but an array, you should
   set the size field of the sized_memory_description to 0, and use
   XD_BLOCK_ARRAY in the inner memory_description.

   NOTE that a "root struct pointer" could also be described using
   dump_add_root_block(), with SIZE == sizeof (void *), and a description
   containing a single XD_BLOCK_PTR entry, offset 0, size 1, with a
   structure description the same as the value passed to
   dump_add_root_block_ptr().  That would require an extra level of
   description, though, as compared to using dump_add_root_block_ptr(),
   and thus this function is generally more convenient.
    */
#ifdef PDUMP
void dump_add_root_block_ptr (void *, const struct sized_memory_description *);
#else
#define dump_add_root_block_ptr(varaddr, descaddr) DO_NOTHING
#endif

/* dump_add_opaque (&var, size) dumps the opaque static structure `var'.
   This is for a static block of memory (in the data segment, not the
   heap), with no relocatable pointers in it. */
#ifdef PDUMP
#define dump_add_opaque(varaddr,size) dump_add_root_block (varaddr, size, NULL)
#else
#define dump_add_opaque(varaddr,size) DO_NOTHING
#endif

/* dump_add_root_block (ptr, size, desc) dumps the static structure
   located at `var' of size SIZE and described by DESC.  This is for a
   static block of memory (in the data segment, not the heap), with
   relocatable pointers in it. */
#ifdef PDUMP
void dump_add_root_block (const void *ptraddress, Bytecount size,
			  const struct memory_description *desc);
#else
#define dump_add_root_block(ptraddress, size, desc) DO_NOTHING
#endif

/* Call dump_add_opaque_int (&int_var) to dump `int_var', of type `int'. */
#ifdef PDUMP
#define dump_add_opaque_int(int_varaddr) do {	\
  int *dao_ = (int_varaddr); /* type check */	\
  dump_add_opaque (dao_, sizeof (*dao_));	\
} while (0)
#else
#define dump_add_opaque_int(int_varaddr) DO_NOTHING
#endif

/* Call dump_add_opaque_fixnum (&fixnum_var) to dump `fixnum_var', of type
   `Fixnum'. */
#ifdef PDUMP
#define dump_add_opaque_fixnum(fixnum_varaddr) do {	\
  Fixnum *dao_ = (fixnum_varaddr); /* type check */	\
  dump_add_opaque (dao_, sizeof (*dao_));		\
} while (0)
#else
#define dump_add_opaque_fixnum(fixnum_varaddr) DO_NOTHING
#endif

/* Call dump_add_root_lisp_object (&var) to ensure that var is properly
   updated after pdump. */
#ifdef PDUMP
void dump_add_root_lisp_object (Lisp_Object *);
#else
#define dump_add_root_lisp_object(varaddr) DO_NOTHING
#endif

/* Call dump_add_weak_lisp_object (&var) to ensure that var is properly
   updated after pdump.  var must point to a linked list of objects out of
   which some may not be dumped */
#ifdef PDUMP
void dump_add_weak_object_chain (Lisp_Object *);
#else
#define dump_add_weak_object_chain(varaddr) DO_NOTHING
#endif

/* Nonzero means Emacs has already been initialized.
   Used during startup to detect startup of dumped Emacs.  */
extern MODULE_API int initialized;

#ifdef PDUMP
#include "dumper.h"
#ifdef NEW_GC
#define DUMPEDP(adr) 0
#else /* not NEW_GC */
#define DUMPEDP(adr) ((((Rawbyte *) (adr)) < pdump_end) && \
                      (((Rawbyte *) (adr)) >= pdump_start))
#endif /* not NEW_GC */
#else
#define DUMPEDP(adr) 0
#endif

#define OBJECT_DUMPED_P(obj) DUMPEDP (XPNTR (obj))

/***********************************************************************/
/*                           data descriptions                         */
/***********************************************************************/


#if defined (USE_KKCC) || defined (PDUMP)

extern int in_pdump;

EMACS_INT lispdesc_indirect_count_1 (EMACS_INT code,
				     const struct memory_description *idesc,
				     const void *idata);
const struct sized_memory_description *lispdesc_indirect_description_1
 (const void *obj, const struct sized_memory_description *sdesc);
Bytecount lispdesc_block_size_1 (const void *obj, Bytecount size,
			         const struct memory_description *desc);

DECLARE_INLINE_HEADER (
Bytecount lispdesc_block_size (const void *obj,
			       const struct sized_memory_description *sdesc))
{
  return lispdesc_block_size_1 (obj, sdesc->size, sdesc->description);
}

DECLARE_INLINE_HEADER (
EMACS_INT
lispdesc_indirect_count (EMACS_INT code,
			 const struct memory_description *idesc,
			 const void *idata)
)
{
  if (XD_IS_INDIRECT (code))
    code = lispdesc_indirect_count_1 (code, idesc, idata);
  return code;
}

DECLARE_INLINE_HEADER (
const struct sized_memory_description *
lispdesc_indirect_description (const void *obj,
			       const struct sized_memory_description *sdesc)
)
{
  if (sdesc->description)
    return sdesc;
  else
    return lispdesc_indirect_description_1 (obj, sdesc);
}


/* Do standard XD_UNION processing.  DESC1 is an entry in DESC, which
   describes the entire data structure.  Returns NULL (do nothing, nothing
   matched), or a new value for DESC1.  In the latter case, assign to DESC1
   in your function and goto union_switcheroo. */

DECLARE_INLINE_HEADER (
const struct memory_description *
lispdesc_process_xd_union (const struct memory_description *desc1,
			   const struct memory_description *desc,
			   const void *data)
)
{
  int count = 0;
  EMACS_INT variant = lispdesc_indirect_count (desc1->data1, desc,
					       data);
  desc1 =
    lispdesc_indirect_description (data, desc1->data2.descr)->description;
  
  for (count = 0; desc1[count].type != XD_END; count++)
    {
      if ((desc1[count].flags & XD_FLAG_UNION_DEFAULT_ENTRY) ||
	  desc1[count].offset == variant)
	{
	  return &desc1[count];
	}
    }

  return NULL;
}

#endif /* defined (USE_KKCC) || defined (PDUMP) */

END_C_DECLS

#endif /* INCLUDED_lrecord_h_ */