428
+ − 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
440
+ − 24 #ifndef INCLUDED_lrecord_h_
+ − 25 #define INCLUDED_lrecord_h_
428
+ − 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
442
+ − 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.
428
+ − 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
442
+ − 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().
428
+ − 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[] */
442
+ − 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
428
+ − 76 /* 1 if the object is readonly from lisp */
442
+ − 77 unsigned int lisp_readonly :1;
428
+ − 78 };
+ − 79
+ − 80 struct lrecord_implementation;
442
+ − 81 int lrecord_type_index (const struct lrecord_implementation *implementation);
428
+ − 82
430
+ − 83 #define set_lheader_implementation(header,imp) do { \
428
+ − 84 struct lrecord_header* SLI_header = (header); \
442
+ − 85 SLI_header->type = (imp)->lrecord_type_index; \
430
+ − 86 SLI_header->mark = 0; \
+ − 87 SLI_header->c_readonly = 0; \
+ − 88 SLI_header->lisp_readonly = 0; \
428
+ − 89 } while (0)
+ − 90
+ − 91 struct lcrecord_header
+ − 92 {
+ − 93 struct lrecord_header lheader;
+ − 94
442
+ − 95 /* The `next' field is normally used to chain all lcrecords together
428
+ − 96 so that the GC can find (and free) all of them.
442
+ − 97 `alloc_lcrecord' threads lcrecords together.
428
+ − 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
442
+ − 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_range_table,
+ − 158 lrecord_type_opaque,
+ − 159 lrecord_type_opaque_ptr,
+ − 160 lrecord_type_buffer,
+ − 161 lrecord_type_extent,
+ − 162 lrecord_type_extent_info,
+ − 163 lrecord_type_extent_auxiliary,
+ − 164 lrecord_type_marker,
+ − 165 lrecord_type_event,
+ − 166 lrecord_type_keymap,
+ − 167 lrecord_type_command_builder,
+ − 168 lrecord_type_timeout,
+ − 169 lrecord_type_specifier,
+ − 170 lrecord_type_console,
+ − 171 lrecord_type_device,
+ − 172 lrecord_type_frame,
+ − 173 lrecord_type_window,
617
+ − 174 lrecord_type_window_mirror,
442
+ − 175 lrecord_type_window_configuration,
+ − 176 lrecord_type_gui_item,
+ − 177 lrecord_type_popup_data,
+ − 178 lrecord_type_toolbar_button,
617
+ − 179 lrecord_type_scrollbar_instance,
442
+ − 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_devmode,
+ − 192 lrecord_type_mswindows_dialog_id,
446
+ − 193 lrecord_type_case_table,
462
+ − 194 lrecord_type_emacs_ffi,
+ − 195 lrecord_type_emacs_gtk_object,
+ − 196 lrecord_type_emacs_gtk_boxed,
454
+ − 197 lrecord_type_free, /* only used for "free" lrecords */
+ − 198 lrecord_type_undefined, /* only used for debugging */
442
+ − 199 lrecord_type_last_built_in_type /* must be last */
+ − 200 };
+ − 201
+ − 202 extern unsigned int lrecord_type_count;
428
+ − 203
+ − 204 struct lrecord_implementation
+ − 205 {
442
+ − 206 const char *name;
+ − 207
+ − 208 /* `marker' is called at GC time, to make sure that all Lisp_Objects
428
+ − 209 pointed to by this object get properly marked. It should call
+ − 210 the mark_object function on all Lisp_Objects in the object. If
+ − 211 the return value is non-nil, it should be a Lisp_Object to be
+ − 212 marked (don't call the mark_object function explicitly on it,
+ − 213 because the GC routines will do this). Doing it this way reduces
+ − 214 recursion, so the object returned should preferably be the one
+ − 215 with the deepest level of Lisp_Object pointers. This function
+ − 216 can be NULL, meaning no GC marking is necessary. */
+ − 217 Lisp_Object (*marker) (Lisp_Object);
442
+ − 218
+ − 219 /* `printer' converts the object to a printed representation.
+ − 220 This can be NULL; in this case default_object_printer() will be
+ − 221 used instead. */
428
+ − 222 void (*printer) (Lisp_Object, Lisp_Object printcharfun, int escapeflag);
442
+ − 223
+ − 224 /* `finalizer' is called at GC time when the object is about to
428
+ − 225 be freed, and at dump time (FOR_DISKSAVE will be non-zero in this
+ − 226 case). It should perform any necessary cleanup (e.g. freeing
442
+ − 227 malloc()ed memory). This can be NULL, meaning no special
428
+ − 228 finalization is necessary.
+ − 229
442
+ − 230 WARNING: remember that `finalizer' is called at dump time even
428
+ − 231 though the object is not being freed. */
+ − 232 void (*finalizer) (void *header, int for_disksave);
442
+ − 233
428
+ − 234 /* This can be NULL, meaning compare objects with EQ(). */
+ − 235 int (*equal) (Lisp_Object obj1, Lisp_Object obj2, int depth);
442
+ − 236
+ − 237 /* `hash' generates hash values for use with hash tables that have
+ − 238 `equal' as their test function. This can be NULL, meaning use
+ − 239 the Lisp_Object itself as the hash. But, you must still satisfy
+ − 240 the constraint that if two objects are `equal', then they *must*
+ − 241 hash to the same value in order for hash tables to work properly.
+ − 242 This means that `hash' can be NULL only if the `equal' method is
+ − 243 also NULL. */
428
+ − 244 unsigned long (*hash) (Lisp_Object, int);
+ − 245
+ − 246 /* External data layout description */
+ − 247 const struct lrecord_description *description;
+ − 248
442
+ − 249 /* These functions allow any object type to have builtin property
+ − 250 lists that can be manipulated from the lisp level with
+ − 251 `get', `put', `remprop', and `object-plist'. */
428
+ − 252 Lisp_Object (*getprop) (Lisp_Object obj, Lisp_Object prop);
+ − 253 int (*putprop) (Lisp_Object obj, Lisp_Object prop, Lisp_Object val);
+ − 254 int (*remprop) (Lisp_Object obj, Lisp_Object prop);
+ − 255 Lisp_Object (*plist) (Lisp_Object obj);
+ − 256
442
+ − 257 /* Only one of `static_size' and `size_in_bytes_method' is non-0.
+ − 258 If both are 0, this type is not instantiable by alloc_lcrecord(). */
428
+ − 259 size_t static_size;
442
+ − 260 size_t (*size_in_bytes_method) (const void *header);
+ − 261
+ − 262 /* The (constant) index into lrecord_implementations_table */
+ − 263 enum lrecord_type lrecord_type_index;
+ − 264
428
+ − 265 /* A "basic" lrecord is any lrecord that's not an lcrecord, i.e.
+ − 266 one that does not have an lcrecord_header at the front and which
+ − 267 is (usually) allocated in frob blocks. We only use this flag for
+ − 268 some consistency checking, and that only when error-checking is
+ − 269 enabled. */
442
+ − 270 unsigned int basic_p :1;
428
+ − 271 };
+ − 272
617
+ − 273 /* All the built-in lisp object types are enumerated in `enum lrecord_type'.
442
+ − 274 Additional ones may be defined by a module (none yet). We leave some
+ − 275 room in `lrecord_implementations_table' for such new lisp object types. */
+ − 276 #define MODULE_DEFINABLE_TYPE_COUNT 32
+ − 277
+ − 278 extern const struct lrecord_implementation *lrecord_implementations_table[(unsigned int)lrecord_type_last_built_in_type + MODULE_DEFINABLE_TYPE_COUNT];
428
+ − 279
+ − 280 #define XRECORD_LHEADER_IMPLEMENTATION(obj) \
442
+ − 281 LHEADER_IMPLEMENTATION (XRECORD_LHEADER (obj))
+ − 282 #define LHEADER_IMPLEMENTATION(lh) lrecord_implementations_table[(lh)->type]
428
+ − 283
+ − 284 extern int gc_in_progress;
+ − 285
442
+ − 286 #define MARKED_RECORD_P(obj) (XRECORD_LHEADER (obj)->mark)
428
+ − 287 #define MARKED_RECORD_HEADER_P(lheader) ((lheader)->mark)
+ − 288 #define MARK_RECORD_HEADER(lheader) ((void) ((lheader)->mark = 1))
+ − 289 #define UNMARK_RECORD_HEADER(lheader) ((void) ((lheader)->mark = 0))
+ − 290
+ − 291 #define C_READONLY_RECORD_HEADER_P(lheader) ((lheader)->c_readonly)
+ − 292 #define LISP_READONLY_RECORD_HEADER_P(lheader) ((lheader)->lisp_readonly)
442
+ − 293 #define SET_C_READONLY_RECORD_HEADER(lheader) do { \
+ − 294 struct lrecord_header *SCRRH_lheader = (lheader); \
+ − 295 SCRRH_lheader->c_readonly = 1; \
+ − 296 SCRRH_lheader->lisp_readonly = 1; \
+ − 297 SCRRH_lheader->mark = 1; \
+ − 298 } while (0)
428
+ − 299 #define SET_LISP_READONLY_RECORD_HEADER(lheader) \
+ − 300 ((void) ((lheader)->lisp_readonly = 1))
442
+ − 301 #define RECORD_MARKER(lheader) lrecord_markers[(lheader)->type]
428
+ − 302
+ − 303 /* External description stuff
+ − 304
+ − 305 A lrecord external description is an array of values. The first
+ − 306 value of each line is a type, the second the offset in the lrecord
+ − 307 structure. Following values are parameters, their presence, type
442
+ − 308 and number is type-dependent.
428
+ − 309
+ − 310 The description ends with a "XD_END" or "XD_SPECIFIER_END" record.
+ − 311
+ − 312 Some example descriptions :
440
+ − 313
428
+ − 314 static const struct lrecord_description cons_description[] = {
440
+ − 315 { XD_LISP_OBJECT, offsetof (Lisp_Cons, car) },
+ − 316 { XD_LISP_OBJECT, offsetof (Lisp_Cons, cdr) },
428
+ − 317 { XD_END }
+ − 318 };
+ − 319
440
+ − 320 Which means "two lisp objects starting at the 'car' and 'cdr' elements"
428
+ − 321
+ − 322 static const struct lrecord_description string_description[] = {
440
+ − 323 { XD_BYTECOUNT, offsetof (Lisp_String, size) },
+ − 324 { XD_OPAQUE_DATA_PTR, offsetof (Lisp_String, data), XD_INDIRECT(0, 1) },
+ − 325 { XD_LISP_OBJECT, offsetof (Lisp_String, plist) },
428
+ − 326 { XD_END }
+ − 327 };
+ − 328 "A pointer to string data at 'data', the size of the pointed array being the value
+ − 329 of the size variable plus 1, and one lisp object at 'plist'"
+ − 330
+ − 331 The existing types :
+ − 332 XD_LISP_OBJECT
440
+ − 333 A Lisp object. This is also the type to use for pointers to other lrecords.
428
+ − 334
440
+ − 335 XD_LISP_OBJECT_ARRAY
+ − 336 An array of Lisp objects or pointers to lrecords.
+ − 337 The third element is the count.
+ − 338
428
+ − 339 XD_LO_LINK
+ − 340 Link in a linked list of objects of the same type.
432
+ − 341
428
+ − 342 XD_OPAQUE_PTR
+ − 343 Pointer to undumpable data. Must be NULL when dumping.
+ − 344
+ − 345 XD_STRUCT_PTR
+ − 346 Pointer to described struct. Parameters are number of structures and
+ − 347 struct_description.
+ − 348
+ − 349 XD_OPAQUE_DATA_PTR
+ − 350 Pointer to dumpable opaque data. Parameter is the size of the data.
+ − 351 Pointed data must be relocatable without changes.
+ − 352
+ − 353 XD_C_STRING
+ − 354 Pointer to a C string.
+ − 355
+ − 356 XD_DOC_STRING
+ − 357 Pointer to a doc string (C string if positive, opaque value if negative)
+ − 358
+ − 359 XD_INT_RESET
+ − 360 An integer which will be reset to a given value in the dump file.
+ − 361
+ − 362
+ − 363 XD_SIZE_T
+ − 364 size_t value. Used for counts.
+ − 365
+ − 366 XD_INT
+ − 367 int value. Used for counts.
+ − 368
+ − 369 XD_LONG
+ − 370 long value. Used for counts.
+ − 371
+ − 372 XD_BYTECOUNT
+ − 373 bytecount value. Used for counts.
+ − 374
+ − 375 XD_END
+ − 376 Special type indicating the end of the array.
+ − 377
+ − 378 XD_SPECIFIER_END
+ − 379 Special type indicating the end of the array for a specifier. Extra
+ − 380 description is going to be fetched from the specifier methods.
+ − 381
+ − 382
+ − 383 Special macros:
+ − 384 XD_INDIRECT(line, delta)
+ − 385 Usable where a "count" or "size" is requested. Gives the value of
+ − 386 the element which is at line number 'line' in the description (count
+ − 387 starts at zero) and adds delta to it.
+ − 388 */
+ − 389
+ − 390 enum lrecord_description_type {
440
+ − 391 XD_LISP_OBJECT_ARRAY,
428
+ − 392 XD_LISP_OBJECT,
+ − 393 XD_LO_LINK,
+ − 394 XD_OPAQUE_PTR,
+ − 395 XD_STRUCT_PTR,
+ − 396 XD_OPAQUE_DATA_PTR,
+ − 397 XD_C_STRING,
+ − 398 XD_DOC_STRING,
+ − 399 XD_INT_RESET,
+ − 400 XD_SIZE_T,
+ − 401 XD_INT,
+ − 402 XD_LONG,
+ − 403 XD_BYTECOUNT,
+ − 404 XD_END,
+ − 405 XD_SPECIFIER_END
+ − 406 };
+ − 407
+ − 408 struct lrecord_description {
+ − 409 enum lrecord_description_type type;
+ − 410 int offset;
+ − 411 EMACS_INT data1;
+ − 412 const struct struct_description *data2;
+ − 413 };
+ − 414
+ − 415 struct struct_description {
+ − 416 size_t size;
+ − 417 const struct lrecord_description *description;
+ − 418 };
+ − 419
+ − 420 #define XD_INDIRECT(val, delta) (-1-((val)|(delta<<8)))
+ − 421
+ − 422 #define XD_IS_INDIRECT(code) (code<0)
+ − 423 #define XD_INDIRECT_VAL(code) ((-1-code) & 255)
+ − 424 #define XD_INDIRECT_DELTA(code) (((-1-code)>>8) & 255)
+ − 425
+ − 426 #define XD_DYNARR_DESC(base_type, sub_desc) \
440
+ − 427 { XD_STRUCT_PTR, offsetof (base_type, base), XD_INDIRECT(1, 0), sub_desc }, \
+ − 428 { XD_INT, offsetof (base_type, cur) }, \
+ − 429 { XD_INT_RESET, offsetof (base_type, max), XD_INDIRECT(1, 0) }
428
+ − 430
+ − 431 /* DEFINE_LRECORD_IMPLEMENTATION is for objects with constant size.
+ − 432 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION is for objects whose size varies.
+ − 433 */
+ − 434
+ − 435 #if defined (ERROR_CHECK_TYPECHECK)
+ − 436 # define DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype)
+ − 437 #else
+ − 438 # define DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype)
+ − 439 #endif
+ − 440
+ − 441 #define DEFINE_BASIC_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \
+ − 442 DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype)
+ − 443
442
+ − 444 #define DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \
+ − 445 MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof(structtype),0,1,structtype)
428
+ − 446
+ − 447 #define DEFINE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \
+ − 448 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype)
+ − 449
442
+ − 450 #define DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \
+ − 451 MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof (structtype),0,0,structtype)
428
+ − 452
+ − 453 #define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \
+ − 454 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,sizer,structtype)
+ − 455
442
+ − 456 #define DEFINE_BASIC_LRECORD_SEQUENCE_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \
+ − 457 MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,sizer,1,structtype)
428
+ − 458
442
+ − 459 #define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizer,structtype) \
+ − 460 MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,0,sizer,0,structtype) \
+ − 461
+ − 462 #define MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \
428
+ − 463 DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype) \
442
+ − 464 const struct lrecord_implementation lrecord_##c_name = \
428
+ − 465 { name, marker, printer, nuker, equal, hash, desc, \
442
+ − 466 getprop, putprop, remprop, plist, size, sizer, \
+ − 467 lrecord_type_##c_name, basic_p }
+ − 468
+ − 469 #define DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \
+ − 470 DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype)
+ − 471
+ − 472 #define DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \
+ − 473 MAKE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof (structtype),0,0,structtype)
+ − 474
+ − 475 #define DEFINE_EXTERNAL_LRECORD_SEQUENCE_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \
+ − 476 DEFINE_EXTERNAL_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,sizer,structtype)
+ − 477
+ − 478 #define DEFINE_EXTERNAL_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizer,structtype) \
+ − 479 MAKE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,0,sizer,0,structtype)
+ − 480
+ − 481 #define MAKE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \
+ − 482 DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype) \
444
+ − 483 unsigned int lrecord_type_##c_name; \
+ − 484 struct lrecord_implementation lrecord_##c_name = \
442
+ − 485 { name, marker, printer, nuker, equal, hash, desc, \
+ − 486 getprop, putprop, remprop, plist, size, sizer, \
444
+ − 487 lrecord_type_last_built_in_type, basic_p }
442
+ − 488
+ − 489
+ − 490 extern Lisp_Object (*lrecord_markers[]) (Lisp_Object);
+ − 491
+ − 492 #define INIT_LRECORD_IMPLEMENTATION(type) do { \
+ − 493 lrecord_implementations_table[lrecord_type_##type] = &lrecord_##type; \
+ − 494 lrecord_markers[lrecord_type_##type] = \
+ − 495 lrecord_implementations_table[lrecord_type_##type]->marker; \
+ − 496 } while (0)
428
+ − 497
444
+ − 498 #define INIT_EXTERNAL_LRECORD_IMPLEMENTATION(type) do { \
+ − 499 lrecord_type_##type = lrecord_type_count++; \
+ − 500 lrecord_##type.lrecord_type_index = lrecord_type_##type; \
+ − 501 INIT_LRECORD_IMPLEMENTATION(type); \
+ − 502 } while (0)
+ − 503
428
+ − 504 #define LRECORDP(a) (XTYPE (a) == Lisp_Type_Record)
+ − 505 #define XRECORD_LHEADER(a) ((struct lrecord_header *) XPNTR (a))
+ − 506
+ − 507 #define RECORD_TYPEP(x, ty) \
442
+ − 508 (LRECORDP (x) && (((unsigned int)(XRECORD_LHEADER (x)->type)) == ((unsigned int)(ty))))
+ − 509
+ − 510 /* Steps to create a new object:
+ − 511
+ − 512 1. Declare the struct for your object in a header file somewhere.
+ − 513 Remember that it must begin with
+ − 514
+ − 515 struct lcrecord_header header;
+ − 516
617
+ − 517 2. Put the "standard junk" (DECLARE_RECORD()/XFOO/XSETFOO/etc.) below the
+ − 518 struct definition -- see below.
442
+ − 519
+ − 520 3. Add this header file to inline.c.
+ − 521
+ − 522 4. Create the methods for your object. Note that technically you don't
+ − 523 need any, but you will almost always want at least a mark method.
+ − 524
+ − 525 5. Define your object with DEFINE_LRECORD_IMPLEMENTATION() or some
+ − 526 variant.
+ − 527
+ − 528 6. Include the header file in the .c file where you defined the object.
+ − 529
+ − 530 7. Put a call to INIT_LRECORD_IMPLEMENTATION() for the object in the
+ − 531 .c file's syms_of_foo() function.
+ − 532
+ − 533 8. Add a type enum for the object to enum lrecord_type, earlier in this
+ − 534 file.
+ − 535
+ − 536 An example:
428
+ − 537
442
+ − 538 ------------------------------ in toolbar.h -----------------------------
+ − 539
+ − 540 struct toolbar_button
+ − 541 {
+ − 542 struct lcrecord_header header;
+ − 543
+ − 544 Lisp_Object next;
+ − 545 Lisp_Object frame;
+ − 546
+ − 547 Lisp_Object up_glyph;
+ − 548 Lisp_Object down_glyph;
+ − 549 Lisp_Object disabled_glyph;
+ − 550
+ − 551 Lisp_Object cap_up_glyph;
+ − 552 Lisp_Object cap_down_glyph;
+ − 553 Lisp_Object cap_disabled_glyph;
+ − 554
+ − 555 Lisp_Object callback;
+ − 556 Lisp_Object enabled_p;
+ − 557 Lisp_Object help_string;
+ − 558
+ − 559 char enabled;
+ − 560 char down;
+ − 561 char pushright;
+ − 562 char blank;
+ − 563
+ − 564 int x, y;
+ − 565 int width, height;
+ − 566 int dirty;
+ − 567 int vertical;
+ − 568 int border_width;
+ − 569 };
428
+ − 570
617
+ − 571 [[ the standard junk: ]]
+ − 572
442
+ − 573 DECLARE_LRECORD (toolbar_button, struct toolbar_button);
+ − 574 #define XTOOLBAR_BUTTON(x) XRECORD (x, toolbar_button, struct toolbar_button)
+ − 575 #define XSETTOOLBAR_BUTTON(x, p) XSETRECORD (x, p, toolbar_button)
617
+ − 576 #define wrap_toolbar_button(p) wrap_record (p, toolbar_button)
442
+ − 577 #define TOOLBAR_BUTTONP(x) RECORDP (x, toolbar_button)
+ − 578 #define CHECK_TOOLBAR_BUTTON(x) CHECK_RECORD (x, toolbar_button)
+ − 579 #define CONCHECK_TOOLBAR_BUTTON(x) CONCHECK_RECORD (x, toolbar_button)
+ − 580
+ − 581 ------------------------------ in toolbar.c -----------------------------
+ − 582
+ − 583 #include "toolbar.h"
+ − 584
+ − 585 ...
+ − 586
+ − 587 static Lisp_Object
+ − 588 mark_toolbar_button (Lisp_Object obj)
+ − 589 {
+ − 590 struct toolbar_button *data = XTOOLBAR_BUTTON (obj);
+ − 591 mark_object (data->next);
+ − 592 mark_object (data->frame);
+ − 593 mark_object (data->up_glyph);
+ − 594 mark_object (data->down_glyph);
+ − 595 mark_object (data->disabled_glyph);
+ − 596 mark_object (data->cap_up_glyph);
+ − 597 mark_object (data->cap_down_glyph);
+ − 598 mark_object (data->cap_disabled_glyph);
+ − 599 mark_object (data->callback);
+ − 600 mark_object (data->enabled_p);
+ − 601 return data->help_string;
+ − 602 }
+ − 603
617
+ − 604 [[ If your object should never escape to Lisp, declare its print method
+ − 605 as internal_object_printer instead of 0. ]]
+ − 606
442
+ − 607 DEFINE_LRECORD_IMPLEMENTATION ("toolbar-button", toolbar_button,
617
+ − 608 mark_toolbar_button, 0,
+ − 609 0, 0, 0, 0, struct toolbar_button);
442
+ − 610
+ − 611 ...
+ − 612
+ − 613 void
+ − 614 syms_of_toolbar (void)
+ − 615 {
+ − 616 INIT_LRECORD_IMPLEMENTATION (toolbar_button);
+ − 617
+ − 618 ...;
+ − 619 }
+ − 620
+ − 621 ------------------------------ in inline.c -----------------------------
+ − 622
+ − 623 #ifdef HAVE_TOOLBARS
+ − 624 #include "toolbar.h"
+ − 625 #endif
+ − 626
+ − 627 ------------------------------ in lrecord.h -----------------------------
+ − 628
+ − 629 enum lrecord_type
+ − 630 {
+ − 631 ...
+ − 632 lrecord_type_toolbar_button,
+ − 633 ...
+ − 634 };
+ − 635
+ − 636 */
+ − 637
+ − 638 /*
+ − 639
+ − 640 Note: Object types defined in external dynamically-loaded modules (not
+ − 641 part of the XEmacs main source code) should use DECLARE_EXTERNAL_LRECORD
+ − 642 and DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION rather than DECLARE_LRECORD
+ − 643 and DEFINE_LRECORD_IMPLEMENTATION.
+ − 644
+ − 645 */
+ − 646
428
+ − 647
+ − 648 #ifdef ERROR_CHECK_TYPECHECK
+ − 649
+ − 650 # define DECLARE_LRECORD(c_name, structtype) \
442
+ − 651 extern const struct lrecord_implementation lrecord_##c_name; \
+ − 652 INLINE_HEADER structtype * \
+ − 653 error_check_##c_name (Lisp_Object obj); \
+ − 654 INLINE_HEADER structtype * \
428
+ − 655 error_check_##c_name (Lisp_Object obj) \
+ − 656 { \
442
+ − 657 assert (RECORD_TYPEP (obj, lrecord_type_##c_name)); \
428
+ − 658 return (structtype *) XPNTR (obj); \
+ − 659 } \
+ − 660 extern Lisp_Object Q##c_name##p
+ − 661
442
+ − 662 # define DECLARE_EXTERNAL_LRECORD(c_name, structtype) \
+ − 663 extern unsigned int lrecord_type_##c_name; \
444
+ − 664 extern struct lrecord_implementation lrecord_##c_name; \
+ − 665 INLINE_HEADER structtype * \
+ − 666 error_check_##c_name (Lisp_Object obj); \
+ − 667 INLINE_HEADER structtype * \
+ − 668 error_check_##c_name (Lisp_Object obj) \
+ − 669 { \
+ − 670 assert (RECORD_TYPEP (obj, lrecord_type_##c_name)); \
+ − 671 return (structtype *) XPNTR (obj); \
+ − 672 } \
+ − 673 extern Lisp_Object Q##c_name##p
442
+ − 674
428
+ − 675 # define DECLARE_NONRECORD(c_name, type_enum, structtype) \
442
+ − 676 INLINE_HEADER structtype * \
+ − 677 error_check_##c_name (Lisp_Object obj); \
+ − 678 INLINE_HEADER structtype * \
428
+ − 679 error_check_##c_name (Lisp_Object obj) \
+ − 680 { \
+ − 681 assert (XTYPE (obj) == type_enum); \
+ − 682 return (structtype *) XPNTR (obj); \
+ − 683 } \
+ − 684 extern Lisp_Object Q##c_name##p
+ − 685
+ − 686 # define XRECORD(x, c_name, structtype) error_check_##c_name (x)
+ − 687 # define XNONRECORD(x, c_name, type_enum, structtype) error_check_##c_name (x)
+ − 688
+ − 689 # define XSETRECORD(var, p, c_name) do \
+ − 690 { \
442
+ − 691 XSETOBJ (var, p); \
+ − 692 assert (RECORD_TYPEP (var, lrecord_type_##c_name)); \
428
+ − 693 } while (0)
+ − 694
617
+ − 695 INLINE_HEADER Lisp_Object wrap_record_1 (void *ptr, enum lrecord_type ty);
+ − 696 INLINE_HEADER Lisp_Object
+ − 697 wrap_record_1 (void *ptr, enum lrecord_type ty)
+ − 698 {
+ − 699 Lisp_Object obj;
+ − 700 XSETOBJ (obj, ptr);
+ − 701 assert (RECORD_TYPEP (obj, ty));
+ − 702 return obj;
+ − 703 }
+ − 704
+ − 705 #define wrap_record(ptr, ty) wrap_record_1 (ptr, lrecord_type_##ty)
+ − 706
428
+ − 707 #else /* not ERROR_CHECK_TYPECHECK */
+ − 708
+ − 709 # define DECLARE_LRECORD(c_name, structtype) \
+ − 710 extern Lisp_Object Q##c_name##p; \
442
+ − 711 extern const struct lrecord_implementation lrecord_##c_name
+ − 712 # define DECLARE_EXTERNAL_LRECORD(c_name, structtype) \
+ − 713 extern Lisp_Object Q##c_name##p; \
+ − 714 extern unsigned int lrecord_type_##c_name; \
444
+ − 715 extern struct lrecord_implementation lrecord_##c_name
428
+ − 716 # define DECLARE_NONRECORD(c_name, type_enum, structtype) \
+ − 717 extern Lisp_Object Q##c_name##p
+ − 718 # define XRECORD(x, c_name, structtype) ((structtype *) XPNTR (x))
+ − 719 # define XNONRECORD(x, c_name, type_enum, structtype) \
+ − 720 ((structtype *) XPNTR (x))
442
+ − 721 # define XSETRECORD(var, p, c_name) XSETOBJ (var, p)
617
+ − 722 /* wrap_pointer_1 is so named as a suggestion not to use it unless you
+ − 723 know what you're doing. */
+ − 724 #define wrap_record(ptr, ty) wrap_pointer_1 (ptr)
428
+ − 725
+ − 726 #endif /* not ERROR_CHECK_TYPECHECK */
+ − 727
442
+ − 728 #define RECORDP(x, c_name) RECORD_TYPEP (x, lrecord_type_##c_name)
428
+ − 729
+ − 730 /* Note: we now have two different kinds of type-checking macros.
+ − 731 The "old" kind has now been renamed CONCHECK_foo. The reason for
+ − 732 this is that the CONCHECK_foo macros signal a continuable error,
+ − 733 allowing the user (through debug-on-error) to substitute a different
+ − 734 value and return from the signal, which causes the lvalue argument
+ − 735 to get changed. Quite a lot of code would crash if that happened,
+ − 736 because it did things like
+ − 737
+ − 738 foo = XCAR (list);
+ − 739 CHECK_STRING (foo);
+ − 740
+ − 741 and later on did XSTRING (XCAR (list)), assuming that the type
+ − 742 is correct (when it might be wrong, if the user substituted a
+ − 743 correct value in the debugger).
+ − 744
+ − 745 To get around this, I made all the CHECK_foo macros signal a
+ − 746 non-continuable error. Places where a continuable error is OK
+ − 747 (generally only when called directly on the argument of a Lisp
+ − 748 primitive) should be changed to use CONCHECK().
+ − 749
+ − 750 FSF Emacs does not have this problem because RMS took the cheesy
+ − 751 way out and disabled returning from a signal entirely. */
+ − 752
+ − 753 #define CONCHECK_RECORD(x, c_name) do { \
442
+ − 754 if (!RECORD_TYPEP (x, lrecord_type_##c_name)) \
428
+ − 755 x = wrong_type_argument (Q##c_name##p, x); \
+ − 756 } while (0)
+ − 757 #define CONCHECK_NONRECORD(x, lisp_enum, predicate) do {\
+ − 758 if (XTYPE (x) != lisp_enum) \
+ − 759 x = wrong_type_argument (predicate, x); \
+ − 760 } while (0)
+ − 761 #define CHECK_RECORD(x, c_name) do { \
442
+ − 762 if (!RECORD_TYPEP (x, lrecord_type_##c_name)) \
428
+ − 763 dead_wrong_type_argument (Q##c_name##p, x); \
+ − 764 } while (0)
+ − 765 #define CHECK_NONRECORD(x, lisp_enum, predicate) do { \
+ − 766 if (XTYPE (x) != lisp_enum) \
+ − 767 dead_wrong_type_argument (predicate, x); \
+ − 768 } while (0)
+ − 769
442
+ − 770 void *alloc_lcrecord (size_t size, const struct lrecord_implementation *);
428
+ − 771
+ − 772 #define alloc_lcrecord_type(type, lrecord_implementation) \
+ − 773 ((type *) alloc_lcrecord (sizeof (type), lrecord_implementation))
+ − 774
+ − 775 /* Copy the data from one lcrecord structure into another, but don't
+ − 776 overwrite the header information. */
+ − 777
+ − 778 #define copy_lcrecord(dst, src) \
430
+ − 779 memcpy ((char *) (dst) + sizeof (struct lcrecord_header), \
+ − 780 (char *) (src) + sizeof (struct lcrecord_header), \
+ − 781 sizeof (*(dst)) - sizeof (struct lcrecord_header))
428
+ − 782
+ − 783 #define zero_lcrecord(lcr) \
430
+ − 784 memset ((char *) (lcr) + sizeof (struct lcrecord_header), 0, \
+ − 785 sizeof (*(lcr)) - sizeof (struct lcrecord_header))
428
+ − 786
440
+ − 787 #endif /* INCLUDED_lrecord_h_ */