Mercurial > hg > xemacs-beta

comparison src/alloc.c @ 400:a86b2b5e0111 r21-2-30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-30
author cvs
date Mon, 13 Aug 2007 11:14:34 +0200
parents 74fd4e045ea6
children 2f8bb876ab1d
comparison
equal deleted inserted replaced
399:376370fb5946 400:a86b2b5e0111
381 void * 381 void *
382 alloc_lcrecord (size_t size, const struct lrecord_implementation *implementation) 382 alloc_lcrecord (size_t size, const struct lrecord_implementation *implementation)
383 { 383 {
384 struct lcrecord_header *lcheader; 384 struct lcrecord_header *lcheader;
385 385
386 #ifdef ERROR_CHECK_TYPECHECK 386 type_checking_assert
387 if (implementation->static_size == 0) 387 ((implementation->static_size == 0 ?
388 assert (implementation->size_in_bytes_method); 388 implementation->size_in_bytes_method != NULL :
389 else 389 implementation->static_size == size)
390 assert (implementation->static_size == size); 390 &&
391 391 (! implementation->basic_p)
392 assert (! implementation->basic_p); 392 &&
393 393 (! (implementation->hash == NULL && implementation->equal != NULL)));
394 if (implementation->hash == NULL)
395 assert (implementation->equal == NULL);
396 #endif
397 394
398 lcheader = (struct lcrecord_header *) allocate_lisp_storage (size); 395 lcheader = (struct lcrecord_header *) allocate_lisp_storage (size);
399 set_lheader_implementation (&(lcheader->lheader), implementation); 396 set_lheader_implementation (&(lcheader->lheader), implementation);
400 lcheader->next = all_lcrecords; 397 lcheader->next = all_lcrecords;
401 #if 1 /* mly prefers to see small ID numbers */ 398 #if 1 /* mly prefers to see small ID numbers */
453 { 450 {
454 struct lcrecord_header *header; 451 struct lcrecord_header *header;
455 452
456 for (header = all_lcrecords; header; header = header->next) 453 for (header = all_lcrecords; header; header = header->next)
457 { 454 {
458 if (LHEADER_IMPLEMENTATION(&header->lheader)->finalizer && 455 if (LHEADER_IMPLEMENTATION (&header->lheader)->finalizer &&
459 !header->free) 456 !header->free)
460 ((LHEADER_IMPLEMENTATION(&header->lheader)->finalizer) 457 LHEADER_IMPLEMENTATION (&header->lheader)->finalizer (header, 1);
461 (header, 1)); 458 }
462 }
463 }
464
465 /* Semi-kludge -- lrecord_symbol_value_forward objects get stuck
466 in const space and you get SEGV's if you attempt to mark them.
467 This sits in lheader->implementation->marker. */
468
469 Lisp_Object
470 this_one_is_unmarkable (Lisp_Object obj)
471 {
472 abort ();
473 return Qnil;
474 } 459 }
475 460
476 461
477 /************************************************************************/ 462 /************************************************************************/
478 /* Debugger support */ 463 /* Debugger support */
487 472
488 #ifdef USE_UNION_TYPE 473 #ifdef USE_UNION_TYPE
489 unsigned char dbg_USE_UNION_TYPE = 1; 474 unsigned char dbg_USE_UNION_TYPE = 1;
490 #else 475 #else
491 unsigned char dbg_USE_UNION_TYPE = 0; 476 unsigned char dbg_USE_UNION_TYPE = 0;
492 #endif
493
494 unsigned char Lisp_Type_Int = 100;
495 unsigned char Lisp_Type_Cons = 101;
496 unsigned char Lisp_Type_String = 102;
497 unsigned char Lisp_Type_Vector = 103;
498 unsigned char Lisp_Type_Symbol = 104;
499
500 #ifndef MULE
501 unsigned char lrecord_char_table_entry;
502 unsigned char lrecord_charset;
503 #ifndef FILE_CODING
504 unsigned char lrecord_coding_system;
505 #endif
506 #endif
507
508 #if !((defined HAVE_X_WINDOWS) && \
509 (defined (HAVE_MENUBARS) || \
510 defined (HAVE_SCROLLBARS) || \
511 defined (HAVE_DIALOGS) || \
512 defined (HAVE_TOOLBARS) || \
513 defined (HAVE_WIDGETS)))
514 unsigned char lrecord_popup_data;
515 #endif
516
517 #ifndef HAVE_TOOLBARS
518 unsigned char lrecord_toolbar_button;
519 #endif
520
521 #ifndef TOOLTALK
522 unsigned char lrecord_tooltalk_message;
523 unsigned char lrecord_tooltalk_pattern;
524 #endif
525
526 #ifndef HAVE_DATABASE
527 unsigned char lrecord_database;
528 #endif 477 #endif
529 478
530 unsigned char dbg_valbits = VALBITS; 479 unsigned char dbg_valbits = VALBITS;
531 unsigned char dbg_gctypebits = GCTYPEBITS; 480 unsigned char dbg_gctypebits = GCTYPEBITS;
532 481
2270 { 2219 {
2271 struct lrecord_header *lheader = XRECORD_LHEADER (chain); 2220 struct lrecord_header *lheader = XRECORD_LHEADER (chain);
2272 struct free_lcrecord_header *free_header = 2221 struct free_lcrecord_header *free_header =
2273 (struct free_lcrecord_header *) lheader; 2222 (struct free_lcrecord_header *) lheader;
2274 2223
2275 #ifdef ERROR_CHECK_GC 2224 gc_checking_assert
2276 const struct lrecord_implementation *implementation 2225 (/* There should be no other pointers to the free list. */
2277 = LHEADER_IMPLEMENTATION(lheader); 2226 ! MARKED_RECORD_HEADER_P (lheader)
2278 2227 &&
2279 /* There should be no other pointers to the free list. */ 2228 /* Only lcrecords should be here. */
2280 assert (!MARKED_RECORD_HEADER_P (lheader)); 2229 ! LHEADER_IMPLEMENTATION (lheader)->basic_p
2281 /* Only lcrecords should be here. */ 2230 &&
2282 assert (!implementation->basic_p); 2231 /* Only free lcrecords should be here. */
2283 /* Only free lcrecords should be here. */ 2232 free_header->lcheader.free
2284 assert (free_header->lcheader.free); 2233 &&
2285 /* The type of the lcrecord must be right. */ 2234 /* The type of the lcrecord must be right. */
2286 assert (implementation == list->implementation); 2235 LHEADER_IMPLEMENTATION (lheader) == list->implementation
2287 /* So must the size. */ 2236 &&
2288 assert (implementation->static_size == 0 2237 /* So must the size. */
2289 || implementation->static_size == list->size); 2238 (LHEADER_IMPLEMENTATION (lheader)->static_size == 0 ||
2290 #endif /* ERROR_CHECK_GC */ 2239 LHEADER_IMPLEMENTATION (lheader)->static_size == list->size)
2240 );
2291 2241
2292 MARK_RECORD_HEADER (lheader); 2242 MARK_RECORD_HEADER (lheader);
2293 chain = free_header->chain; 2243 chain = free_header->chain;
2294 } 2244 }
2295 2245
2323 Lisp_Object val = list->free; 2273 Lisp_Object val = list->free;
2324 struct free_lcrecord_header *free_header = 2274 struct free_lcrecord_header *free_header =
2325 (struct free_lcrecord_header *) XPNTR (val); 2275 (struct free_lcrecord_header *) XPNTR (val);
2326 2276
2327 #ifdef ERROR_CHECK_GC 2277 #ifdef ERROR_CHECK_GC
2328 struct lrecord_header *lheader = 2278 struct lrecord_header *lheader = &free_header->lcheader.lheader;
2329 (struct lrecord_header *) free_header;
2330 const struct lrecord_implementation *implementation
2331 = LHEADER_IMPLEMENTATION (lheader);
2332 2279
2333 /* There should be no other pointers to the free list. */ 2280 /* There should be no other pointers to the free list. */
2334 assert (!MARKED_RECORD_HEADER_P (lheader)); 2281 assert (! MARKED_RECORD_HEADER_P (lheader));
2335 /* Only lcrecords should be here. */ 2282 /* Only lcrecords should be here. */
2336 assert (!implementation->basic_p); 2283 assert (! LHEADER_IMPLEMENTATION (lheader)->basic_p);
2337 /* Only free lcrecords should be here. */ 2284 /* Only free lcrecords should be here. */
2338 assert (free_header->lcheader.free); 2285 assert (free_header->lcheader.free);
2339 /* The type of the lcrecord must be right. */ 2286 /* The type of the lcrecord must be right. */
2340 assert (implementation == list->implementation); 2287 assert (LHEADER_IMPLEMENTATION (lheader) == list->implementation);
2341 /* So must the size. */ 2288 /* So must the size. */
2342 assert (implementation->static_size == 0 2289 assert (LHEADER_IMPLEMENTATION (lheader)->static_size == 0 ||
2343 || implementation->static_size == list->size); 2290 LHEADER_IMPLEMENTATION (lheader)->static_size == list->size);
2344 #endif /* ERROR_CHECK_GC */ 2291 #endif /* ERROR_CHECK_GC */
2292
2345 list->free = free_header->chain; 2293 list->free = free_header->chain;
2346 free_header->lcheader.free = 0; 2294 free_header->lcheader.free = 0;
2347 return val; 2295 return val;
2348 } 2296 }
2349 else 2297 else
2360 free_managed_lcrecord (Lisp_Object lcrecord_list, Lisp_Object lcrecord) 2308 free_managed_lcrecord (Lisp_Object lcrecord_list, Lisp_Object lcrecord)
2361 { 2309 {
2362 struct lcrecord_list *list = XLCRECORD_LIST (lcrecord_list); 2310 struct lcrecord_list *list = XLCRECORD_LIST (lcrecord_list);
2363 struct free_lcrecord_header *free_header = 2311 struct free_lcrecord_header *free_header =
2364 (struct free_lcrecord_header *) XPNTR (lcrecord); 2312 (struct free_lcrecord_header *) XPNTR (lcrecord);
2365 struct lrecord_header *lheader = 2313 struct lrecord_header *lheader = &free_header->lcheader.lheader;
2366 (struct lrecord_header *) free_header;
2367 const struct lrecord_implementation *implementation 2314 const struct lrecord_implementation *implementation
2368 = LHEADER_IMPLEMENTATION (lheader); 2315 = LHEADER_IMPLEMENTATION (lheader);
2369 2316
2370 #ifdef ERROR_CHECK_GC
2371 /* Make sure the size is correct. This will catch, for example, 2317 /* Make sure the size is correct. This will catch, for example,
2372 putting a window configuration on the wrong free list. */ 2318 putting a window configuration on the wrong free list. */
2373 if (implementation->size_in_bytes_method) 2319 gc_checking_assert ((implementation->size_in_bytes_method ?
2374 assert (implementation->size_in_bytes_method (lheader) == list->size); 2320 implementation->size_in_bytes_method (lheader) :
2375 else 2321 implementation->static_size)
2376 assert (implementation->static_size == list->size); 2322 == list->size);
2377 #endif /* ERROR_CHECK_GC */
2378 2323
2379 if (implementation->finalizer) 2324 if (implementation->finalizer)
2380 implementation->finalizer (lheader, 0); 2325 implementation->finalizer (lheader, 0);
2381 free_header->chain = list->free; 2326 free_header->chain = list->free;
2382 free_header->lcheader.free = 1; 2327 free_header->lcheader.free = 1;
2396 (obj)) 2341 (obj))
2397 { 2342 {
2398 return obj; 2343 return obj;
2399 } 2344 }
2400 2345
2401
2402 2346
2403 /************************************************************************/ 2347 /************************************************************************/
2404 /* Garbage Collection */ 2348 /* Garbage Collection */
2405 /************************************************************************/ 2349 /************************************************************************/
2406 2350
2407 /* This will be used more extensively In The Future */ 2351 /* This will be used more extensively In The Future */
2408 static int last_lrecord_type_index_assigned; 2352 static int last_lrecord_type_index_assigned;
2409 2353
2410 const struct lrecord_implementation *lrecord_implementations_table[128]; 2354 /* All the built-in lisp object types are enumerated in `enum lrecord_type'.
2411 #define max_lrecord_type (countof (lrecord_implementations_table) - 1) 2355 Additional ones may be defined by a module (none yet). We leave some
2356 room in `lrecord_implementations_table' for such new lisp object types. */
2357 #define MODULE_DEFINABLE_TYPE_COUNT 32
2358 const struct lrecord_implementation *lrecord_implementations_table[lrecord_type_count + MODULE_DEFINABLE_TYPE_COUNT];
2359
2360 /* Object marker functions are in the lrecord_implementation structure.
2361 But copying them to a parallel array is much more cache-friendly.
2362 This hack speeds up (garbage-collect) by about 5%. */
2363 Lisp_Object (*lrecord_markers[countof (lrecord_implementations_table)]) (Lisp_Object);
2412 2364
2413 struct gcpro *gcprolist; 2365 struct gcpro *gcprolist;
2414 2366
2415 /* 415 used Mly 29-Jun-93 */ 2367 /* 415 used Mly 29-Jun-93 */
2416 /* 1327 used slb 28-Feb-98 */ 2368 /* 1327 used slb 28-Feb-98 */
2523 if (pdump_wireidx_list >= countof (pdump_wirevec_list)) 2475 if (pdump_wireidx_list >= countof (pdump_wirevec_list))
2524 abort (); 2476 abort ();
2525 pdump_wirevec_list[pdump_wireidx_list++] = varaddress; 2477 pdump_wirevec_list[pdump_wireidx_list++] = varaddress;
2526 } 2478 }
2527 2479
2480 #ifdef ERROR_CHECK_GC
2481 #define GC_CHECK_LHEADER_INVARIANTS(lheader) do { \
2482 struct lrecord_header * GCLI_lh = (lheader); \
2483 assert (GCLI_lh != 0); \
2484 assert (GCLI_lh->type <= last_lrecord_type_index_assigned); \
2485 assert (! C_READONLY_RECORD_HEADER_P (GCLI_lh) || \
2486 (MARKED_RECORD_HEADER_P (GCLI_lh) && \
2487 LISP_READONLY_RECORD_HEADER_P (GCLI_lh))); \
2488 } while (0)
2489 #else
2490 #define GC_CHECK_LHEADER_INVARIANTS(lheader)
2491 #endif
2492
2528 2493
2529 /* Mark reference to a Lisp_Object. If the object referred to has not been 2494 /* Mark reference to a Lisp_Object. If the object referred to has not been
2530 seen yet, recursively mark all the references contained in it. */ 2495 seen yet, recursively mark all the references contained in it. */
2531 2496
2532 void 2497 void
2533 mark_object (Lisp_Object obj) 2498 mark_object (Lisp_Object obj)
2534 { 2499 {
2535 tail_recurse: 2500 tail_recurse:
2536 2501
2537 #ifdef ERROR_CHECK_GC
2538 assert (! (EQ (obj, Qnull_pointer)));
2539 #endif
2540 /* Checks we used to perform */ 2502 /* Checks we used to perform */
2541 /* if (EQ (obj, Qnull_pointer)) return; */ 2503 /* if (EQ (obj, Qnull_pointer)) return; */
2542 /* if (!POINTER_TYPE_P (XGCTYPE (obj))) return; */ 2504 /* if (!POINTER_TYPE_P (XGCTYPE (obj))) return; */
2543 /* if (PURIFIED (XPNTR (obj))) return; */ 2505 /* if (PURIFIED (XPNTR (obj))) return; */
2544 2506
2545 if (XTYPE (obj) == Lisp_Type_Record) 2507 if (XTYPE (obj) == Lisp_Type_Record)
2546 { 2508 {
2547 struct lrecord_header *lheader = XRECORD_LHEADER (obj); 2509 struct lrecord_header *lheader = XRECORD_LHEADER (obj);
2548 #if defined (ERROR_CHECK_GC) 2510
2549 assert (lheader->type <= last_lrecord_type_index_assigned); 2511 GC_CHECK_LHEADER_INVARIANTS (lheader);
2550 #endif 2512
2551 if (C_READONLY_RECORD_HEADER_P (lheader)) 2513 gc_checking_assert (LHEADER_IMPLEMENTATION (lheader)->basic_p ||
2552 return; 2514 ! ((struct lcrecord_header *) lheader)->free);
2553 2515
2554 if (! MARKED_RECORD_HEADER_P (lheader) && 2516 /* All c_readonly objects have their mark bit set,
2555 ! UNMARKABLE_RECORD_HEADER_P (lheader)) 2517 so that we only need to check the mark bit here. */
2518 if (! MARKED_RECORD_HEADER_P (lheader))
2556 { 2519 {
2557 const struct lrecord_implementation *implementation =
2558 LHEADER_IMPLEMENTATION (lheader);
2559 MARK_RECORD_HEADER (lheader); 2520 MARK_RECORD_HEADER (lheader);
2560 #ifdef ERROR_CHECK_GC 2521
2561 if (!implementation->basic_p) 2522 if (RECORD_MARKER (lheader))
2562 assert (! ((struct lcrecord_header *) lheader)->free);
2563 #endif
2564 if (implementation->marker)
2565 { 2523 {
2566 obj = implementation->marker (obj); 2524 obj = RECORD_MARKER (lheader) (obj);
2567 if (!NILP (obj)) goto tail_recurse; 2525 if (!NILP (obj)) goto tail_recurse;
2568 } 2526 }
2569 } 2527 }
2570 } 2528 }
2571 } 2529 }
2601 static int gc_count_short_string_total_size; 2559 static int gc_count_short_string_total_size;
2602 2560
2603 /* static int gc_count_total_records_used, gc_count_records_total_size; */ 2561 /* static int gc_count_total_records_used, gc_count_records_total_size; */
2604 2562
2605 2563
2606 int
2607 lrecord_type_index (const struct lrecord_implementation *implementation)
2608 {
2609 int type_index = *(implementation->lrecord_type_index);
2610 /* Have to do this circuitous validation test because of problems
2611 dumping out initialized variables (ie can't set xxx_type_index to -1
2612 because that would make xxx_type_index read-only in a dumped emacs. */
2613 if (type_index < 0 || type_index > max_lrecord_type
2614 || lrecord_implementations_table[type_index] != implementation)
2615 {
2616 assert (last_lrecord_type_index_assigned < max_lrecord_type);
2617 type_index = ++last_lrecord_type_index_assigned;
2618 lrecord_implementations_table[type_index] = implementation;
2619 *(implementation->lrecord_type_index) = type_index;
2620 }
2621 return type_index;
2622 }
2623
2624 /* stats on lcrecords in use - kinda kludgy */ 2564 /* stats on lcrecords in use - kinda kludgy */
2625 2565
2626 static struct 2566 static struct
2627 { 2567 {
2628 int instances_in_use; 2568 int instances_in_use;
2633 } lcrecord_stats [countof (lrecord_implementations_table)]; 2573 } lcrecord_stats [countof (lrecord_implementations_table)];
2634 2574
2635 static void 2575 static void
2636 tick_lcrecord_stats (const struct lrecord_header *h, int free_p) 2576 tick_lcrecord_stats (const struct lrecord_header *h, int free_p)
2637 { 2577 {
2638 const struct lrecord_implementation *implementation = 2578 unsigned int type_index = h->type;
2639 LHEADER_IMPLEMENTATION (h);
2640 int type_index = lrecord_type_index (implementation);
2641 2579
2642 if (((struct lcrecord_header *) h)->free) 2580 if (((struct lcrecord_header *) h)->free)
2643 { 2581 {
2644 assert (!free_p); 2582 gc_checking_assert (!free_p);
2645 lcrecord_stats[type_index].instances_on_free_list++; 2583 lcrecord_stats[type_index].instances_on_free_list++;
2646 } 2584 }
2647 else 2585 else
2648 { 2586 {
2649 size_t sz = (implementation->size_in_bytes_method 2587 const struct lrecord_implementation *implementation =
2650 ? implementation->size_in_bytes_method (h) 2588 LHEADER_IMPLEMENTATION (h);
2651 : implementation->static_size); 2589
2652 2590 size_t sz = (implementation->size_in_bytes_method ?
2591 implementation->size_in_bytes_method (h) :
2592 implementation->static_size);
2653 if (free_p) 2593 if (free_p)
2654 { 2594 {
2655 lcrecord_stats[type_index].instances_freed++; 2595 lcrecord_stats[type_index].instances_freed++;
2656 lcrecord_stats[type_index].bytes_freed += sz; 2596 lcrecord_stats[type_index].bytes_freed += sz;
2657 } 2597 }
2685 other object. */ 2625 other object. */
2686 2626
2687 for (header = *prev; header; header = header->next) 2627 for (header = *prev; header; header = header->next)
2688 { 2628 {
2689 struct lrecord_header *h = &(header->lheader); 2629 struct lrecord_header *h = &(header->lheader);
2690 if (!C_READONLY_RECORD_HEADER_P(h) 2630
2691 && !MARKED_RECORD_HEADER_P (h) 2631 GC_CHECK_LHEADER_INVARIANTS (h);
2692 && ! (header->free)) 2632
2633 if (! MARKED_RECORD_HEADER_P (h) && ! header->free)
2693 { 2634 {
2694 if (LHEADER_IMPLEMENTATION (h)->finalizer) 2635 if (LHEADER_IMPLEMENTATION (h)->finalizer)
2695 LHEADER_IMPLEMENTATION (h)->finalizer (h, 0); 2636 LHEADER_IMPLEMENTATION (h)->finalizer (h, 0);
2696 } 2637 }
2697 } 2638 }
2698 2639
2699 for (header = *prev; header; ) 2640 for (header = *prev; header; )
2700 { 2641 {
2701 struct lrecord_header *h = &(header->lheader); 2642 struct lrecord_header *h = &(header->lheader);
2702 if (C_READONLY_RECORD_HEADER_P(h) || MARKED_RECORD_HEADER_P (h)) 2643 if (MARKED_RECORD_HEADER_P (h))
2703 { 2644 {
2704 if (MARKED_RECORD_HEADER_P (h)) 2645 if (! C_READONLY_RECORD_HEADER_P (h))
2705 UNMARK_RECORD_HEADER (h); 2646 UNMARK_RECORD_HEADER (h);
2706 num_used++; 2647 num_used++;
2707 /* total_size += n->implementation->size_in_bytes (h);*/ 2648 /* total_size += n->implementation->size_in_bytes (h);*/
2708 /* #### May modify header->next on a C_READONLY lcrecord */ 2649 /* #### May modify header->next on a C_READONLY lcrecord */
2709 prev = &(header->next); 2650 prev = &(header->next);
2738 their implementation */ 2679 their implementation */
2739 for (bit_vector = *prev; !EQ (bit_vector, Qzero); ) 2680 for (bit_vector = *prev; !EQ (bit_vector, Qzero); )
2740 { 2681 {
2741 Lisp_Bit_Vector *v = XBIT_VECTOR (bit_vector); 2682 Lisp_Bit_Vector *v = XBIT_VECTOR (bit_vector);
2742 int len = v->size; 2683 int len = v->size;
2743 if (C_READONLY_RECORD_HEADER_P(&(v->lheader)) || MARKED_RECORD_P (bit_vector)) 2684 if (MARKED_RECORD_P (bit_vector))
2744 { 2685 {
2745 if (MARKED_RECORD_P (bit_vector)) 2686 if (! C_READONLY_RECORD_HEADER_P(&(v->lheader)))
2746 UNMARK_RECORD_HEADER (&(v->lheader)); 2687 UNMARK_RECORD_HEADER (&(v->lheader));
2747 total_size += len; 2688 total_size += len;
2748 total_storage += 2689 total_storage +=
2749 MALLOC_OVERHEAD + 2690 MALLOC_OVERHEAD +
2750 offsetof (Lisp_Bit_Vector, bits[BIT_VECTOR_LONG_STORAGE (len)]); 2691 offsetof (Lisp_Bit_Vector, bits[BIT_VECTOR_LONG_STORAGE (len)]);
2796 } \ 2737 } \
2797 else if (C_READONLY_RECORD_HEADER_P (&SFTB_victim->lheader)) \ 2738 else if (C_READONLY_RECORD_HEADER_P (&SFTB_victim->lheader)) \
2798 { \ 2739 { \
2799 num_used++; \ 2740 num_used++; \
2800 } \ 2741 } \
2801 else if (!MARKED_RECORD_HEADER_P (&SFTB_victim->lheader)) \ 2742 else if (! MARKED_RECORD_HEADER_P (&SFTB_victim->lheader)) \
2802 { \ 2743 { \
2803 num_free++; \ 2744 num_free++; \
2804 FREE_FIXED_TYPE (typename, obj_type, SFTB_victim); \ 2745 FREE_FIXED_TYPE (typename, obj_type, SFTB_victim); \
2805 } \ 2746 } \
2806 else \ 2747 else \
2851 else if (C_READONLY_RECORD_HEADER_P (&SFTB_victim->lheader)) \ 2792 else if (C_READONLY_RECORD_HEADER_P (&SFTB_victim->lheader)) \
2852 { \ 2793 { \
2853 SFTB_empty = 0; \ 2794 SFTB_empty = 0; \
2854 num_used++; \ 2795 num_used++; \
2855 } \ 2796 } \
2856 else if (!MARKED_RECORD_HEADER_P (&SFTB_victim->lheader)) \ 2797 else if (! MARKED_RECORD_HEADER_P (&SFTB_victim->lheader)) \
2857 { \ 2798 { \
2858 num_free++; \ 2799 num_free++; \
2859 FREE_FIXED_TYPE (typename, obj_type, SFTB_victim); \ 2800 FREE_FIXED_TYPE (typename, obj_type, SFTB_victim); \
2860 } \ 2801 } \
2861 else \ 2802 else \
3030 2971
3031 /* Explicitly free a marker. */ 2972 /* Explicitly free a marker. */
3032 void 2973 void
3033 free_marker (Lisp_Marker *ptr) 2974 free_marker (Lisp_Marker *ptr)
3034 { 2975 {
3035 #ifdef ERROR_CHECK_GC
3036 /* Perhaps this will catch freeing an already-freed marker. */ 2976 /* Perhaps this will catch freeing an already-freed marker. */
3037 Lisp_Object temmy; 2977 gc_checking_assert (ptr->lheader.type = lrecord_type_marker);
3038 XSETMARKER (temmy, ptr);
3039 assert (MARKERP (temmy));
3040 #endif /* ERROR_CHECK_GC */
3041 2978
3042 #ifndef ALLOC_NO_POOLS 2979 #ifndef ALLOC_NO_POOLS
3043 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (marker, Lisp_Marker, ptr); 2980 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (marker, Lisp_Marker, ptr);
3044 #endif /* ALLOC_NO_POOLS */ 2981 #endif /* ALLOC_NO_POOLS */
3045 } 2982 }
3251 3188
3252 /* I hate duplicating all this crap! */ 3189 /* I hate duplicating all this crap! */
3253 int 3190 int
3254 marked_p (Lisp_Object obj) 3191 marked_p (Lisp_Object obj)
3255 { 3192 {
3256 #ifdef ERROR_CHECK_GC
3257 assert (! (EQ (obj, Qnull_pointer)));
3258 #endif
3259 /* Checks we used to perform. */ 3193 /* Checks we used to perform. */
3260 /* if (EQ (obj, Qnull_pointer)) return 1; */ 3194 /* if (EQ (obj, Qnull_pointer)) return 1; */
3261 /* if (!POINTER_TYPE_P (XGCTYPE (obj))) return 1; */ 3195 /* if (!POINTER_TYPE_P (XGCTYPE (obj))) return 1; */
3262 /* if (PURIFIED (XPNTR (obj))) return 1; */ 3196 /* if (PURIFIED (XPNTR (obj))) return 1; */
3263 3197
3264 if (XTYPE (obj) == Lisp_Type_Record) 3198 if (XTYPE (obj) == Lisp_Type_Record)
3265 { 3199 {
3266 struct lrecord_header *lheader = XRECORD_LHEADER (obj); 3200 struct lrecord_header *lheader = XRECORD_LHEADER (obj);
3267 #if defined (ERROR_CHECK_GC) 3201
3268 assert (lheader->type <= last_lrecord_type_index_assigned); 3202 GC_CHECK_LHEADER_INVARIANTS (lheader);
3269 #endif 3203
3270 return C_READONLY_RECORD_HEADER_P (lheader) || MARKED_RECORD_HEADER_P (lheader); 3204 return MARKED_RECORD_HEADER_P (lheader);
3271 } 3205 }
3272 return 1; 3206 return 1;
3273 } 3207 }
3274 3208
3275 static void 3209 static void
3343 p += sizeof (pdump_reloc_table); 3277 p += sizeof (pdump_reloc_table);
3344 if (rt->desc) 3278 if (rt->desc)
3345 { 3279 {
3346 for (i=0; i<rt->count; i++) 3280 for (i=0; i<rt->count; i++)
3347 { 3281 {
3348 UNMARK_RECORD_HEADER ((struct lrecord_header *)(*(EMACS_INT *)p)); 3282 struct lrecord_header *lh = * (struct lrecord_header **) p;
3283 if (! C_READONLY_RECORD_HEADER_P (lh))
3284 UNMARK_RECORD_HEADER (lh);
3349 p += sizeof (EMACS_INT); 3285 p += sizeof (EMACS_INT);
3350 } 3286 }
3351 } else 3287 } else
3352 break; 3288 break;
3353 } 3289 }
3724 { 3660 {
3725 char buf [255]; 3661 char buf [255];
3726 const char *name = lrecord_implementations_table[i]->name; 3662 const char *name = lrecord_implementations_table[i]->name;
3727 int len = strlen (name); 3663 int len = strlen (name);
3728 /* save this for the FSFmacs-compatible part of the summary */ 3664 /* save this for the FSFmacs-compatible part of the summary */
3729 if (i == *lrecord_vector.lrecord_type_index) 3665 if (i == lrecord_vector.lrecord_type_index)
3730 gc_count_vector_total_size = 3666 gc_count_vector_total_size =
3731 lcrecord_stats[i].bytes_in_use + lcrecord_stats[i].bytes_freed; 3667 lcrecord_stats[i].bytes_in_use + lcrecord_stats[i].bytes_freed;
3732 3668
3733 sprintf (buf, "%s-storage", name); 3669 sprintf (buf, "%s-storage", name);
3734 pl = gc_plist_hack (buf, lcrecord_stats[i].bytes_in_use, pl); 3670 pl = gc_plist_hack (buf, lcrecord_stats[i].bytes_in_use, pl);
4053 } 3989 }
4054 3990
4055 void 3991 void
4056 init_alloc_once_early (void) 3992 init_alloc_once_early (void)
4057 { 3993 {
4058 int iii;
4059
4060 reinit_alloc_once_early (); 3994 reinit_alloc_once_early ();
4061 3995
4062 last_lrecord_type_index_assigned = -1; 3996 last_lrecord_type_index_assigned = lrecord_type_count - 1;
4063 for (iii = 0; iii < countof (lrecord_implementations_table); iii++) 3997
4064 { 3998 {
4065 lrecord_implementations_table[iii] = 0; 3999 int i;
4066 } 4000 for (i = 0; i < countof (lrecord_implementations_table); i++)
4067 4001 lrecord_implementations_table[i] = 0;
4068 /* 4002 }
4069 * All the staticly 4003
4070 * defined subr lrecords were initialized with lheader->type == 0. 4004 INIT_LRECORD_IMPLEMENTATION (cons);
4071 * See subr_lheader_initializer in lisp.h. Force type index 0 to be 4005 INIT_LRECORD_IMPLEMENTATION (vector);
4072 * assigned to lrecord_subr so that those predefined indexes match 4006 INIT_LRECORD_IMPLEMENTATION (string);
4073 * reality. 4007 INIT_LRECORD_IMPLEMENTATION (lcrecord_list);
4074 */
4075 lrecord_type_index (&lrecord_subr);
4076 assert (*(lrecord_subr.lrecord_type_index) == 0);
4077 /*
4078 * The same is true for symbol_value_forward objects, except the
4079 * type is 1.
4080 */
4081 lrecord_type_index (&lrecord_symbol_value_forward);
4082 assert (*(lrecord_symbol_value_forward.lrecord_type_index) == 1);
4083 4008
4084 staticidx = 0; 4009 staticidx = 0;
4085 } 4010 }
4086 4011
4087 int pure_bytes_used = 0; 4012 int pure_bytes_used = 0;
5188 5113
5189 /* Put back the lrecord_implementations_table */ 5114 /* Put back the lrecord_implementations_table */
5190 memcpy (lrecord_implementations_table, p, sizeof (lrecord_implementations_table)); 5115 memcpy (lrecord_implementations_table, p, sizeof (lrecord_implementations_table));
5191 p += sizeof (lrecord_implementations_table); 5116 p += sizeof (lrecord_implementations_table);
5192 5117
5193 /* Give back their numbers to the lrecord implementations */ 5118 /* Reinitialize lrecord_markers from lrecord_implementations_table */
5194 for (i = 0; i < countof (lrecord_implementations_table); i++) 5119 for (i=0; i < countof (lrecord_implementations_table); i++)
5195 if (lrecord_implementations_table[i]) 5120 if (lrecord_implementations_table[i])
5196 { 5121 lrecord_markers[i] = lrecord_implementations_table[i]->marker;
5197 *(lrecord_implementations_table[i]->lrecord_type_index) = i;
5198 last_lrecord_type_index_assigned = i;
5199 }
5200 5122
5201 /* Do the relocations */ 5123 /* Do the relocations */
5202 pdump_rt_list = p; 5124 pdump_rt_list = p;
5203 count = 2; 5125 count = 2;
5204 for (;;) 5126 for (;;)
5254 5176
5255 return 1; 5177 return 1;
5256 } 5178 }
5257 5179
5258 #endif /* PDUMP */ 5180 #endif /* PDUMP */
5181