Mercurial > hg > xemacs-beta

comparison src/lrecord.h @ 185:3d6bfa290dbd r20-3b19

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b19
author cvs
date Mon, 13 Aug 2007 09:55:28 +0200
parents ac2d302a0011
children e45d5e7c476e
comparison
equal deleted inserted replaced
184:bcd2674570bf 185:3d6bfa290dbd
64 header->implementation and "wasting" 32 bits on the below 64 header->implementation and "wasting" 32 bits on the below
65 pointer. The type-id would then be a 7 or 15 bit index into a 65 pointer. The type-id would then be a 7 or 15 bit index into a
66 table of lrecord-implementations rather than a direct pointer. 66 table of lrecord-implementations rather than a direct pointer.
67 There would be 24 (or 16) bits left over for datatype-specific 67 There would be 24 (or 16) bits left over for datatype-specific
68 per-instance flags. 68 per-instance flags.
69 69
70 The below is the simplest thing to do for the present, 70 The below is the simplest thing to do for the present,
71 and doesn't incur that much overhead as most Emacs records 71 and doesn't incur that much overhead as most Emacs records
72 are of such a size that the overhead isn't too bad. 72 are of such a size that the overhead isn't too bad.
73 (The marker datatype is the worst case.) 73 (The marker datatype is the worst case.)
74 74
75 It also has the very very very slight advantage that type-checking 75 It also has the very very very slight advantage that type-checking
76 involves one memory read (of the "implementation" slot) and a 76 involves one memory read (of the "implementation" slot) and a
77 comparison against a link-time constant address rather than a 77 comparison against a link-time constant address rather than a
78 read and a comparison against a variable value. (Variable since 78 read and a comparison against a variable value. (Variable since
79 it is a very good idea to assign the indices into the hypothetical 79 it is a very good idea to assign the indices into the hypothetical
88 { 88 {
89 struct lrecord_header lheader; 89 struct lrecord_header lheader;
90 /* The "next" field is normally used to chain all lrecords together 90 /* The "next" field is normally used to chain all lrecords together
91 so that the GC can find (and free) all of them. 91 so that the GC can find (and free) all of them.
92 "alloc_lcrecord" threads records together. 92 "alloc_lcrecord" threads records together.
93 93
94 The "next" field may be used for other purposes as long as some 94 The "next" field may be used for other purposes as long as some
95 other mechanism is provided for letting the GC do its work. (For 95 other mechanism is provided for letting the GC do its work. (For
96 example, the event and marker datatypes allocate members out of 96 example, the event and marker datatypes allocate members out of
97 memory chunks, and are able to find all unmarked members by 97 memory chunks, and are able to find all unmarked members by
98 sweeping through the elements of the list of chunks) */ 98 sweeping through the elements of the list of chunks) */
116 { 116 {
117 struct lcrecord_header lcheader; 117 struct lcrecord_header lcheader;
118 Lisp_Object chain; 118 Lisp_Object chain;
119 }; 119 };
120 120
121 /* This as the value of lheader->implementation->finalizer 121 /* This as the value of lheader->implementation->finalizer
122 * means that this record is already marked */ 122 * means that this record is already marked */
123 extern void this_marks_a_marked_record (void *, int); 123 extern void this_marks_a_marked_record (void *, int);
124 124
125 /* see alloc.c for an explanation */ 125 /* see alloc.c for an explanation */
126 extern Lisp_Object this_one_is_unmarkable (Lisp_Object obj, 126 extern Lisp_Object this_one_is_unmarkable (Lisp_Object obj,
145 /* This function is called at GC time when the object is about to 145 /* This function is called at GC time when the object is about to
146 be freed, and at dump time (FOR_DISKSAVE will be non-zero in this 146 be freed, and at dump time (FOR_DISKSAVE will be non-zero in this
147 case). It should perform any necessary cleanup (e.g. freeing 147 case). It should perform any necessary cleanup (e.g. freeing
148 malloc()ed memory. This can be NULL, meaning no special 148 malloc()ed memory. This can be NULL, meaning no special
149 finalization is necessary. 149 finalization is necessary.
150 150
151 WARNING: remember that the finalizer is called at dump time even 151 WARNING: remember that the finalizer is called at dump time even
152 though the object is not being freed. */ 152 though the object is not being freed. */
153 void (*finalizer) (void *header, int for_disksave); 153 void (*finalizer) (void *header, int for_disksave);
154 /* This can be NULL, meaning compare objects with EQ(). */ 154 /* This can be NULL, meaning compare objects with EQ(). */
155 int (*equal) (Lisp_Object obj1, Lisp_Object obj2, int depth); 155 int (*equal) (Lisp_Object obj1, Lisp_Object obj2, int depth);
257 { { name, marker, printer, nuker, equal, hash, \ 257 { { name, marker, printer, nuker, equal, hash, \
258 getprop, putprop, remprop, props, 0, sizer, \ 258 getprop, putprop, remprop, props, 0, sizer, \
259 &(lrecord_##c_name##_lrecord_type_index), 0 }, \ 259 &(lrecord_##c_name##_lrecord_type_index), 0 }, \
260 { 0, 0, 0, this_marks_a_marked_record, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 } } 260 { 0, 0, 0, this_marks_a_marked_record, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 } }
261 261
262 #define LRECORDP(a) (XTYPE ((a)) == Lisp_Record) 262 #define LRECORDP(a) (XTYPE ((a)) == Lisp_Type_Record)
263 #define XRECORD_LHEADER(a) ((struct lrecord_header *) XPNTR (a)) 263 #define XRECORD_LHEADER(a) ((struct lrecord_header *) XPNTR (a))
264 #define RECORD_TYPEP(x, ty) \ 264 #define RECORD_TYPEP(x, ty) \
265 (LRECORDP (x) && XRECORD_LHEADER (x)->implementation == (ty)) 265 (LRECORDP (x) && XRECORD_LHEADER (x)->implementation == (ty))
266 266
267 /* NOTE: the DECLARE_LRECORD() must come before the associated 267 /* NOTE: the DECLARE_LRECORD() must come before the associated
303 # define XRECORD(x, c_name, structtype) error_check_##c_name (x) 303 # define XRECORD(x, c_name, structtype) error_check_##c_name (x)
304 # define XNONRECORD(x, c_name, type_enum, structtype) error_check_##c_name (x) 304 # define XNONRECORD(x, c_name, type_enum, structtype) error_check_##c_name (x)
305 305
306 # define XSETRECORD(var, p, c_name) do \ 306 # define XSETRECORD(var, p, c_name) do \
307 { \ 307 { \
308 XSETOBJ (var, Lisp_Record, p); \ 308 XSETOBJ (var, Lisp_Type_Record, p); \
309 assert (RECORD_TYPEP (var, lrecord_##c_name) || \ 309 assert (RECORD_TYPEP (var, lrecord_##c_name) || \
310 MARKED_RECORD_P (var)); \ 310 MARKED_RECORD_P (var)); \
311 } while (0) 311 } while (0)
312 312
313 #else /* not ERROR_CHECK_TYPECHECK */ 313 #else /* not ERROR_CHECK_TYPECHECK */
319 # define DECLARE_NONRECORD(c_name, type_enum, structtype) \ 319 # define DECLARE_NONRECORD(c_name, type_enum, structtype) \
320 extern Lisp_Object Q##c_name##p 320 extern Lisp_Object Q##c_name##p
321 # define XRECORD(x, c_name, structtype) ((structtype *) XPNTR (x)) 321 # define XRECORD(x, c_name, structtype) ((structtype *) XPNTR (x))
322 # define XNONRECORD(x, c_name, type_enum, structtype) \ 322 # define XNONRECORD(x, c_name, type_enum, structtype) \
323 ((structtype *) XPNTR (x)) 323 ((structtype *) XPNTR (x))
324 # define XSETRECORD(var, p, c_name) XSETOBJ (var, Lisp_Record, p) 324 # define XSETRECORD(var, p, c_name) XSETOBJ (var, Lisp_Type_Record, p)
325 325
326 #endif /* not ERROR_CHECK_TYPECHECK */ 326 #endif /* not ERROR_CHECK_TYPECHECK */
327 327
328 #define RECORDP(x, c_name) RECORD_TYPEP (x, lrecord_##c_name) 328 #define RECORDP(x, c_name) RECORD_TYPEP (x, lrecord_##c_name)
329 #define GC_RECORDP(x, c_name) gc_record_type_p (x, lrecord_##c_name) 329 #define GC_RECORDP(x, c_name) gc_record_type_p (x, lrecord_##c_name)
330 330
331 /* Note: we now have two different kinds of type-checking macros. 331 /* Note: we now have two different kinds of type-checking macros.
332 The "old" kind has now been renamed CONCHECK_foo. The reason for 332 The "old" kind has now been renamed CONCHECK_foo. The reason for
333 this is that the CONCHECK_foo macros signal a continuable error, 333 this is that the CONCHECK_foo macros signal a continuable error,
334 allowing the user (through debug-on-error) to subsitute a different 334 allowing the user (through debug-on-error) to substitute a different
335 value and return from the signal, which causes the lvalue argument 335 value and return from the signal, which causes the lvalue argument
336 to get changed. Quite a lot of code would crash if that happened, 336 to get changed. Quite a lot of code would crash if that happened,
337 because it did things like 337 because it did things like
338 338
339 foo = XCAR (list); 339 foo = XCAR (list);
349 primitive) should be changed to use CONCHECK(). 349 primitive) should be changed to use CONCHECK().
350 350
351 FSF Emacs does not have this problem because RMS took the cheesy 351 FSF Emacs does not have this problem because RMS took the cheesy
352 way out and disabled returning from a signal entirely. */ 352 way out and disabled returning from a signal entirely. */
353 353
354 #define CONCHECK_RECORD(x, c_name) do \ 354 #define CONCHECK_RECORD(x, c_name) do { \
355 { if (!RECORD_TYPEP (x, lrecord_##c_name)) \ 355 if (!RECORD_TYPEP (x, lrecord_##c_name)) \
356 x = wrong_type_argument (Q##c_name##p, x); } \ 356 x = wrong_type_argument (Q##c_name##p, x); \
357 while (0) 357 } while (0)
358 #define CONCHECK_NONRECORD(x, lisp_enum, predicate) do \ 358 #define CONCHECK_NONRECORD(x, lisp_enum, predicate) do {\
359 { if (XTYPE (x) != lisp_enum) \ 359 if (XTYPE (x) != lisp_enum) \
360 x = wrong_type_argument (predicate, x); } \ 360 x = wrong_type_argument (predicate, x); \
361 while (0) 361 } while (0)
362 #define CHECK_RECORD(x, c_name) do \ 362 #define CHECK_RECORD(x, c_name) do { \
363 { if (!RECORD_TYPEP (x, lrecord_##c_name)) \ 363 if (!RECORD_TYPEP (x, lrecord_##c_name)) \
364 dead_wrong_type_argument (Q##c_name##p, x); } \ 364 dead_wrong_type_argument (Q##c_name##p, x); \
365 while (0) 365 } while (0)
366 #define CHECK_NONRECORD(x, lisp_enum, predicate) do \ 366 #define CHECK_NONRECORD(x, lisp_enum, predicate) do { \
367 { if (XTYPE (x) != lisp_enum) \ 367 if (XTYPE (x) != lisp_enum) \
368 dead_wrong_type_argument (predicate, x); } \ 368 dead_wrong_type_argument (predicate, x); \
369 while (0) 369 } while (0)
370 370
371 void *alloc_lcrecord (int size, CONST struct lrecord_implementation *); 371 void *alloc_lcrecord (int size, CONST struct lrecord_implementation *);
372
373 #define alloc_lcrecord_type(type, lrecord_implementation) \
374 ((type *) alloc_lcrecord (sizeof (type), lrecord_implementation))
372 375
373 int gc_record_type_p (Lisp_Object frob, 376 int gc_record_type_p (Lisp_Object frob,
374 CONST struct lrecord_implementation *type); 377 CONST struct lrecord_implementation *type);
375 378
376 /* Copy the data from one lcrecord structure into another, but don't 379 /* Copy the data from one lcrecord structure into another, but don't