Mercurial > hg > xemacs-beta
comparison src/specifier.c @ 5133:444a448b2f53
Merge branch ben-lisp-object into default branch
author | Ben Wing <ben@xemacs.org> |
---|---|
date | Sun, 07 Mar 2010 06:47:37 -0600 |
parents | a9c41067dd88 |
children | f965e31a35f0 |
comparison
equal
deleted
inserted
replaced
5113:b2dcf6a6d8ab | 5133:444a448b2f53 |
---|---|
305 write_fmt_string (printcharfun, " 0x%x>", sp->header.uid); | 305 write_fmt_string (printcharfun, " 0x%x>", sp->header.uid); |
306 } | 306 } |
307 | 307 |
308 #ifndef NEW_GC | 308 #ifndef NEW_GC |
309 static void | 309 static void |
310 finalize_specifier (void *header, int for_disksave) | 310 finalize_specifier (Lisp_Object obj) |
311 { | 311 { |
312 Lisp_Specifier *sp = (Lisp_Specifier *) header; | 312 Lisp_Specifier *sp = XSPECIFIER (obj); |
313 /* don't be snafued by the disksave finalization. */ | 313 if (!GHOST_SPECIFIER_P(sp) && sp->caching) |
314 if (!for_disksave && !GHOST_SPECIFIER_P(sp) && sp->caching) | |
315 { | 314 { |
316 xfree (sp->caching); | 315 xfree (sp->caching); |
317 sp->caching = 0; | 316 sp->caching = 0; |
318 } | 317 } |
319 } | 318 } |
370 return MAX_ALIGN_SIZE (offsetof (Lisp_Specifier, data) | 369 return MAX_ALIGN_SIZE (offsetof (Lisp_Specifier, data) |
371 + specifier_type_specific_size); | 370 + specifier_type_specific_size); |
372 } | 371 } |
373 | 372 |
374 static Bytecount | 373 static Bytecount |
375 sizeof_specifier (const void *header) | 374 sizeof_specifier (Lisp_Object obj) |
376 { | 375 { |
377 const Lisp_Specifier *p = (const Lisp_Specifier *) header; | 376 const Lisp_Specifier *p = XSPECIFIER (obj); |
378 return aligned_sizeof_specifier (GHOST_SPECIFIER_P (p) | 377 return aligned_sizeof_specifier (GHOST_SPECIFIER_P (p) |
379 ? 0 | 378 ? 0 |
380 : p->methods->extra_data_size); | 379 : p->methods->extra_data_size); |
381 } | 380 } |
382 | 381 |
393 static const struct memory_description specifier_caching_description_1[] = { | 392 static const struct memory_description specifier_caching_description_1[] = { |
394 { XD_END } | 393 { XD_END } |
395 }; | 394 }; |
396 | 395 |
397 #ifdef NEW_GC | 396 #ifdef NEW_GC |
398 DEFINE_LRECORD_IMPLEMENTATION ("specifier-caching", | 397 DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("specifier-caching", specifier_caching, |
399 specifier_caching, | 398 0, specifier_caching_description_1, |
400 1, /*dumpable-flag*/ | 399 struct specifier_caching); |
401 0, 0, 0, 0, 0, | |
402 specifier_caching_description_1, | |
403 struct specifier_caching); | |
404 #else /* not NEW_GC */ | 400 #else /* not NEW_GC */ |
405 static const struct sized_memory_description specifier_caching_description = { | 401 static const struct sized_memory_description specifier_caching_description = { |
406 sizeof (struct specifier_caching), | 402 sizeof (struct specifier_caching), |
407 specifier_caching_description_1 | 403 specifier_caching_description_1 |
408 }; | 404 }; |
445 const struct sized_memory_description specifier_empty_extra_description = { | 441 const struct sized_memory_description specifier_empty_extra_description = { |
446 0, specifier_empty_extra_description_1 | 442 0, specifier_empty_extra_description_1 |
447 }; | 443 }; |
448 | 444 |
449 #ifdef NEW_GC | 445 #ifdef NEW_GC |
450 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("specifier", specifier, | 446 DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT ("specifier", specifier, |
451 1, /*dumpable-flag*/ | 447 mark_specifier, print_specifier, |
452 mark_specifier, print_specifier, | 448 0, specifier_equal, specifier_hash, |
453 0, specifier_equal, specifier_hash, | 449 specifier_description, |
454 specifier_description, | 450 sizeof_specifier, |
455 sizeof_specifier, | 451 Lisp_Specifier); |
456 Lisp_Specifier); | |
457 #else /* not NEW_GC */ | 452 #else /* not NEW_GC */ |
458 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("specifier", specifier, | 453 DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT ("specifier", specifier, |
459 1, /*dumpable-flag*/ | 454 mark_specifier, print_specifier, |
460 mark_specifier, print_specifier, | 455 finalize_specifier, |
461 finalize_specifier, | 456 specifier_equal, specifier_hash, |
462 specifier_equal, specifier_hash, | 457 specifier_description, |
463 specifier_description, | 458 sizeof_specifier, |
464 sizeof_specifier, | 459 Lisp_Specifier); |
465 Lisp_Specifier); | |
466 #endif /* not NEW_GC */ | 460 #endif /* not NEW_GC */ |
467 | 461 |
468 /************************************************************************/ | 462 /************************************************************************/ |
469 /* Creating specifiers */ | 463 /* Creating specifiers */ |
470 /************************************************************************/ | 464 /************************************************************************/ |
524 | 518 |
525 static Lisp_Object | 519 static Lisp_Object |
526 make_specifier_internal (struct specifier_methods *spec_meths, | 520 make_specifier_internal (struct specifier_methods *spec_meths, |
527 Bytecount data_size, int call_create_meth) | 521 Bytecount data_size, int call_create_meth) |
528 { | 522 { |
529 Lisp_Object specifier; | 523 Lisp_Object specifier = |
530 Lisp_Specifier *sp = (Lisp_Specifier *) | 524 ALLOC_SIZED_LISP_OBJECT (aligned_sizeof_specifier (data_size), specifier); |
531 BASIC_ALLOC_LCRECORD (aligned_sizeof_specifier (data_size), | 525 Lisp_Specifier *sp = XSPECIFIER (specifier); |
532 &lrecord_specifier); | |
533 | 526 |
534 sp->methods = spec_meths; | 527 sp->methods = spec_meths; |
535 sp->global_specs = Qnil; | 528 sp->global_specs = Qnil; |
536 sp->device_specs = Qnil; | 529 sp->device_specs = Qnil; |
537 sp->frame_specs = Qnil; | 530 sp->frame_specs = Qnil; |
540 sp->fallback = Qnil; | 533 sp->fallback = Qnil; |
541 sp->magic_parent = Qnil; | 534 sp->magic_parent = Qnil; |
542 sp->caching = 0; | 535 sp->caching = 0; |
543 sp->next_specifier = Vall_specifiers; | 536 sp->next_specifier = Vall_specifiers; |
544 | 537 |
545 specifier = wrap_specifier (sp); | |
546 Vall_specifiers = specifier; | 538 Vall_specifiers = specifier; |
547 | 539 |
548 if (call_create_meth) | 540 if (call_create_meth) |
549 { | 541 { |
550 struct gcpro gcpro1; | 542 struct gcpro gcpro1; |
3392 Lisp_Specifier *sp = XSPECIFIER (specifier); | 3384 Lisp_Specifier *sp = XSPECIFIER (specifier); |
3393 assert (!GHOST_SPECIFIER_P (sp)); | 3385 assert (!GHOST_SPECIFIER_P (sp)); |
3394 | 3386 |
3395 if (!sp->caching) | 3387 if (!sp->caching) |
3396 #ifdef NEW_GC | 3388 #ifdef NEW_GC |
3397 sp->caching = alloc_lrecord_type (struct specifier_caching, | 3389 sp->caching = XSPECIFIER_CACHING (ALLOC_NORMAL_LISP_OBJECT (specifier_caching)); |
3398 &lrecord_specifier_caching); | |
3399 #else /* not NEW_GC */ | 3390 #else /* not NEW_GC */ |
3400 sp->caching = xnew_and_zero (struct specifier_caching); | 3391 sp->caching = xnew_and_zero (struct specifier_caching); |
3401 #endif /* not NEW_GC */ | 3392 #endif /* not NEW_GC */ |
3402 sp->caching->offset_into_struct_window = struct_window_offset; | 3393 sp->caching->offset_into_struct_window = struct_window_offset; |
3403 sp->caching->value_changed_in_window = value_changed_in_window; | 3394 sp->caching->value_changed_in_window = value_changed_in_window; |
3748 /************************************************************************/ | 3739 /************************************************************************/ |
3749 | 3740 |
3750 void | 3741 void |
3751 syms_of_specifier (void) | 3742 syms_of_specifier (void) |
3752 { | 3743 { |
3753 INIT_LRECORD_IMPLEMENTATION (specifier); | 3744 INIT_LISP_OBJECT (specifier); |
3754 #ifdef NEW_GC | 3745 #ifdef NEW_GC |
3755 INIT_LRECORD_IMPLEMENTATION (specifier_caching); | 3746 INIT_LISP_OBJECT (specifier_caching); |
3756 #endif /* NEW_GC */ | 3747 #endif /* NEW_GC */ |
3757 | 3748 |
3758 DEFSYMBOL (Qspecifierp); | 3749 DEFSYMBOL (Qspecifierp); |
3759 | 3750 |
3760 DEFSYMBOL (Qconsole_type); | 3751 DEFSYMBOL (Qconsole_type); |