src/lrecord.h

   1 /* The "lrecord" structure (header of a compound lisp object).
   2    Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
   3    Copyright (C) 1996 Ben Wing.
   4
   5 This file is part of XEmacs.
   6
   7 XEmacs is free software; you can redistribute it and/or modify it
   8 under the terms of the GNU General Public License as published by the
   9 Free Software Foundation; either version 2, or (at your option) any
  10 later version.
  11
  12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
  13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  14 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  15 for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with XEmacs; see the file COPYING.  If not, write to
  19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  20 Boston, MA 02111-1307, USA.  */
  21
  22 /* Synched up with: Not in FSF. */
  23
  24 #ifndef INCLUDED_lrecord_h_
  25 #define INCLUDED_lrecord_h_
  26
  27 /* The "lrecord" type of Lisp object is used for all object types
  28    other than a few simple ones.  This allows many types to be
  29    implemented but only a few bits required in a Lisp object for type
  30    information. (The tradeoff is that each object has its type marked
  31    in it, thereby increasing its size.) All lrecords begin with a
  32    `struct lrecord_header', which identifies the lisp object type, by
  33    providing an index into a table of `struct lrecord_implementation',
  34    which describes the behavior of the lisp object.  It also contains
  35    some other data bits.
  36
  37    Lrecords are of two types: straight lrecords, and lcrecords.
  38    Straight lrecords are used for those types of objects that have
  39    their own allocation routines (typically allocated out of 2K chunks
  40    of memory called `frob blocks').  These objects have a `struct
  41    lrecord_header' at the top, containing only the bits needed to find
  42    the lrecord_implementation for the object.  There are special
  43    routines in alloc.c to deal with each such object type.
  44
  45    Lcrecords are used for less common sorts of objects that don't do
  46    their own allocation.  Each such object is malloc()ed individually,
  47    and the objects are chained together through a `next' pointer.
  48    Lcrecords have a `struct lcrecord_header' at the top, which
  49    contains a `struct lrecord_header' and a `next' pointer, and are
  50    allocated using alloc_lcrecord().
  51
  52    Creating a new lcrecord type is fairly easy; just follow the
  53    lead of some existing type (e.g. hash tables).  Note that you
  54    do not need to supply all the methods (see below); reasonable
  55    defaults are provided for many of them.  Alternatively, if you're
  56    just looking for a way of encapsulating data (which possibly
  57    could contain Lisp_Objects in it), you may well be able to use
  58    the opaque type. */
  59
  60 struct lrecord_header
  61 {
  62   /* index into lrecord_implementations_table[] */
  63   unsigned int type :8;
  64
  65   /* If `mark' is 0 after the GC mark phase, the object will be freed
  66      during the GC sweep phase.  There are 2 ways that `mark' can be 1:
  67      - by being referenced from other objects during the GC mark phase
  68      - because it is permanently on, for c_readonly objects */
  69   unsigned int mark :1;
  70
  71   /* 1 if the object resides in logically read-only space, and does not
  72      reference other non-c_readonly objects.
  73      Invariant: if (c_readonly == 1), then (mark == 1 && lisp_readonly == 1) */
  74   unsigned int c_readonly :1;
  75
  76   /* 1 if the object is readonly from lisp */
  77   unsigned int lisp_readonly :1;
  78 };
  79
  80 struct lrecord_implementation;
  81 int lrecord_type_index (const struct lrecord_implementation *implementation);
  82
  83 #define set_lheader_implementation(header,imp) do {     \
  84   struct lrecord_header* SLI_header = (header);         \
  85   SLI_header->type = (imp)->lrecord_type_index;         \
  86   SLI_header->mark = 0;                                 \
  87   SLI_header->c_readonly = 0;                           \
  88   SLI_header->lisp_readonly = 0;                        \
  89 } while (0)
  90
  91 struct lcrecord_header
  92 {
  93   struct lrecord_header lheader;
  94
  95   /* The `next' field is normally used to chain all lcrecords together
  96      so that the GC can find (and free) all of them.
  97      `alloc_lcrecord' threads lcrecords together.
  98
  99      The `next' field may be used for other purposes as long as some
 100      other mechanism is provided for letting the GC do its work.
 101
 102      For example, the event and marker object types allocate members
 103      out of memory chunks, and are able to find all unmarked members
 104      by sweeping through the elements of the list of chunks.  */
 105   struct lcrecord_header *next;
 106
 107   /* The `uid' field is just for debugging/printing convenience.
 108      Having this slot doesn't hurt us much spacewise, since an
 109      lcrecord already has the above slots plus malloc overhead. */
 110   unsigned int uid :31;
 111
 112   /* The `free' field is a flag that indicates whether this lcrecord
 113      is on a "free list".  Free lists are used to minimize the number
 114      of calls to malloc() when we're repeatedly allocating and freeing
 115      a number of the same sort of lcrecord.  Lcrecords on a free list
 116      always get marked in a different fashion, so we can use this flag
 117      as a sanity check to make sure that free lists only have freed
 118      lcrecords and there are no freed lcrecords elsewhere. */
 119   unsigned int free :1;
 120 };
 121
 122 /* Used for lcrecords in an lcrecord-list. */
 123 struct free_lcrecord_header
 124 {
 125   struct lcrecord_header lcheader;
 126   Lisp_Object chain;
 127 };
 128
 129 enum lrecord_type
 130 {
 131   /* Symbol value magic types come first to make SYMBOL_VALUE_MAGIC_P fast.
 132      #### This should be replaced by a symbol_value_magic_p flag
 133      in the Lisp_Symbol lrecord_header. */
 134   lrecord_type_symbol_value_forward,
 135   lrecord_type_symbol_value_varalias,
 136   lrecord_type_symbol_value_lisp_magic,
 137   lrecord_type_symbol_value_buffer_local,
 138   lrecord_type_max_symbol_value_magic = lrecord_type_symbol_value_buffer_local,
 139
 140   lrecord_type_symbol,
 141   lrecord_type_subr,
 142   lrecord_type_cons,
 143   lrecord_type_vector,
 144   lrecord_type_string,
 145   lrecord_type_lcrecord_list,
 146   lrecord_type_compiled_function,
 147   lrecord_type_weak_list,
 148   lrecord_type_bit_vector,
 149   lrecord_type_float,
 150   lrecord_type_hash_table,
 151   lrecord_type_lstream,
 152   lrecord_type_process,
 153   lrecord_type_charset,
 154   lrecord_type_coding_system,
 155   lrecord_type_char_table,
 156   lrecord_type_char_table_entry,
 157   lrecord_type_char_code_table,
 158   lrecord_type_char_byte_table,
 159   lrecord_type_range_table,
 160   lrecord_type_opaque,
 161   lrecord_type_opaque_ptr,
 162   lrecord_type_buffer,
 163   lrecord_type_extent,
 164   lrecord_type_extent_info,
 165   lrecord_type_extent_auxiliary,
 166   lrecord_type_marker,
 167   lrecord_type_event,
 168   lrecord_type_keymap,
 169   lrecord_type_command_builder,
 170   lrecord_type_timeout,
 171   lrecord_type_specifier,
 172   lrecord_type_console,
 173   lrecord_type_device,
 174   lrecord_type_frame,
 175   lrecord_type_window,
 176   lrecord_type_window_configuration,
 177   lrecord_type_gui_item,
 178   lrecord_type_popup_data,
 179   lrecord_type_toolbar_button,
 180   lrecord_type_color_instance,
 181   lrecord_type_font_instance,
 182   lrecord_type_image_instance,
 183   lrecord_type_glyph,
 184   lrecord_type_face,
 185   lrecord_type_database,
 186   lrecord_type_tooltalk_message,
 187   lrecord_type_tooltalk_pattern,
 188   lrecord_type_ldap,
 189   lrecord_type_pgconn,
 190   lrecord_type_pgresult,
 191   lrecord_type_count /* must be last */
 192 };
 193
 194 struct lrecord_implementation
 195 {
 196   const char *name;
 197
 198   /* `marker' is called at GC time, to make sure that all Lisp_Objects
 199      pointed to by this object get properly marked.  It should call
 200      the mark_object function on all Lisp_Objects in the object.  If
 201      the return value is non-nil, it should be a Lisp_Object to be
 202      marked (don't call the mark_object function explicitly on it,
 203      because the GC routines will do this).  Doing it this way reduces
 204      recursion, so the object returned should preferably be the one
 205      with the deepest level of Lisp_Object pointers.  This function
 206      can be NULL, meaning no GC marking is necessary. */
 207   Lisp_Object (*marker) (Lisp_Object);
 208
 209   /* `printer' converts the object to a printed representation.
 210      This can be NULL; in this case default_object_printer() will be
 211      used instead. */
 212   void (*printer) (Lisp_Object, Lisp_Object printcharfun, int escapeflag);
 213
 214   /* `finalizer' is called at GC time when the object is about to
 215      be freed, and at dump time (FOR_DISKSAVE will be non-zero in this
 216      case).  It should perform any necessary cleanup (e.g. freeing
 217      malloc()ed memory).  This can be NULL, meaning no special
 218      finalization is necessary.
 219
 220      WARNING: remember that `finalizer' is called at dump time even
 221      though the object is not being freed. */
 222   void (*finalizer) (void *header, int for_disksave);
 223
 224   /* This can be NULL, meaning compare objects with EQ(). */
 225   int (*equal) (Lisp_Object obj1, Lisp_Object obj2, int depth);
 226
 227   /* `hash' generates hash values for use with hash tables that have
 228      `equal' as their test function.  This can be NULL, meaning use
 229      the Lisp_Object itself as the hash.  But, you must still satisfy
 230      the constraint that if two objects are `equal', then they *must*
 231      hash to the same value in order for hash tables to work properly.
 232      This means that `hash' can be NULL only if the `equal' method is
 233      also NULL. */
 234   unsigned long (*hash) (Lisp_Object, int);
 235
 236   /* External data layout description */
 237   const struct lrecord_description *description;
 238
 239   /* These functions allow any object type to have builtin property
 240      lists that can be manipulated from the lisp level with
 241      `get', `put', `remprop', and `object-plist'. */
 242   Lisp_Object (*getprop) (Lisp_Object obj, Lisp_Object prop);
 243   int (*putprop) (Lisp_Object obj, Lisp_Object prop, Lisp_Object val);
 244   int (*remprop) (Lisp_Object obj, Lisp_Object prop);
 245   Lisp_Object (*plist) (Lisp_Object obj);
 246
 247   /* Only one of `static_size' and `size_in_bytes_method' is non-0.
 248      If both are 0, this type is not instantiable by alloc_lcrecord(). */
 249   size_t static_size;
 250   size_t (*size_in_bytes_method) (const void *header);
 251
 252   /* The (constant) index into lrecord_implementations_table */
 253   enum lrecord_type lrecord_type_index;
 254
 255   /* A "basic" lrecord is any lrecord that's not an lcrecord, i.e.
 256      one that does not have an lcrecord_header at the front and which
 257      is (usually) allocated in frob blocks.  We only use this flag for
 258      some consistency checking, and that only when error-checking is
 259      enabled. */
 260   unsigned int basic_p :1;
 261 };
 262
 263 extern const struct lrecord_implementation *lrecord_implementations_table[];
 264
 265 #define XRECORD_LHEADER_IMPLEMENTATION(obj) \
 266    LHEADER_IMPLEMENTATION (XRECORD_LHEADER (obj))
 267 #define LHEADER_IMPLEMENTATION(lh) lrecord_implementations_table[(lh)->type]
 268
 269 extern int gc_in_progress;
 270
 271 #define MARKED_RECORD_P(obj) (XRECORD_LHEADER (obj)->mark)
 272 #define MARKED_RECORD_HEADER_P(lheader) ((lheader)->mark)
 273 #define MARK_RECORD_HEADER(lheader)   ((void) ((lheader)->mark = 1))
 274 #define UNMARK_RECORD_HEADER(lheader) ((void) ((lheader)->mark = 0))
 275
 276 #define C_READONLY_RECORD_HEADER_P(lheader)  ((lheader)->c_readonly)
 277 #define LISP_READONLY_RECORD_HEADER_P(lheader)  ((lheader)->lisp_readonly)
 278 #define SET_C_READONLY_RECORD_HEADER(lheader) do {      \
 279   struct lrecord_header *SCRRH_lheader = (lheader);     \
 280   SCRRH_lheader->c_readonly = 1;                        \
 281   SCRRH_lheader->lisp_readonly = 1;                     \
 282   SCRRH_lheader->mark = 1;                              \
 283 } while (0)
 284 #define SET_LISP_READONLY_RECORD_HEADER(lheader) \
 285   ((void) ((lheader)->lisp_readonly = 1))
 286 #define RECORD_MARKER(lheader) lrecord_markers[(lheader)->type]
 287
 288 /* External description stuff
 289
 290    A lrecord external description  is an array  of values.  The  first
 291    value of each line is a type, the second  the offset in the lrecord
 292    structure.  Following values  are parameters, their  presence, type
 293    and number is type-dependant.
 294
 295    The description ends with a "XD_END" or "XD_SPECIFIER_END" record.
 296
 297    Some example descriptions :
 298
 299    static const struct lrecord_description cons_description[] = {
 300      { XD_LISP_OBJECT, offsetof (Lisp_Cons, car) },
 301      { XD_LISP_OBJECT, offsetof (Lisp_Cons, cdr) },
 302      { XD_END }
 303    };
 304
 305    Which means "two lisp objects starting at the 'car' and 'cdr' elements"
 306
 307   static const struct lrecord_description string_description[] = {
 308     { XD_BYTECOUNT,       offsetof (Lisp_String, size) },
 309     { XD_OPAQUE_DATA_PTR, offsetof (Lisp_String, data), XD_INDIRECT(0, 1) },
 310     { XD_LISP_OBJECT,     offsetof (Lisp_String, plist) },
 311     { XD_END }
 312   };
 313   "A pointer to string data at 'data', the size of the pointed array being the value
 314    of the size variable plus 1, and one lisp object at 'plist'"
 315
 316   The existing types :
 317     XD_LISP_OBJECT
 318   A Lisp object.  This is also the type to use for pointers to other lrecords.
 319
 320     XD_LISP_OBJECT_ARRAY
 321   An array of Lisp objects or pointers to lrecords.
 322   The third element is the count.
 323
 324     XD_LO_RESET_NIL
 325   Lisp objects which will be reset to Qnil when dumping.  Useful for cleaning
 326   up caches.
 327
 328     XD_LO_LINK
 329   Link in a linked list of objects of the same type.
 330
 331     XD_OPAQUE_PTR
 332   Pointer to undumpable data.  Must be NULL when dumping.
 333
 334     XD_STRUCT_PTR
 335   Pointer to described struct.  Parameters are number of structures and
 336   struct_description.
 337
 338     XD_OPAQUE_DATA_PTR
 339   Pointer to dumpable opaque data.  Parameter is the size of the data.
 340   Pointed data must be relocatable without changes.
 341
 342     XD_C_STRING
 343   Pointer to a C string.
 344
 345     XD_DOC_STRING
 346   Pointer to a doc string (C string if positive, opaque value if negative)
 347
 348     XD_INT_RESET
 349   An integer which will be reset to a given value in the dump file.
 350
 351
 352     XD_SIZE_T
 353   size_t value.  Used for counts.
 354
 355     XD_INT
 356   int value.  Used for counts.
 357
 358     XD_LONG
 359   long value.  Used for counts.
 360
 361     XD_BYTECOUNT
 362   bytecount value.  Used for counts.
 363
 364     XD_END
 365   Special type indicating the end of the array.
 366
 367     XD_SPECIFIER_END
 368   Special type indicating the end of the array for a specifier.  Extra
 369   description is going to be fetched from the specifier methods.
 370
 371
 372   Special macros:
 373     XD_INDIRECT(line, delta)
 374   Usable where  a "count" or "size"  is requested.  Gives the value of
 375   the element which is at line number 'line' in the description (count
 376   starts at zero) and adds delta to it.
 377 */
 378
 379 enum lrecord_description_type {
 380   XD_LISP_OBJECT_ARRAY,
 381   XD_LISP_OBJECT,
 382   XD_LO_RESET_NIL,
 383   XD_LO_LINK,
 384   XD_OPAQUE_PTR,
 385   XD_STRUCT_PTR,
 386   XD_OPAQUE_DATA_PTR,
 387   XD_C_STRING,
 388   XD_DOC_STRING,
 389   XD_INT_RESET,
 390   XD_SIZE_T,
 391   XD_INT,
 392   XD_LONG,
 393   XD_BYTECOUNT,
 394   XD_END,
 395   XD_SPECIFIER_END
 396 };
 397
 398 struct lrecord_description {
 399   enum lrecord_description_type type;
 400   int offset;
 401   EMACS_INT data1;
 402   const struct struct_description *data2;
 403 };
 404
 405 struct struct_description {
 406   size_t size;
 407   const struct lrecord_description *description;
 408 };
 409
 410 #define XD_INDIRECT(val, delta) (-1-((val)|(delta<<8)))
 411
 412 #define XD_IS_INDIRECT(code) (code<0)
 413 #define XD_INDIRECT_VAL(code) ((-1-code) & 255)
 414 #define XD_INDIRECT_DELTA(code) (((-1-code)>>8) & 255)
 415
 416 #define XD_DYNARR_DESC(base_type, sub_desc) \
 417   { XD_STRUCT_PTR, offsetof (base_type, base), XD_INDIRECT(1, 0), sub_desc }, \
 418   { XD_INT,        offsetof (base_type, cur) }, \
 419   { XD_INT_RESET,  offsetof (base_type, max), XD_INDIRECT(1, 0) }
 420
 421 /* DEFINE_LRECORD_IMPLEMENTATION is for objects with constant size.
 422    DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION is for objects whose size varies.
 423  */
 424
 425 #if defined (ERROR_CHECK_TYPECHECK)
 426 # define DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype)
 427 #else
 428 # define DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype)
 429 #endif
 430
 431 #define DEFINE_BASIC_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \
 432 DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype)
 433
 434 #define DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \
 435 MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof(structtype),0,1,structtype)
 436
 437 #define DEFINE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \
 438 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype)
 439
 440 #define DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \
 441 MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof (structtype),0,0,structtype)
 442
 443 #define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \
 444 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,sizer,structtype)
 445
 446 #define DEFINE_BASIC_LRECORD_SEQUENCE_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \
 447 MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,sizer,1,structtype)
 448
 449 #define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizer,structtype) \
 450 MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,0,sizer,0,structtype) \
 451
 452 #define MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \
 453 DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype)                       \
 454 const struct lrecord_implementation lrecord_##c_name =                  \
 455   { name, marker, printer, nuker, equal, hash, desc,                    \
 456     getprop, putprop, remprop, plist, size, sizer,                      \
 457     lrecord_type_##c_name, basic_p }
 458
 459 extern Lisp_Object (*lrecord_markers[]) (Lisp_Object);
 460
 461 #define INIT_LRECORD_IMPLEMENTATION(type) do {                          \
 462   lrecord_implementations_table[lrecord_type_##type] = &lrecord_##type; \
 463   lrecord_markers[lrecord_type_##type] =                                \
 464     lrecord_implementations_table[lrecord_type_##type]->marker;         \
 465 } while (0)
 466
 467 #define LRECORDP(a) (XTYPE (a) == Lisp_Type_Record)
 468 #define XRECORD_LHEADER(a) ((struct lrecord_header *) XPNTR (a))
 469
 470 #define RECORD_TYPEP(x, ty) \
 471   (LRECORDP (x) && XRECORD_LHEADER (x)->type == (ty))
 472
 473 /* NOTE: the DECLARE_LRECORD() must come before the associated
 474    DEFINE_LRECORD_*() or you will get compile errors.
 475
 476    Furthermore, you always need to put the DECLARE_LRECORD() in a header
 477    file, and make sure the header file is included in inline.c, even
 478    if the type is private to a particular file.  Otherwise, you will
 479    get undefined references for the error_check_foo() inline function
 480    under GCC. */
 481
 482 #ifdef ERROR_CHECK_TYPECHECK
 483
 484 # define DECLARE_LRECORD(c_name, structtype)                    \
 485 extern const struct lrecord_implementation lrecord_##c_name;    \
 486 INLINE_HEADER structtype *                                      \
 487 error_check_##c_name (Lisp_Object obj);                         \
 488 INLINE_HEADER structtype *                                      \
 489 error_check_##c_name (Lisp_Object obj)                          \
 490 {                                                               \
 491   assert (RECORD_TYPEP (obj, lrecord_type_##c_name));           \
 492   return (structtype *) XPNTR (obj);                            \
 493 }                                                               \
 494 extern Lisp_Object Q##c_name##p
 495
 496 # define DECLARE_NONRECORD(c_name, type_enum, structtype)       \
 497 INLINE_HEADER structtype *                                      \
 498 error_check_##c_name (Lisp_Object obj);                         \
 499 INLINE_HEADER structtype *                                      \
 500 error_check_##c_name (Lisp_Object obj)                          \
 501 {                                                               \
 502   assert (XTYPE (obj) == type_enum);                            \
 503   return (structtype *) XPNTR (obj);                            \
 504 }                                                               \
 505 extern Lisp_Object Q##c_name##p
 506
 507 # define XRECORD(x, c_name, structtype) error_check_##c_name (x)
 508 # define XNONRECORD(x, c_name, type_enum, structtype) error_check_##c_name (x)
 509
 510 # define XSETRECORD(var, p, c_name) do                          \
 511 {                                                               \
 512   XSETOBJ (var, Lisp_Type_Record, p);                           \
 513   assert (RECORD_TYPEP (var, lrecord_type_##c_name));           \
 514 } while (0)
 515
 516 #else /* not ERROR_CHECK_TYPECHECK */
 517
 518 # define DECLARE_LRECORD(c_name, structtype)                    \
 519 extern Lisp_Object Q##c_name##p;                                \
 520 extern const struct lrecord_implementation lrecord_##c_name
 521 # define DECLARE_NONRECORD(c_name, type_enum, structtype)       \
 522 extern Lisp_Object Q##c_name##p
 523 # define XRECORD(x, c_name, structtype) ((structtype *) XPNTR (x))
 524 # define XNONRECORD(x, c_name, type_enum, structtype)           \
 525   ((structtype *) XPNTR (x))
 526 # define XSETRECORD(var, p, c_name) XSETOBJ (var, Lisp_Type_Record, p)
 527
 528 #endif /* not ERROR_CHECK_TYPECHECK */
 529
 530 #define RECORDP(x, c_name) RECORD_TYPEP (x, lrecord_type_##c_name)
 531
 532 /* Note: we now have two different kinds of type-checking macros.
 533    The "old" kind has now been renamed CONCHECK_foo.  The reason for
 534    this is that the CONCHECK_foo macros signal a continuable error,
 535    allowing the user (through debug-on-error) to substitute a different
 536    value and return from the signal, which causes the lvalue argument
 537    to get changed.  Quite a lot of code would crash if that happened,
 538    because it did things like
 539
 540    foo = XCAR (list);
 541    CHECK_STRING (foo);
 542
 543    and later on did XSTRING (XCAR (list)), assuming that the type
 544    is correct (when it might be wrong, if the user substituted a
 545    correct value in the debugger).
 546
 547    To get around this, I made all the CHECK_foo macros signal a
 548    non-continuable error.  Places where a continuable error is OK
 549    (generally only when called directly on the argument of a Lisp
 550    primitive) should be changed to use CONCHECK().
 551
 552    FSF Emacs does not have this problem because RMS took the cheesy
 553    way out and disabled returning from a signal entirely. */
 554
 555 #define CONCHECK_RECORD(x, c_name) do {                 \
 556  if (!RECORD_TYPEP (x, lrecord_type_##c_name))          \
 557    x = wrong_type_argument (Q##c_name##p, x);           \
 558 }  while (0)
 559 #define CONCHECK_NONRECORD(x, lisp_enum, predicate) do {\
 560  if (XTYPE (x) != lisp_enum)                            \
 561    x = wrong_type_argument (predicate, x);              \
 562  } while (0)
 563 #define CHECK_RECORD(x, c_name) do {                    \
 564  if (!RECORD_TYPEP (x, lrecord_type_##c_name))          \
 565    dead_wrong_type_argument (Q##c_name##p, x);          \
 566  } while (0)
 567 #define CHECK_NONRECORD(x, lisp_enum, predicate) do {   \
 568  if (XTYPE (x) != lisp_enum)                            \
 569    dead_wrong_type_argument (predicate, x);             \
 570  } while (0)
 571
 572 void *alloc_lcrecord (size_t size, const struct lrecord_implementation *);
 573
 574 #define alloc_lcrecord_type(type, lrecord_implementation) \
 575   ((type *) alloc_lcrecord (sizeof (type), lrecord_implementation))
 576
 577 /* Copy the data from one lcrecord structure into another, but don't
 578    overwrite the header information. */
 579
 580 #define copy_lcrecord(dst, src)                                 \
 581   memcpy ((char *) (dst) + sizeof (struct lcrecord_header),     \
 582           (char *) (src) + sizeof (struct lcrecord_header),     \
 583           sizeof (*(dst)) - sizeof (struct lcrecord_header))
 584
 585 #define zero_lcrecord(lcr)                                      \
 586    memset ((char *) (lcr) + sizeof (struct lcrecord_header), 0, \
 587            sizeof (*(lcr)) - sizeof (struct lcrecord_header))
 588
 589 #endif /* INCLUDED_lrecord_h_ */