comparison src/specifier.h @ 398:74fd4e045ea6 r21-2-29

Import from CVS: tag r21-2-29
author cvs
date Mon, 13 Aug 2007 11:13:30 +0200
parents 8626e4521993
children 2f8bb876ab1d
comparison
equal deleted inserted replaced
397:f4aeb21a5bad 398:74fd4e045ea6
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, 19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */ 20 Boston, MA 02111-1307, USA. */
21 21
22 /* Synched up with: Not in FSF. */ 22 /* Synched up with: Not in FSF. */
23 23
24 #ifndef _XEMACS_SPECIFIER_H_ 24 #ifndef INCLUDED_specifier_h_
25 #define _XEMACS_SPECIFIER_H_ 25 #define INCLUDED_specifier_h_
26 26
27 /* 27 /*
28 MAGIC SPECIFIERS 28 MAGIC SPECIFIERS
29 ================ 29 ================
30 30
81 4. All specifiers are added to Vall_specifiers list, both bodily and 81 4. All specifiers are added to Vall_specifiers list, both bodily and
82 ghost. The pair of objects is always removed from the list at the 82 ghost. The pair of objects is always removed from the list at the
83 same time. 83 same time.
84 */ 84 */
85 85
86 extern const struct struct_description specifier_methods_description;
87
86 struct specifier_methods 88 struct specifier_methods
87 { 89 {
88 CONST char *name; 90 const char *name;
89 Lisp_Object predicate_symbol; 91 Lisp_Object predicate_symbol;
90 92
91 /* Implementation specific methods: */ 93 /* Implementation specific methods: */
92 94
93 /* Create method: Initialize specifier data. Optional. */ 95 /* Create method: Initialize specifier data. Optional. */
94 void (*create_method) (Lisp_Object specifier); 96 void (*create_method) (Lisp_Object specifier);
95 97
96 /* Mark method: Mark any lisp object within specifier data 98 /* Mark method: Mark any lisp object within specifier data
97 structure. Not required if no specifier data are Lisp_Objects. */ 99 structure. Not required if no specifier data are Lisp_Objects. */
98 void (*mark_method) (Lisp_Object specifier, void (*markobj) (Lisp_Object)); 100 void (*mark_method) (Lisp_Object specifier);
99 101
100 /* Equal method: Compare two specifiers. This is called after 102 /* Equal method: Compare two specifiers. This is called after
101 ensuring that the two specifiers are of the same type, and have 103 ensuring that the two specifiers are of the same type, and have
102 the same specs. Quit is inhibited during the call so it is safe 104 the same specs. Quit is inhibited during the call so it is safe
103 to call internal_equal(). 105 to call internal_equal().
119 valid for this specifier type. If not, signal an error. 121 valid for this specifier type. If not, signal an error.
120 122
121 If this function is not present, all instantiators are considered 123 If this function is not present, all instantiators are considered
122 valid. */ 124 valid. */
123 void (*validate_method) (Lisp_Object instantiator); 125 void (*validate_method) (Lisp_Object instantiator);
126
127
128 /* Copy method: Given an instantiator, copy the bits that we need to
129 for this specifier type.
130
131 If this function is not present, then Fcopy_tree is used. */
132 Lisp_Object (*copy_instantiator_method) (Lisp_Object instantiator);
124 133
125 /* Validate-matchspec method: Given a matchspec, verify that it's 134 /* Validate-matchspec method: Given a matchspec, verify that it's
126 valid for this specifier type. If not, signal an error. 135 valid for this specifier type. If not, signal an error.
127 136
128 If this function is not present, *no* matchspecs are considered 137 If this function is not present, *no* matchspecs are considered
183 192
184 #### Do not still know if this can safely eval. */ 193 #### Do not still know if this can safely eval. */
185 void (*after_change_method) (Lisp_Object specifier, 194 void (*after_change_method) (Lisp_Object specifier,
186 Lisp_Object locale); 195 Lisp_Object locale);
187 196
197 const struct lrecord_description *extra_description;
188 int extra_data_size; 198 int extra_data_size;
189 }; 199 };
190 200
191 struct Lisp_Specifier 201 struct Lisp_Specifier
192 { 202 {
225 Lisp_Object fallback; 235 Lisp_Object fallback;
226 236
227 /* type-specific extra data attached to a specifier */ 237 /* type-specific extra data attached to a specifier */
228 char data[1]; 238 char data[1];
229 }; 239 };
230 240 typedef struct Lisp_Specifier Lisp_Specifier;
231 DECLARE_LRECORD (specifier, struct Lisp_Specifier); 241
232 #define XSPECIFIER(x) XRECORD (x, specifier, struct Lisp_Specifier) 242 DECLARE_LRECORD (specifier, Lisp_Specifier);
243 #define XSPECIFIER(x) XRECORD (x, specifier, Lisp_Specifier)
233 #define XSETSPECIFIER(x, p) XSETRECORD (x, p, specifier) 244 #define XSETSPECIFIER(x, p) XSETRECORD (x, p, specifier)
234 #define SPECIFIERP(x) RECORDP (x, specifier) 245 #define SPECIFIERP(x) RECORDP (x, specifier)
235 #define GC_SPECIFIERP(x) GC_RECORDP (x, specifier)
236 #define CHECK_SPECIFIER(x) CHECK_RECORD (x, specifier) 246 #define CHECK_SPECIFIER(x) CHECK_RECORD (x, specifier)
237 #define CONCHECK_SPECIFIER(x) CONCHECK_RECORD (x, specifier) 247 #define CONCHECK_SPECIFIER(x) CONCHECK_RECORD (x, specifier)
238 248
239 /***** Calling a specifier method *****/ 249 /***** Calling a specifier method *****/
240 250
241 #define RAW_SPECMETH(sp, m) ((sp)->methods->m##_method) 251 #define RAW_SPECMETH(sp, m) ((sp)->methods->m##_method)
242 #define HAS_SPECMETH_P(sp, m) (!!RAW_SPECMETH (sp, m)) 252 #define HAS_SPECMETH_P(sp, m) (!!RAW_SPECMETH (sp, m))
243 #define SPECMETH(sp, m, args) (((sp)->methods->m##_method) args) 253 #define SPECMETH(sp, m, args) (((sp)->methods->m##_method) args)
244 254
245 /* Call a void-returning specifier method, if it exists. */ 255 /* Call a void-returning specifier method, if it exists. */
246 #define MAYBE_SPECMETH(sp, m, args) do { \ 256 #define MAYBE_SPECMETH(sp, m, args) do { \
247 struct Lisp_Specifier *maybe_specmeth_sp = (sp); \ 257 Lisp_Specifier *maybe_specmeth_sp = (sp); \
248 if (HAS_SPECMETH_P (maybe_specmeth_sp, m)) \ 258 if (HAS_SPECMETH_P (maybe_specmeth_sp, m)) \
249 SPECMETH (maybe_specmeth_sp, m, args); \ 259 SPECMETH (maybe_specmeth_sp, m, args); \
250 } while (0) 260 } while (0)
251 261
252 /***** Defining new specifier types *****/ 262 /***** Defining new specifier types *****/
263
264 #define specifier_data_offset (offsetof (Lisp_Specifier, data))
265 extern const struct lrecord_description specifier_empty_extra_description[];
253 266
254 #ifdef ERROR_CHECK_TYPECHECK 267 #ifdef ERROR_CHECK_TYPECHECK
255 #define DECLARE_SPECIFIER_TYPE(type) \ 268 #define DECLARE_SPECIFIER_TYPE(type) \
256 extern struct specifier_methods * type##_specifier_methods; \ 269 extern struct specifier_methods * type##_specifier_methods; \
257 INLINE struct type##_specifier * \ 270 INLINE struct type##_specifier * \
258 error_check_##type##_specifier_data (struct Lisp_Specifier *sp); \ 271 error_check_##type##_specifier_data (Lisp_Specifier *sp); \
259 INLINE struct type##_specifier * \ 272 INLINE struct type##_specifier * \
260 error_check_##type##_specifier_data (struct Lisp_Specifier *sp) \ 273 error_check_##type##_specifier_data (Lisp_Specifier *sp) \
261 { \ 274 { \
262 if (SPECIFIERP (sp->magic_parent)) \ 275 if (SPECIFIERP (sp->magic_parent)) \
263 { \ 276 { \
264 assert (SPECIFIER_TYPE_P (sp, type)); \ 277 assert (SPECIFIER_TYPE_P (sp, type)); \
265 sp = XSPECIFIER (sp->magic_parent); \ 278 sp = XSPECIFIER (sp->magic_parent); \
267 else \ 280 else \
268 assert (NILP (sp->magic_parent) || EQ (sp->magic_parent, Qt)); \ 281 assert (NILP (sp->magic_parent) || EQ (sp->magic_parent, Qt)); \
269 assert (SPECIFIER_TYPE_P (sp, type)); \ 282 assert (SPECIFIER_TYPE_P (sp, type)); \
270 return (struct type##_specifier *) sp->data; \ 283 return (struct type##_specifier *) sp->data; \
271 } \ 284 } \
285 INLINE Lisp_Specifier * \
286 error_check_##type##_specifier_type (Lisp_Object obj); \
287 INLINE Lisp_Specifier * \
288 error_check_##type##_specifier_type (Lisp_Object obj) \
289 { \
290 Lisp_Specifier *sp = XSPECIFIER (obj); \
291 assert (SPECIFIER_TYPE_P (sp, type)); \
292 return sp; \
293 } \
272 DECLARE_NOTHING 294 DECLARE_NOTHING
273 #else 295 #else
274 #define DECLARE_SPECIFIER_TYPE(type) \ 296 #define DECLARE_SPECIFIER_TYPE(type) \
275 extern struct specifier_methods * type##_specifier_methods 297 extern struct specifier_methods * type##_specifier_methods
276 #endif /* ERROR_CHECK_TYPECHECK */ 298 #endif /* ERROR_CHECK_TYPECHECK */
277 299
278 #define DEFINE_SPECIFIER_TYPE(type) \ 300 #define DEFINE_SPECIFIER_TYPE(type) \
279 struct specifier_methods * type##_specifier_methods 301 struct specifier_methods * type##_specifier_methods
280 302
281 #define INITIALIZE_SPECIFIER_TYPE(type, obj_name, pred_sym) do { \ 303 #define INITIALIZE_SPECIFIER_TYPE(type, obj_name, pred_sym) do { \
282 type##_specifier_methods = xnew_and_zero (struct specifier_methods); \ 304 type##_specifier_methods = xnew_and_zero (struct specifier_methods); \
283 type##_specifier_methods->name = obj_name; \ 305 type##_specifier_methods->name = obj_name; \
284 defsymbol (&type##_specifier_methods->predicate_symbol, pred_sym); \ 306 type##_specifier_methods->extra_description = \
285 add_entry_to_specifier_type_list (Q##type, type##_specifier_methods); \ 307 specifier_empty_extra_description; \
308 defsymbol_nodump (&type##_specifier_methods->predicate_symbol, pred_sym); \
309 add_entry_to_specifier_type_list (Q##type, type##_specifier_methods); \
310 dumpstruct (&type##_specifier_methods, &specifier_methods_description); \
311 } while (0)
312
313 #define REINITIALIZE_SPECIFIER_TYPE(type) do { \
314 staticpro_nodump (&type##_specifier_methods->predicate_symbol); \
286 } while (0) 315 } while (0)
287 316
288 #define INITIALIZE_SPECIFIER_TYPE_WITH_DATA(type, obj_name, pred_sym) \ 317 #define INITIALIZE_SPECIFIER_TYPE_WITH_DATA(type, obj_name, pred_sym) \
289 do { \ 318 do { \
290 INITIALIZE_SPECIFIER_TYPE (type, obj_name, pred_sym); \ 319 INITIALIZE_SPECIFIER_TYPE (type, obj_name, pred_sym); \
291 type##_specifier_methods->extra_data_size = \ 320 type##_specifier_methods->extra_data_size = \
292 sizeof (struct type##_specifier); \ 321 sizeof (struct type##_specifier); \
322 type##_specifier_methods->extra_description = \
323 type##_specifier_description; \
293 } while (0) 324 } while (0)
294 325
295 /* Declare that specifier-type TYPE has method METH; used in 326 /* Declare that specifier-type TYPE has method METH; used in
296 initialization routines */ 327 initialization routines */
297 #define SPECIFIER_HAS_METHOD(type, meth) \ 328 #define SPECIFIER_HAS_METHOD(type, meth) \
301 332
302 #define SPECIFIER_TYPE_P(sp, type) \ 333 #define SPECIFIER_TYPE_P(sp, type) \
303 ((sp)->methods == type##_specifier_methods) 334 ((sp)->methods == type##_specifier_methods)
304 335
305 /* Any of the two of the magic spec */ 336 /* Any of the two of the magic spec */
306 #define MAGIC_SPECIFIER_P(sp) \ 337 #define MAGIC_SPECIFIER_P(sp) (!NILP((sp)->magic_parent))
307 (!NILP((sp)->magic_parent))
308 /* Normal part of the magic specifier */ 338 /* Normal part of the magic specifier */
309 #define BODILY_SPECIFIER_P(sp) \ 339 #define BODILY_SPECIFIER_P(sp) EQ ((sp)->magic_parent, Qt)
310 (EQ ((sp)->magic_parent, Qt))
311 /* Ghost part of the magic specifier */ 340 /* Ghost part of the magic specifier */
312 #define GHOST_SPECIFIER_P(sp) \ 341 #define GHOST_SPECIFIER_P(sp) SPECIFIERP((sp)->magic_parent)
313 (SPECIFIERP((sp)->magic_parent)) 342
314 /* The same three, when used in GC */ 343 #define GHOST_SPECIFIER(sp) XSPECIFIER ((sp)->fallback)
315 #define GC_MAGIC_SPECIFIER_P(sp) \
316 (!GC_NILP((sp)->magic_parent))
317 #define GC_BODILY_SPECIFIER_P(sp) \
318 (GC_EQ ((sp)->magic_parent, Qt))
319 #define GC_GHOST_SPECIFIER_P(sp) \
320 (GC_SPECIFIERP((sp)->magic_parent))
321
322 #define GHOST_SPECIFIER(sp) \
323 (XSPECIFIER ((sp)->fallback))
324 344
325 #ifdef ERROR_CHECK_TYPECHECK 345 #ifdef ERROR_CHECK_TYPECHECK
326 # define SPECIFIER_TYPE_DATA(sp, type) \ 346 # define SPECIFIER_TYPE_DATA(sp, type) \
327 error_check_##type##_specifier_data (sp) 347 error_check_##type##_specifier_data (sp)
328 #else 348 #else
331 (GHOST_SPECIFIER_P(sp) \ 351 (GHOST_SPECIFIER_P(sp) \
332 ? XSPECIFIER((sp)->magic_parent)->data \ 352 ? XSPECIFIER((sp)->magic_parent)->data \
333 : (sp)->data)) 353 : (sp)->data))
334 #endif 354 #endif
335 355
336 /* #### Need to create ERROR_CHECKING versions of these. */ 356 #ifdef ERROR_CHECK_TYPECHECK
337 357 # define XSPECIFIER_TYPE(x, type) \
338 #define XSPECIFIER_TYPE(x, type) XSPECIFIER (x) 358 error_check_##type##_specifier_type (x)
339 #define XSETSPECIFIER_TYPE(x, p, type) XSETSPECIFIER (x, p) 359 # define XSETSPECIFIER_TYPE(x, p, type) do \
360 { \
361 XSETSPECIFIER (x, p); \
362 assert (SPECIFIER_TYPEP (XSPECIFIER(x), type)); \
363 } while (0)
364 #else
365 # define XSPECIFIER_TYPE(x, type) XSPECIFIER (x)
366 # define XSETSPECIFIER_TYPE(x, p, type) XSETSPECIFIER (x, p)
367 #endif /* ERROR_CHECK_TYPE_CHECK */
368
340 #define SPECIFIER_TYPEP(x, type) \ 369 #define SPECIFIER_TYPEP(x, type) \
341 (SPECIFIERP (x) && SPECIFIER_TYPE_P (XSPECIFIER (x), type)) 370 (SPECIFIERP (x) && SPECIFIER_TYPE_P (XSPECIFIER (x), type))
342 #define CHECK_SPECIFIER_TYPE(x, type) do { \ 371 #define CHECK_SPECIFIER_TYPE(x, type) do { \
343 CHECK_SPECIFIER (x); \ 372 CHECK_SPECIFIER (x); \
344 if (!SPECIFIER_TYPE_P (XSPECIFIER (x), type)) \ 373 if (!SPECIFIER_TYPE_P (XSPECIFIER (x), type)) \
423 Lisp_Object tag_set, Lisp_Object exact_p); 452 Lisp_Object tag_set, Lisp_Object exact_p);
424 453
425 int unlock_ghost_specifiers_protected (void); 454 int unlock_ghost_specifiers_protected (void);
426 455
427 void cleanup_specifiers (void); 456 void cleanup_specifiers (void);
428 void prune_specifiers (int (*obj_marked_p) (Lisp_Object)); 457 void prune_specifiers (void);
429 void setup_device_initial_specifier_tags (struct device *d); 458 void setup_device_initial_specifier_tags (struct device *d);
430 void kill_specifier_buffer_locals (Lisp_Object buffer); 459 void kill_specifier_buffer_locals (Lisp_Object buffer);
431 460
432 DECLARE_SPECIFIER_TYPE (generic); 461 DECLARE_SPECIFIER_TYPE (generic);
433 #define XGENERIC_SPECIFIER(x) XSPECIFIER_TYPE (x, generic) 462 #define XGENERIC_SPECIFIER(x) XSPECIFIER_TYPE (x, generic)
462 #define XSETDISPLAYTABLE_SPECIFIER(x, p) XSETSPECIFIER_TYPE (x, p, display_table) 491 #define XSETDISPLAYTABLE_SPECIFIER(x, p) XSETSPECIFIER_TYPE (x, p, display_table)
463 #define DISPLAYTABLE_SPECIFIERP(x) SPECIFIER_TYPEP (x, display_table) 492 #define DISPLAYTABLE_SPECIFIERP(x) SPECIFIER_TYPEP (x, display_table)
464 #define CHECK_DISPLAYTABLE_SPECIFIER(x) CHECK_SPECIFIER_TYPE (x, display_table) 493 #define CHECK_DISPLAYTABLE_SPECIFIER(x) CHECK_SPECIFIER_TYPE (x, display_table)
465 #define CONCHECK_DISPLAYTABLE_SPECIFIER(x) CONCHECK_SPECIFIER_TYPE (x, display_table) 494 #define CONCHECK_DISPLAYTABLE_SPECIFIER(x) CONCHECK_SPECIFIER_TYPE (x, display_table)
466 495
467 #endif /* _XEMACS_SPECIFIER_H_ */ 496 #endif /* INCLUDED_specifier_h_ */