Mercurial > hg > xemacs-beta

comparison src/lrecord.h @ 380:8626e4521993 r21-2-5

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-5
author cvs
date Mon, 13 Aug 2007 11:07:10 +0200
parents c5d627a313b1
children 74fd4e045ea6
comparison
equal deleted inserted replaced
379:76b7d63099ad 380:8626e4521993
48 a `next' pointer. Lcrecords have a `struct lcrecord_header' 48 a `next' pointer. Lcrecords have a `struct lcrecord_header'
49 at the top, which contains a `struct lrecord_header' and 49 at the top, which contains a `struct lrecord_header' and
50 a `next' pointer, and are allocated using alloc_lcrecord(). 50 a `next' pointer, and are allocated using alloc_lcrecord().
51 51
52 Creating a new lcrecord type is fairly easy; just follow the 52 Creating a new lcrecord type is fairly easy; just follow the
53 lead of some existing type (e.g. hashtables). Note that you 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 54 do not need to supply all the methods (see below); reasonable
55 defaults are provided for many of them. Alternatively, if you're 55 defaults are provided for many of them. Alternatively, if you're
56 just looking for a way of encapsulating data (which possibly 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 57 could contain Lisp_Objects in it), you may well be able to use
58 the opaque type. */ 58 the opaque type. */
87 * implementing the scheme described in the 'It would be better 87 * implementing the scheme described in the 'It would be better
88 * ...' paragraph above. 88 * ...' paragraph above.
89 */ 89 */
90 #ifdef USE_INDEXED_LRECORD_IMPLEMENTATION 90 #ifdef USE_INDEXED_LRECORD_IMPLEMENTATION
91 /* index into lrecord_implementations_table[] */ 91 /* index into lrecord_implementations_table[] */
92 unsigned type:8; 92 unsigned char type;
93 /* 1 if the object is marked during GC, 0 otherwise. */ 93 /* 1 if the object is marked during GC, 0 otherwise. */
94 unsigned mark:1; 94 char mark;
95 /* 1 if the object resides in pure (read-only) space */ 95 /* 1 if the object resides in pure (read-only) space */
96 unsigned pure:1; 96 char pure;
97 #else 97 #else
98 CONST struct lrecord_implementation *implementation; 98 CONST struct lrecord_implementation *implementation;
99 #endif 99 #endif
100 }; 100 };
101 101
102 struct lrecord_implementation; 102 struct lrecord_implementation;
103 int lrecord_type_index (CONST struct lrecord_implementation *implementation); 103 int lrecord_type_index (CONST struct lrecord_implementation *implementation);
104 104
105 #ifdef USE_INDEXED_LRECORD_IMPLEMENTATION 105 #ifdef USE_INDEXED_LRECORD_IMPLEMENTATION
106 # define set_lheader_implementation(header,imp) do \ 106 # define set_lheader_implementation(header,imp) do { \
107 { \ 107 struct lrecord_header* SLI_header = (header); \
108 (header)->type = lrecord_type_index (imp); \ 108 (SLI_header)->type = lrecord_type_index (imp); \
109 (header)->mark = 0; \ 109 (SLI_header)->mark = 0; \
110 (header)->pure = 0; \ 110 (SLI_header)->pure = 0; \
111 } while (0) 111 } while (0)
112 #else 112 #else
113 # define set_lheader_implementation(header,imp) \ 113 # define set_lheader_implementation(header,imp) \
114 ((void) ((header)->implementation = (imp))) 114 ((void) ((header)->implementation = (imp)))
115 #endif 115 #endif
116 116
117 struct lcrecord_header 117 struct lcrecord_header
118 { 118 {
119 struct lrecord_header lheader; 119 struct lrecord_header lheader;
120 /* The "next" field is normally used to chain all lrecords together 120
121 /* The `next' field is normally used to chain all lrecords together
121 so that the GC can find (and free) all of them. 122 so that the GC can find (and free) all of them.
122 "alloc_lcrecord" threads records together. 123 `alloc_lcrecord' threads records together.
123 124
124 The "next" field may be used for other purposes as long as some 125 The `next' field may be used for other purposes as long as some
125 other mechanism is provided for letting the GC do its work. (For 126 other mechanism is provided for letting the GC do its work.
126 example, the event and marker datatypes allocate members out of 127
127 memory chunks, and are able to find all unmarked members by 128 For example, the event and marker object types allocate members
128 sweeping through the elements of the list of chunks) */ 129 out of memory chunks, and are able to find all unmarked members
130 by sweeping through the elements of the list of chunks. */
129 struct lcrecord_header *next; 131 struct lcrecord_header *next;
130 /* This is just for debugging/printing convenience. 132
131 Having this slot doesn't hurt us much spacewise, since an lcrecord 133 /* The `uid' field is just for debugging/printing convenience.
132 already has the above slots together with malloc overhead. */ 134 Having this slot doesn't hurt us much spacewise, since an
135 lcrecord already has the above slots plus malloc overhead. */
133 unsigned int uid :31; 136 unsigned int uid :31;
134 /* A flag that indicates whether this lcrecord is on a "free list". 137
135 Free lists are used to minimize the number of calls to malloc() 138 /* The `free' field is a flag that indicates whether this lcrecord
136 when we're repeatedly allocating and freeing a number of the 139 is on a "free list". Free lists are used to minimize the number
137 same sort of lcrecord. Lcrecords on a free list always get 140 of calls to malloc() when we're repeatedly allocating and freeing
138 marked in a different fashion, so we can use this flag as a 141 a number of the same sort of lcrecord. Lcrecords on a free list
139 sanity check to make sure that free lists only have freed lcrecords 142 always get marked in a different fashion, so we can use this flag
140 and there are no freed lcrecords elsewhere. */ 143 as a sanity check to make sure that free lists only have freed
144 lcrecords and there are no freed lcrecords elsewhere. */
141 unsigned int free :1; 145 unsigned int free :1;
142 }; 146 };
143 147
144 /* Used for lcrecords in an lcrecord-list. */ 148 /* Used for lcrecords in an lcrecord-list. */
145 struct free_lcrecord_header 149 struct free_lcrecord_header
147 struct lcrecord_header lcheader; 151 struct lcrecord_header lcheader;
148 Lisp_Object chain; 152 Lisp_Object chain;
149 }; 153 };
150 154
151 /* This as the value of lheader->implementation->finalizer 155 /* This as the value of lheader->implementation->finalizer
152 * means that this record is already marked */ 156 means that this record is already marked */
153 void this_marks_a_marked_record (void *, int); 157 void this_marks_a_marked_record (void *, int);
154 158
155 /* see alloc.c for an explanation */ 159 /* see alloc.c for an explanation */
156 Lisp_Object this_one_is_unmarkable (Lisp_Object obj, 160 Lisp_Object this_one_is_unmarkable (Lisp_Object obj,
157 void (*markobj) (Lisp_Object)); 161 void (*markobj) (Lisp_Object));
230 this_marks_a_marked_record) 234 this_marks_a_marked_record)
231 #endif 235 #endif
232 236
233 #ifdef USE_INDEXED_LRECORD_IMPLEMENTATION 237 #ifdef USE_INDEXED_LRECORD_IMPLEMENTATION
234 238
235 # define MARKED_RECORD_HEADER_P(lheader) (lheader)->mark 239 # define MARKED_RECORD_HEADER_P(lheader) ((lheader)->mark)
236 # define MARK_RECORD_HEADER(lheader) (lheader)->mark = 1 240 # define MARK_RECORD_HEADER(lheader) ((void) ((lheader)->mark = 1))
237 # define UNMARK_RECORD_HEADER(lheader) (lheader)->mark = 0 241 # define UNMARK_RECORD_HEADER(lheader) ((void) ((lheader)->mark = 0))
238 242
239 #else /* ! USE_INDEXED_LRECORD_IMPLEMENTATION */ 243 #else /* ! USE_INDEXED_LRECORD_IMPLEMENTATION */
240 244
241 # define MARKED_RECORD_HEADER_P(lheader) \ 245 # define MARKED_RECORD_HEADER_P(lheader) \
242 (((lheader)->implementation->finalizer) == this_marks_a_marked_record) 246 ((lheader)->implementation->finalizer == this_marks_a_marked_record)
243 # define MARK_RECORD_HEADER(lheader) \ 247 # define MARK_RECORD_HEADER(lheader) ((void) (((lheader)->implementation)++))
244 do { (((lheader)->implementation)++); } while (0) 248 # define UNMARK_RECORD_HEADER(lheader) ((void) (((lheader)->implementation)--))
245 # define UNMARK_RECORD_HEADER(lheader) \
246 do { (((lheader)->implementation)--); } while (0)
247 249
248 #endif /* ! USE_INDEXED_LRECORD_IMPLEMENTATION */ 250 #endif /* ! USE_INDEXED_LRECORD_IMPLEMENTATION */
249 251
250 #define UNMARKABLE_RECORD_HEADER_P(lheader) \ 252 #define UNMARKABLE_RECORD_HEADER_P(lheader) \
251 ((LHEADER_IMPLEMENTATION (lheader)->marker) \ 253 (LHEADER_IMPLEMENTATION (lheader)->marker == this_one_is_unmarkable)
252 == this_one_is_unmarkable)
253 254
254 /* Declaring the following structures as const puts them in the 255 /* Declaring the following structures as const puts them in the
255 text (read-only) segment, which makes debugging inconvenient 256 text (read-only) segment, which makes debugging inconvenient
256 because this segment is not mapped when processing a core- 257 because this segment is not mapped when processing a core-
257 dump file */ 258 dump file */
323 #ifdef ERROR_CHECK_TYPECHECK 324 #ifdef ERROR_CHECK_TYPECHECK
324 325
325 # define DECLARE_LRECORD(c_name, structtype) \ 326 # define DECLARE_LRECORD(c_name, structtype) \
326 extern CONST_IF_NOT_DEBUG struct lrecord_implementation \ 327 extern CONST_IF_NOT_DEBUG struct lrecord_implementation \
327 lrecord_##c_name[]; \ 328 lrecord_##c_name[]; \
328 INLINE structtype *error_check_##c_name (Lisp_Object _obj); \ 329 INLINE structtype *error_check_##c_name (Lisp_Object obj); \
329 INLINE structtype * \ 330 INLINE structtype * \
330 error_check_##c_name (Lisp_Object _obj) \ 331 error_check_##c_name (Lisp_Object obj) \
331 { \ 332 { \
332 XUNMARK (_obj); \ 333 XUNMARK (obj); \
333 assert (RECORD_TYPEP (_obj, lrecord_##c_name) || \ 334 assert (RECORD_TYPEP (obj, lrecord_##c_name) || \
334 MARKED_RECORD_P (_obj)); \ 335 MARKED_RECORD_P (obj)); \
335 return (structtype *) XPNTR (_obj); \ 336 return (structtype *) XPNTR (obj); \
336 } \ 337 } \
337 extern Lisp_Object Q##c_name##p 338 extern Lisp_Object Q##c_name##p
338 339
339 # define DECLARE_NONRECORD(c_name, type_enum, structtype) \ 340 # define DECLARE_NONRECORD(c_name, type_enum, structtype) \
340 INLINE structtype *error_check_##c_name (Lisp_Object _obj); \ 341 INLINE structtype *error_check_##c_name (Lisp_Object obj); \
341 INLINE structtype * \ 342 INLINE structtype * \
342 error_check_##c_name (Lisp_Object _obj) \ 343 error_check_##c_name (Lisp_Object obj) \
343 { \ 344 { \
344 XUNMARK (_obj); \ 345 XUNMARK (obj); \
345 assert (XGCTYPE (_obj) == type_enum); \ 346 assert (XGCTYPE (obj) == type_enum); \
346 return (structtype *) XPNTR (_obj); \ 347 return (structtype *) XPNTR (obj); \
347 } \ 348 } \
348 extern Lisp_Object Q##c_name##p 349 extern Lisp_Object Q##c_name##p
349 350
350 # define XRECORD(x, c_name, structtype) error_check_##c_name (x) 351 # define XRECORD(x, c_name, structtype) error_check_##c_name (x)
351 # define XNONRECORD(x, c_name, type_enum, structtype) error_check_##c_name (x) 352 # define XNONRECORD(x, c_name, type_enum, structtype) error_check_##c_name (x)