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);