boehm-gc/reclaim.c

   1 /*
   2  * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
   3  * Copyright (c) 1991-1996 by Xerox Corporation.  All rights reserved.
   4  * Copyright (c) 1996-1999 by Silicon Graphics.  All rights reserved.
   5  * Copyright (c) 1999 by Hewlett-Packard Company. All rights reserved.
   6  *
   7  * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
   8  * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
   9  *
  10  * Permission is hereby granted to use or copy this program
  11  * for any purpose,  provided the above notices are retained on all copies.
  12  * Permission to modify the code and to distribute modified code is granted,
  13  * provided the above notices are retained, and a notice that the code was
  14  * modified is included with the above copyright notice.
  15  */
  16
  17 #include <stdio.h>
  18 #include "gc_priv.h"
  19
  20 signed_word GC_mem_found = 0;
  21                         /* Number of words of memory reclaimed     */
  22
  23 static void report_leak(p, sz)
  24 ptr_t p;
  25 word sz;
  26 {
  27     if (HDR(p) -> hb_obj_kind == PTRFREE) {
  28         GC_err_printf0("Leaked atomic object at ");
  29     } else {
  30         GC_err_printf0("Leaked composite object at ");
  31     }
  32     if (GC_debugging_started && GC_has_debug_info(p)) {
  33         GC_print_obj(p);
  34     } else {
  35         GC_err_printf2("0x%lx (appr. size = %ld)\n",
  36                       (unsigned long)p,
  37                       (unsigned long)WORDS_TO_BYTES(sz));
  38     }
  39 }
  40
  41 #   define FOUND_FREE(hblk, word_no) \
  42       { \
  43          report_leak((ptr_t)hblk + WORDS_TO_BYTES(word_no), \
  44                      HDR(hblk) -> hb_sz); \
  45       }
  46
  47 /*
  48  * reclaim phase
  49  *
  50  */
  51
  52
  53 /*
  54  * Test whether a block is completely empty, i.e. contains no marked
  55  * objects.  This does not require the block to be in physical
  56  * memory.
  57  */
  58
  59 GC_bool GC_block_empty(hhdr)
  60 register hdr * hhdr;
  61 {
  62     register word *p = (word *)(&(hhdr -> hb_marks[0]));
  63     register word * plim =
  64                         (word *)(&(hhdr -> hb_marks[MARK_BITS_SZ]));
  65     while (p < plim) {
  66         if (*p++) return(FALSE);
  67     }
  68     return(TRUE);
  69 }
  70
  71 /* The following functions sometimes return a DONT_KNOW value. */
  72 #define DONT_KNOW  2
  73
  74 #ifdef SMALL_CONFIG
  75 # define GC_block_nearly_full1(hhdr, pat1) DONT_KNOW
  76 # define GC_block_nearly_full3(hhdr, pat1, pat2) DONT_KNOW
  77 # define GC_block_nearly_full(hhdr) DONT_KNOW
  78 #else
  79
  80 /*
  81  * Test whether nearly all of the mark words consist of the same
  82  * repeating pattern.
  83  */
  84 #define FULL_THRESHOLD (MARK_BITS_SZ/16)
  85
  86 GC_bool GC_block_nearly_full1(hhdr, pat1)
  87 hdr *hhdr;
  88 word pat1;
  89 {
  90     unsigned i;
  91     unsigned misses = 0;
  92     GC_ASSERT((MARK_BITS_SZ & 1) == 0);
  93     for (i = 0; i < MARK_BITS_SZ; ++i) {
  94         if ((hhdr -> hb_marks[i] | ~pat1) != ONES) {
  95             if (++misses > FULL_THRESHOLD) return FALSE;
  96         }
  97     }
  98     return TRUE;
  99 }
 100
 101 /*
 102  * Test whether the same repeating 3 word pattern occurs in nearly
 103  * all the mark bit slots.
 104  * This is used as a heuristic, so we're a bit sloppy and ignore
 105  * the last one or two words.
 106  */
 107 GC_bool GC_block_nearly_full3(hhdr, pat1, pat2, pat3)
 108 hdr *hhdr;
 109 word pat1, pat2, pat3;
 110 {
 111     unsigned i;
 112     unsigned misses = 0;
 113
 114     if (MARK_BITS_SZ < 4) {
 115       return DONT_KNOW;
 116     }
 117     for (i = 0; i < MARK_BITS_SZ - 2; i += 3) {
 118         if ((hhdr -> hb_marks[i] | ~pat1) != ONES) {
 119             if (++misses > FULL_THRESHOLD) return FALSE;
 120         }
 121         if ((hhdr -> hb_marks[i+1] | ~pat2) != ONES) {
 122             if (++misses > FULL_THRESHOLD) return FALSE;
 123         }
 124         if ((hhdr -> hb_marks[i+2] | ~pat3) != ONES) {
 125             if (++misses > FULL_THRESHOLD) return FALSE;
 126         }
 127     }
 128     return TRUE;
 129 }
 130
 131 /* Check whether a small object block is nearly full by looking at only */
 132 /* the mark bits.                                                       */
 133 /* We manually precomputed the mark bit patterns that need to be        */
 134 /* checked for, and we give up on the ones that are unlikely to occur,  */
 135 /* or have period > 3.                                                  */
 136 /* This would be a lot easier with a mark bit per object instead of per */
 137 /* word, but that would rewuire computing object numbers in the mark    */
 138 /* loop, which would require different data structures ...              */
 139 GC_bool GC_block_nearly_full(hhdr)
 140 hdr *hhdr;
 141 {
 142     int sz = hhdr -> hb_sz;
 143
 144 #   if CPP_WORDSZ != 32 && CPP_WORDSZ != 64
 145       return DONT_KNOW; /* Shouldn't be used in any standard config.    */
 146 #   endif
 147     if (0 != HDR_WORDS) return DONT_KNOW;
 148         /* Also shouldn't happen */
 149 #   if CPP_WORDSZ == 32
 150       switch(sz) {
 151         case 1:
 152           return GC_block_nearly_full1(hhdr, 0xffffffffl);
 153         case 2:
 154           return GC_block_nearly_full1(hhdr, 0x55555555l);
 155         case 4:
 156           return GC_block_nearly_full1(hhdr, 0x11111111l);
 157         case 6:
 158           return GC_block_nearly_full3(hhdr, 0x41041041l,
 159                                               0x10410410l,
 160                                                0x04104104l);
 161         case 8:
 162           return GC_block_nearly_full1(hhdr, 0x01010101l);
 163         case 12:
 164           return GC_block_nearly_full3(hhdr, 0x01001001l,
 165                                               0x10010010l,
 166                                                0x00100100l);
 167         case 16:
 168           return GC_block_nearly_full1(hhdr, 0x00010001l);
 169         case 32:
 170           return GC_block_nearly_full1(hhdr, 0x00000001l);
 171         default:
 172           return DONT_KNOW;
 173       }
 174 #   endif
 175 #   if CPP_WORDSZ == 64
 176       switch(sz) {
 177         case 1:
 178           return GC_block_nearly_full1(hhdr, 0xffffffffffffffffl);
 179         case 2:
 180           return GC_block_nearly_full1(hhdr, 0x5555555555555555l);
 181         case 4:
 182           return GC_block_nearly_full1(hhdr, 0x1111111111111111l);
 183         case 6:
 184           return GC_block_nearly_full3(hhdr, 0x1041041041041041l,
 185                                                0x4104104104104104l,
 186                                                  0x0410410410410410l);
 187         case 8:
 188           return GC_block_nearly_full1(hhdr, 0x0101010101010101l);
 189         case 12:
 190           return GC_block_nearly_full3(hhdr, 0x1001001001001001l,
 191                                                0x0100100100100100l,
 192                                                  0x0010010010010010l);
 193         case 16:
 194           return GC_block_nearly_full1(hhdr, 0x0001000100010001l);
 195         case 32:
 196           return GC_block_nearly_full1(hhdr, 0x0000000100000001l);
 197         default:
 198           return DONT_KNOW;
 199       }
 200 #   endif
 201 }
 202 #endif /* !SMALL_CONFIG */
 203
 204 # ifdef GATHERSTATS
 205 #   define INCR_WORDS(sz) n_words_found += (sz)
 206 # else
 207 #   define INCR_WORDS(sz)
 208 # endif
 209 /*
 210  * Restore unmarked small objects in h of size sz to the object
 211  * free list.  Returns the new list.
 212  * Clears unmarked objects.
 213  */
 214 /*ARGSUSED*/
 215 ptr_t GC_reclaim_clear(hbp, hhdr, sz, list)
 216 register struct hblk *hbp;      /* ptr to current heap block            */
 217 register hdr * hhdr;
 218 register ptr_t list;
 219 register word sz;
 220 {
 221     register int word_no;
 222     register word *p, *q, *plim;
 223 #   ifdef GATHERSTATS
 224         register int n_words_found = 0;
 225 #   endif
 226
 227     p = (word *)(hbp->hb_body);
 228     word_no = HDR_WORDS;
 229     plim = (word *)((((word)hbp) + HBLKSIZE)
 230                    - WORDS_TO_BYTES(sz));
 231
 232     /* go through all words in block */
 233         while( p <= plim )  {
 234             if( mark_bit_from_hdr(hhdr, word_no) ) {
 235                 p += sz;
 236             } else {
 237                 INCR_WORDS(sz);
 238                 /* object is available - put on list */
 239                     obj_link(p) = list;
 240                     list = ((ptr_t)p);
 241                 /* Clear object, advance p to next object in the process */
 242                     q = p + sz;
 243                     p++; /* Skip link field */
 244 #                   if defined(SMALL_CONFIG) && defined(ALIGN_DOUBLE)
 245                       /* We assert that sz must be even */
 246                       *p++ = 0;
 247                       while (p < q) {
 248                         CLEAR_DOUBLE(p);
 249                         p += 2;
 250                       }
 251 #                   else
 252                       while (p < q) {
 253                         *p++ = 0;
 254                       }
 255 #                   endif
 256             }
 257             word_no += sz;
 258         }
 259 #   ifdef GATHERSTATS
 260         GC_mem_found += n_words_found;
 261 #   endif
 262     return(list);
 263 }
 264
 265 #ifndef SMALL_CONFIG
 266
 267 /*
 268  * A special case for 2 word composite objects (e.g. cons cells):
 269  */
 270 /*ARGSUSED*/
 271 ptr_t GC_reclaim_clear2(hbp, hhdr, list)
 272 register struct hblk *hbp;      /* ptr to current heap block            */
 273 hdr * hhdr;
 274 register ptr_t list;
 275 {
 276     register word * mark_word_addr = &(hhdr->hb_marks[divWORDSZ(HDR_WORDS)]);
 277     register word *p, *plim;
 278 #   ifdef GATHERSTATS
 279         register int n_words_found = 0;
 280 #   endif
 281     register word mark_word;
 282     register int i;
 283 #   define DO_OBJ(start_displ) \
 284         if (!(mark_word & ((word)1 << start_displ))) { \
 285             p[start_displ] = (word)list; \
 286             list = (ptr_t)(p+start_displ); \
 287             p[start_displ+1] = 0; \
 288             INCR_WORDS(2); \
 289         }
 290
 291     p = (word *)(hbp->hb_body);
 292     plim = (word *)(((word)hbp) + HBLKSIZE);
 293
 294     /* go through all words in block */
 295         while( p < plim )  {
 296             mark_word = *mark_word_addr++;
 297             for (i = 0; i < WORDSZ; i += 8) {
 298                 DO_OBJ(0);
 299                 DO_OBJ(2);
 300                 DO_OBJ(4);
 301                 DO_OBJ(6);
 302                 p += 8;
 303                 mark_word >>= 8;
 304             }
 305         }
 306 #   ifdef GATHERSTATS
 307         GC_mem_found += n_words_found;
 308 #   endif
 309     return(list);
 310 #   undef DO_OBJ
 311 }
 312
 313 /*
 314  * Another special case for 4 word composite objects:
 315  */
 316 /*ARGSUSED*/
 317 ptr_t GC_reclaim_clear4(hbp, hhdr, list)
 318 register struct hblk *hbp;      /* ptr to current heap block            */
 319 hdr * hhdr;
 320 register ptr_t list;
 321 {
 322     register word * mark_word_addr = &(hhdr->hb_marks[divWORDSZ(HDR_WORDS)]);
 323     register word *p, *plim;
 324 #   ifdef GATHERSTATS
 325         register int n_words_found = 0;
 326 #   endif
 327     register word mark_word;
 328 #   define DO_OBJ(start_displ) \
 329         if (!(mark_word & ((word)1 << start_displ))) { \
 330             p[start_displ] = (word)list; \
 331             list = (ptr_t)(p+start_displ); \
 332             p[start_displ+1] = 0; \
 333             CLEAR_DOUBLE(p + start_displ + 2); \
 334             INCR_WORDS(4); \
 335         }
 336
 337     p = (word *)(hbp->hb_body);
 338     plim = (word *)(((word)hbp) + HBLKSIZE);
 339
 340     /* go through all words in block */
 341         while( p < plim )  {
 342             mark_word = *mark_word_addr++;
 343             DO_OBJ(0);
 344             DO_OBJ(4);
 345             DO_OBJ(8);
 346             DO_OBJ(12);
 347             DO_OBJ(16);
 348             DO_OBJ(20);
 349             DO_OBJ(24);
 350             DO_OBJ(28);
 351 #           if CPP_WORDSZ == 64
 352               DO_OBJ(32);
 353               DO_OBJ(36);
 354               DO_OBJ(40);
 355               DO_OBJ(44);
 356               DO_OBJ(48);
 357               DO_OBJ(52);
 358               DO_OBJ(56);
 359               DO_OBJ(60);
 360 #           endif
 361             p += WORDSZ;
 362         }
 363 #   ifdef GATHERSTATS
 364         GC_mem_found += n_words_found;
 365 #   endif
 366     return(list);
 367 #   undef DO_OBJ
 368 }
 369
 370 #endif /* !SMALL_CONFIG */
 371
 372 /* The same thing, but don't clear objects: */
 373 /*ARGSUSED*/
 374 ptr_t GC_reclaim_uninit(hbp, hhdr, sz, list)
 375 register struct hblk *hbp;      /* ptr to current heap block            */
 376 register hdr * hhdr;
 377 register ptr_t list;
 378 register word sz;
 379 {
 380     register int word_no;
 381     register word *p, *plim;
 382 #   ifdef GATHERSTATS
 383         register int n_words_found = 0;
 384 #   endif
 385
 386     p = (word *)(hbp->hb_body);
 387     word_no = HDR_WORDS;
 388     plim = (word *)((((word)hbp) + HBLKSIZE)
 389                    - WORDS_TO_BYTES(sz));
 390
 391     /* go through all words in block */
 392         while( p <= plim )  {
 393             if( !mark_bit_from_hdr(hhdr, word_no) ) {
 394                 INCR_WORDS(sz);
 395                 /* object is available - put on list */
 396                     obj_link(p) = list;
 397                     list = ((ptr_t)p);
 398             }
 399             p += sz;
 400             word_no += sz;
 401         }
 402 #   ifdef GATHERSTATS
 403         GC_mem_found += n_words_found;
 404 #   endif
 405     return(list);
 406 }
 407
 408 /* Don't really reclaim objects, just check for unmarked ones: */
 409 /*ARGSUSED*/
 410 void GC_reclaim_check(hbp, hhdr, sz)
 411 register struct hblk *hbp;      /* ptr to current heap block            */
 412 register hdr * hhdr;
 413 register word sz;
 414 {
 415     register int word_no;
 416     register word *p, *plim;
 417 #   ifdef GATHERSTATS
 418         register int n_words_found = 0;
 419 #   endif
 420
 421     p = (word *)(hbp->hb_body);
 422     word_no = HDR_WORDS;
 423     plim = (word *)((((word)hbp) + HBLKSIZE)
 424                    - WORDS_TO_BYTES(sz));
 425
 426     /* go through all words in block */
 427         while( p <= plim )  {
 428             if( !mark_bit_from_hdr(hhdr, word_no) ) {
 429                 FOUND_FREE(hbp, word_no);
 430             }
 431             p += sz;
 432             word_no += sz;
 433         }
 434 }
 435
 436 #ifndef SMALL_CONFIG
 437 /*
 438  * Another special case for 2 word atomic objects:
 439  */
 440 /*ARGSUSED*/
 441 ptr_t GC_reclaim_uninit2(hbp, hhdr, list)
 442 register struct hblk *hbp;      /* ptr to current heap block            */
 443 hdr * hhdr;
 444 register ptr_t list;
 445 {
 446     register word * mark_word_addr = &(hhdr->hb_marks[divWORDSZ(HDR_WORDS)]);
 447     register word *p, *plim;
 448 #   ifdef GATHERSTATS
 449         register int n_words_found = 0;
 450 #   endif
 451     register word mark_word;
 452     register int i;
 453 #   define DO_OBJ(start_displ) \
 454         if (!(mark_word & ((word)1 << start_displ))) { \
 455             p[start_displ] = (word)list; \
 456             list = (ptr_t)(p+start_displ); \
 457             INCR_WORDS(2); \
 458         }
 459
 460     p = (word *)(hbp->hb_body);
 461     plim = (word *)(((word)hbp) + HBLKSIZE);
 462
 463     /* go through all words in block */
 464         while( p < plim )  {
 465             mark_word = *mark_word_addr++;
 466             for (i = 0; i < WORDSZ; i += 8) {
 467                 DO_OBJ(0);
 468                 DO_OBJ(2);
 469                 DO_OBJ(4);
 470                 DO_OBJ(6);
 471                 p += 8;
 472                 mark_word >>= 8;
 473             }
 474         }
 475 #   ifdef GATHERSTATS
 476         GC_mem_found += n_words_found;
 477 #   endif
 478     return(list);
 479 #   undef DO_OBJ
 480 }
 481
 482 /*
 483  * Another special case for 4 word atomic objects:
 484  */
 485 /*ARGSUSED*/
 486 ptr_t GC_reclaim_uninit4(hbp, hhdr, list)
 487 register struct hblk *hbp;      /* ptr to current heap block            */
 488 hdr * hhdr;
 489 register ptr_t list;
 490 {
 491     register word * mark_word_addr = &(hhdr->hb_marks[divWORDSZ(HDR_WORDS)]);
 492     register word *p, *plim;
 493 #   ifdef GATHERSTATS
 494         register int n_words_found = 0;
 495 #   endif
 496     register word mark_word;
 497 #   define DO_OBJ(start_displ) \
 498         if (!(mark_word & ((word)1 << start_displ))) { \
 499             p[start_displ] = (word)list; \
 500             list = (ptr_t)(p+start_displ); \
 501             INCR_WORDS(4); \
 502         }
 503
 504     p = (word *)(hbp->hb_body);
 505     plim = (word *)(((word)hbp) + HBLKSIZE);
 506
 507     /* go through all words in block */
 508         while( p < plim )  {
 509             mark_word = *mark_word_addr++;
 510             DO_OBJ(0);
 511             DO_OBJ(4);
 512             DO_OBJ(8);
 513             DO_OBJ(12);
 514             DO_OBJ(16);
 515             DO_OBJ(20);
 516             DO_OBJ(24);
 517             DO_OBJ(28);
 518 #           if CPP_WORDSZ == 64
 519               DO_OBJ(32);
 520               DO_OBJ(36);
 521               DO_OBJ(40);
 522               DO_OBJ(44);
 523               DO_OBJ(48);
 524               DO_OBJ(52);
 525               DO_OBJ(56);
 526               DO_OBJ(60);
 527 #           endif
 528             p += WORDSZ;
 529         }
 530 #   ifdef GATHERSTATS
 531         GC_mem_found += n_words_found;
 532 #   endif
 533     return(list);
 534 #   undef DO_OBJ
 535 }
 536
 537 /* Finally the one word case, which never requires any clearing: */
 538 /*ARGSUSED*/
 539 ptr_t GC_reclaim1(hbp, hhdr, list)
 540 register struct hblk *hbp;      /* ptr to current heap block            */
 541 hdr * hhdr;
 542 register ptr_t list;
 543 {
 544     register word * mark_word_addr = &(hhdr->hb_marks[divWORDSZ(HDR_WORDS)]);
 545     register word *p, *plim;
 546 #   ifdef GATHERSTATS
 547         register int n_words_found = 0;
 548 #   endif
 549     register word mark_word;
 550     register int i;
 551 #   define DO_OBJ(start_displ) \
 552         if (!(mark_word & ((word)1 << start_displ))) { \
 553             p[start_displ] = (word)list; \
 554             list = (ptr_t)(p+start_displ); \
 555             INCR_WORDS(1); \
 556         }
 557
 558     p = (word *)(hbp->hb_body);
 559     plim = (word *)(((word)hbp) + HBLKSIZE);
 560
 561     /* go through all words in block */
 562         while( p < plim )  {
 563             mark_word = *mark_word_addr++;
 564             for (i = 0; i < WORDSZ; i += 4) {
 565                 DO_OBJ(0);
 566                 DO_OBJ(1);
 567                 DO_OBJ(2);
 568                 DO_OBJ(3);
 569                 p += 4;
 570                 mark_word >>= 4;
 571             }
 572         }
 573 #   ifdef GATHERSTATS
 574         GC_mem_found += n_words_found;
 575 #   endif
 576     return(list);
 577 #   undef DO_OBJ
 578 }
 579
 580 #endif /* !SMALL_CONFIG */
 581
 582 /*
 583  * Restore unmarked small objects in the block pointed to by hbp
 584  * to the appropriate object free list.
 585  * If entirely empty blocks are to be completely deallocated, then
 586  * caller should perform that check.
 587  */
 588 void GC_reclaim_small_nonempty_block(hbp, report_if_found)
 589 register struct hblk *hbp;      /* ptr to current heap block            */
 590 int report_if_found;            /* Abort if a reclaimable object is found */
 591 {
 592     hdr * hhdr;
 593     word sz;            /* size of objects in current block     */
 594     struct obj_kind * ok;
 595     ptr_t * flh;
 596     int kind;
 597     GC_bool full;
 598
 599     hhdr = HDR(hbp);
 600     sz = hhdr -> hb_sz;
 601     hhdr -> hb_last_reclaimed = (unsigned short) GC_gc_no;
 602     kind = hhdr -> hb_obj_kind;
 603     ok = &GC_obj_kinds[kind];
 604     flh = &(ok -> ok_freelist[sz]);
 605
 606     if (report_if_found) {
 607         GC_reclaim_check(hbp, hhdr, sz);
 608     } else if (ok -> ok_init) {
 609       switch(sz) {
 610 #      ifndef SMALL_CONFIG
 611         case 1:
 612             full = GC_block_nearly_full1(hhdr, 0xffffffffl);
 613             if (TRUE == full) goto out;
 614             if (FALSE == full) GC_write_hint(hbp);
 615             /* In the DONT_KNOW case, we let reclaim fault.     */
 616             *flh = GC_reclaim1(hbp, hhdr, *flh);
 617             break;
 618         case 2:
 619             full = GC_block_nearly_full1(hhdr, 0x55555555l);
 620             if (TRUE == full) goto out;
 621             if (FALSE == full) GC_write_hint(hbp);
 622             *flh = GC_reclaim_clear2(hbp, hhdr, *flh);
 623             break;
 624         case 4:
 625             full = GC_block_nearly_full1(hhdr, 0x11111111l);
 626             if (TRUE == full) goto out;
 627             if (FALSE == full) GC_write_hint(hbp);
 628             *flh = GC_reclaim_clear4(hbp, hhdr, *flh);
 629             break;
 630 #      endif
 631         default:
 632             full = GC_block_nearly_full(hhdr);
 633             if (TRUE == full) goto out;
 634             if (FALSE == full) GC_write_hint(hbp);
 635             *flh = GC_reclaim_clear(hbp, hhdr, sz, *flh);
 636             break;
 637       }
 638     } else {
 639       switch(sz) {
 640 #      ifndef SMALL_CONFIG
 641         case 1:
 642             full = GC_block_nearly_full1(hhdr, 0xffffffffl);
 643             if (TRUE == full) goto out;
 644             if (FALSE == full) GC_write_hint(hbp);
 645             *flh = GC_reclaim1(hbp, hhdr, *flh);
 646             break;
 647         case 2:
 648             full = GC_block_nearly_full1(hhdr, 0x55555555l);
 649             if (TRUE == full) goto out;
 650             if (FALSE == full) GC_write_hint(hbp);
 651             *flh = GC_reclaim_uninit2(hbp, hhdr, *flh);
 652             break;
 653         case 4:
 654             full = GC_block_nearly_full1(hhdr, 0x11111111l);
 655             if (TRUE == full) goto out;
 656             if (FALSE == full) GC_write_hint(hbp);
 657             *flh = GC_reclaim_uninit4(hbp, hhdr, *flh);
 658             break;
 659 #      endif
 660         default:
 661             full = GC_block_nearly_full(hhdr);
 662             if (TRUE == full) goto out;
 663             if (FALSE == full) GC_write_hint(hbp);
 664             *flh = GC_reclaim_uninit(hbp, hhdr, sz, *flh);
 665             break;
 666       }
 667     }
 668 out:
 669     if (IS_UNCOLLECTABLE(kind)) GC_set_hdr_marks(hhdr);
 670 }
 671
 672 /*
 673  * Restore an unmarked large object or an entirely empty blocks of small objects
 674  * to the heap block free list.
 675  * Otherwise enqueue the block for later processing
 676  * by GC_reclaim_small_nonempty_block.
 677  * If report_if_found is TRUE, then process any block immediately, and
 678  * simply report free objects; do not actually reclaim them.
 679  */
 680 void GC_reclaim_block(hbp, report_if_found)
 681 register struct hblk *hbp;      /* ptr to current heap block            */
 682 word report_if_found;           /* Abort if a reclaimable object is found */
 683 {
 684     register hdr * hhdr;
 685     register word sz;           /* size of objects in current block     */
 686     register struct obj_kind * ok;
 687     struct hblk ** rlh;
 688
 689     hhdr = HDR(hbp);
 690     sz = hhdr -> hb_sz;
 691     ok = &GC_obj_kinds[hhdr -> hb_obj_kind];
 692
 693     if( sz > MAXOBJSZ ) {  /* 1 big object */
 694         if( !mark_bit_from_hdr(hhdr, HDR_WORDS) ) {
 695             if (report_if_found) {
 696               FOUND_FREE(hbp, HDR_WORDS);
 697             } else {
 698 #             ifdef GATHERSTATS
 699                 GC_mem_found += sz;
 700 #             endif
 701               GC_freehblk(hbp);
 702             }
 703         }
 704     } else {
 705         GC_bool empty = GC_block_empty(hhdr);
 706         if (report_if_found) {
 707           GC_reclaim_small_nonempty_block(hbp, (int)report_if_found);
 708         } else if (empty) {
 709 #         ifdef GATHERSTATS
 710             GC_mem_found += BYTES_TO_WORDS(HBLKSIZE);
 711 #         endif
 712           GC_freehblk(hbp);
 713         } else {
 714           /* group of smaller objects, enqueue the real work */
 715           rlh = &(ok -> ok_reclaim_list[sz]);
 716           hhdr -> hb_next = *rlh;
 717           *rlh = hbp;
 718         }
 719     }
 720 }
 721
 722 #if !defined(NO_DEBUGGING)
 723 /* Routines to gather and print heap block info         */
 724 /* intended for debugging.  Otherwise should be called  */
 725 /* with lock.                                           */
 726 static size_t number_of_blocks;
 727 static size_t total_bytes;
 728
 729 /* Number of set bits in a word.  Not performance critical.     */
 730 static int set_bits(n)
 731 word n;
 732 {
 733     register word m = n;
 734     register int result = 0;
 735
 736     while (m > 0) {
 737         if (m & 1) result++;
 738         m >>= 1;
 739     }
 740     return(result);
 741 }
 742
 743 /* Return the number of set mark bits in the given header       */
 744 int GC_n_set_marks(hhdr)
 745 hdr * hhdr;
 746 {
 747     register int result = 0;
 748     register int i;
 749
 750     for (i = 0; i < MARK_BITS_SZ; i++) {
 751         result += set_bits(hhdr -> hb_marks[i]);
 752     }
 753     return(result);
 754 }
 755
 756 /*ARGSUSED*/
 757 void GC_print_block_descr(h, dummy)
 758 struct hblk *h;
 759 word dummy;
 760 {
 761     register hdr * hhdr = HDR(h);
 762     register size_t bytes = WORDS_TO_BYTES(hhdr -> hb_sz);
 763
 764     GC_printf3("(%lu:%lu,%lu)", (unsigned long)(hhdr -> hb_obj_kind),
 765                                 (unsigned long)bytes,
 766                                 (unsigned long)(GC_n_set_marks(hhdr)));
 767     bytes += HDR_BYTES + HBLKSIZE-1;
 768     bytes &= ~(HBLKSIZE-1);
 769     total_bytes += bytes;
 770     number_of_blocks++;
 771 }
 772
 773 void GC_print_block_list()
 774 {
 775     GC_printf0("(kind(0=ptrfree,1=normal,2=unc.,3=stubborn):size_in_bytes, #_marks_set)\n");
 776     number_of_blocks = 0;
 777     total_bytes = 0;
 778     GC_apply_to_all_blocks(GC_print_block_descr, (word)0);
 779     GC_printf2("\nblocks = %lu, bytes = %lu\n",
 780                (unsigned long)number_of_blocks,
 781                (unsigned long)total_bytes);
 782 }
 783
 784 #endif /* NO_DEBUGGING */
 785
 786 /*
 787  * Perform GC_reclaim_block on the entire heap, after first clearing
 788  * small object free lists (if we are not just looking for leaks).
 789  */
 790 void GC_start_reclaim(report_if_found)
 791 int report_if_found;            /* Abort if a GC_reclaimable object is found */
 792 {
 793     int kind;
 794
 795     /* Clear reclaim- and free-lists */
 796       for (kind = 0; kind < GC_n_kinds; kind++) {
 797         register ptr_t *fop;
 798         register ptr_t *lim;
 799         register struct hblk ** rlp;
 800         register struct hblk ** rlim;
 801         register struct hblk ** rlist = GC_obj_kinds[kind].ok_reclaim_list;
 802
 803         if (rlist == 0) continue;       /* This kind not used.  */
 804         if (!report_if_found) {
 805             lim = &(GC_obj_kinds[kind].ok_freelist[MAXOBJSZ+1]);
 806             for( fop = GC_obj_kinds[kind].ok_freelist; fop < lim; fop++ ) {
 807               *fop = 0;
 808             }
 809         } /* otherwise free list objects are marked,    */
 810           /* and its safe to leave them                 */
 811         rlim = rlist + MAXOBJSZ+1;
 812         for( rlp = rlist; rlp < rlim; rlp++ ) {
 813             *rlp = 0;
 814         }
 815       }
 816
 817 #   ifdef PRINTBLOCKS
 818         GC_printf0("GC_reclaim: current block sizes:\n");
 819         GC_print_block_list();
 820 #   endif
 821
 822   /* Go through all heap blocks (in hblklist) and reclaim unmarked objects */
 823   /* or enqueue the block for later processing.                            */
 824     GC_apply_to_all_blocks(GC_reclaim_block, (word)report_if_found);
 825
 826 # ifdef EAGER_SWEEP
 827     /* This is a very stupid thing to do.  We make it possible anyway,  */
 828     /* so that you can convince yourself that it really is very stupid. */
 829     GC_reclaim_all((GC_stop_func)0, FALSE);
 830 # endif
 831
 832 }
 833
 834 /*
 835  * Sweep blocks of the indicated object size and kind until either the
 836  * appropriate free list is nonempty, or there are no more blocks to
 837  * sweep.
 838  */
 839 void GC_continue_reclaim(sz, kind)
 840 word sz;        /* words */
 841 int kind;
 842 {
 843     register hdr * hhdr;
 844     register struct hblk * hbp;
 845     register struct obj_kind * ok = &(GC_obj_kinds[kind]);
 846     struct hblk ** rlh = ok -> ok_reclaim_list;
 847     ptr_t *flh = &(ok -> ok_freelist[sz]);
 848
 849     if (rlh == 0) return;       /* No blocks of this kind.      */
 850     rlh += sz;
 851     while ((hbp = *rlh) != 0) {
 852         hhdr = HDR(hbp);
 853         *rlh = hhdr -> hb_next;
 854         GC_reclaim_small_nonempty_block(hbp, FALSE);
 855         if (*flh != 0) break;
 856     }
 857 }
 858
 859 /*
 860  * Reclaim all small blocks waiting to be reclaimed.
 861  * Abort and return FALSE when/if (*stop_func)() returns TRUE.
 862  * If this returns TRUE, then it's safe to restart the world
 863  * with incorrectly cleared mark bits.
 864  * If ignore_old is TRUE, then reclaim only blocks that have been
 865  * recently reclaimed, and discard the rest.
 866  * Stop_func may be 0.
 867  */
 868 GC_bool GC_reclaim_all(stop_func, ignore_old)
 869 GC_stop_func stop_func;
 870 GC_bool ignore_old;
 871 {
 872     register word sz;
 873     register int kind;
 874     register hdr * hhdr;
 875     register struct hblk * hbp;
 876     register struct obj_kind * ok;
 877     struct hblk ** rlp;
 878     struct hblk ** rlh;
 879 #   ifdef PRINTTIMES
 880         CLOCK_TYPE start_time;
 881         CLOCK_TYPE done_time;
 882
 883         GET_TIME(start_time);
 884 #   endif
 885
 886     for (kind = 0; kind < GC_n_kinds; kind++) {
 887         ok = &(GC_obj_kinds[kind]);
 888         rlp = ok -> ok_reclaim_list;
 889         if (rlp == 0) continue;
 890         for (sz = 1; sz <= MAXOBJSZ; sz++) {
 891             rlh = rlp + sz;
 892             while ((hbp = *rlh) != 0) {
 893                 if (stop_func != (GC_stop_func)0 && (*stop_func)()) {
 894                     return(FALSE);
 895                 }
 896                 hhdr = HDR(hbp);
 897                 *rlh = hhdr -> hb_next;
 898                 if (!ignore_old || hhdr -> hb_last_reclaimed == GC_gc_no - 1) {
 899                     /* It's likely we'll need it this time, too */
 900                     /* It's been touched recently, so this      */
 901                     /* shouldn't trigger paging.                */
 902                     GC_reclaim_small_nonempty_block(hbp, FALSE);
 903                 }
 904             }
 905         }
 906     }
 907 #   ifdef PRINTTIMES
 908         GET_TIME(done_time);
 909         GC_printf1("Disposing of reclaim lists took %lu msecs\n",
 910                    MS_TIME_DIFF(done_time,start_time));
 911 #   endif
 912     return(TRUE);
 913 }