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                     while (p < q) {
 245                         *p++ = 0;
 246                     }
 247             }
 248             word_no += sz;
 249         }
 250 #   ifdef GATHERSTATS
 251         GC_mem_found += n_words_found;
 252 #   endif
 253     return(list);
 254 }
 255
 256 #ifndef SMALL_CONFIG
 257
 258 /*
 259  * A special case for 2 word composite objects (e.g. cons cells):
 260  */
 261 /*ARGSUSED*/
 262 ptr_t GC_reclaim_clear2(hbp, hhdr, list)
 263 register struct hblk *hbp;      /* ptr to current heap block            */
 264 hdr * hhdr;
 265 register ptr_t list;
 266 {
 267     register word * mark_word_addr = &(hhdr->hb_marks[divWORDSZ(HDR_WORDS)]);
 268     register word *p, *plim;
 269 #   ifdef GATHERSTATS
 270         register int n_words_found = 0;
 271 #   endif
 272     register word mark_word;
 273     register int i;
 274 #   define DO_OBJ(start_displ) \
 275         if (!(mark_word & ((word)1 << start_displ))) { \
 276             p[start_displ] = (word)list; \
 277             list = (ptr_t)(p+start_displ); \
 278             p[start_displ+1] = 0; \
 279             INCR_WORDS(2); \
 280         }
 281
 282     p = (word *)(hbp->hb_body);
 283     plim = (word *)(((word)hbp) + HBLKSIZE);
 284
 285     /* go through all words in block */
 286         while( p < plim )  {
 287             mark_word = *mark_word_addr++;
 288             for (i = 0; i < WORDSZ; i += 8) {
 289                 DO_OBJ(0);
 290                 DO_OBJ(2);
 291                 DO_OBJ(4);
 292                 DO_OBJ(6);
 293                 p += 8;
 294                 mark_word >>= 8;
 295             }
 296         }
 297 #   ifdef GATHERSTATS
 298         GC_mem_found += n_words_found;
 299 #   endif
 300     return(list);
 301 #   undef DO_OBJ
 302 }
 303
 304 /*
 305  * Another special case for 4 word composite objects:
 306  */
 307 /*ARGSUSED*/
 308 ptr_t GC_reclaim_clear4(hbp, hhdr, list)
 309 register struct hblk *hbp;      /* ptr to current heap block            */
 310 hdr * hhdr;
 311 register ptr_t list;
 312 {
 313     register word * mark_word_addr = &(hhdr->hb_marks[divWORDSZ(HDR_WORDS)]);
 314     register word *p, *plim;
 315 #   ifdef GATHERSTATS
 316         register int n_words_found = 0;
 317 #   endif
 318     register word mark_word;
 319 #   define DO_OBJ(start_displ) \
 320         if (!(mark_word & ((word)1 << start_displ))) { \
 321             p[start_displ] = (word)list; \
 322             list = (ptr_t)(p+start_displ); \
 323             p[start_displ+1] = 0; \
 324             p[start_displ+2] = 0; \
 325             p[start_displ+3] = 0; \
 326             INCR_WORDS(4); \
 327         }
 328
 329     p = (word *)(hbp->hb_body);
 330     plim = (word *)(((word)hbp) + HBLKSIZE);
 331
 332     /* go through all words in block */
 333         while( p < plim )  {
 334             mark_word = *mark_word_addr++;
 335             DO_OBJ(0);
 336             DO_OBJ(4);
 337             DO_OBJ(8);
 338             DO_OBJ(12);
 339             DO_OBJ(16);
 340             DO_OBJ(20);
 341             DO_OBJ(24);
 342             DO_OBJ(28);
 343 #           if CPP_WORDSZ == 64
 344               DO_OBJ(32);
 345               DO_OBJ(36);
 346               DO_OBJ(40);
 347               DO_OBJ(44);
 348               DO_OBJ(48);
 349               DO_OBJ(52);
 350               DO_OBJ(56);
 351               DO_OBJ(60);
 352 #           endif
 353             p += WORDSZ;
 354         }
 355 #   ifdef GATHERSTATS
 356         GC_mem_found += n_words_found;
 357 #   endif
 358     return(list);
 359 #   undef DO_OBJ
 360 }
 361
 362 #endif /* !SMALL_CONFIG */
 363
 364 /* The same thing, but don't clear objects: */
 365 /*ARGSUSED*/
 366 ptr_t GC_reclaim_uninit(hbp, hhdr, sz, list)
 367 register struct hblk *hbp;      /* ptr to current heap block            */
 368 register hdr * hhdr;
 369 register ptr_t list;
 370 register word sz;
 371 {
 372     register int word_no;
 373     register word *p, *plim;
 374 #   ifdef GATHERSTATS
 375         register int n_words_found = 0;
 376 #   endif
 377
 378     p = (word *)(hbp->hb_body);
 379     word_no = HDR_WORDS;
 380     plim = (word *)((((word)hbp) + HBLKSIZE)
 381                    - WORDS_TO_BYTES(sz));
 382
 383     /* go through all words in block */
 384         while( p <= plim )  {
 385             if( !mark_bit_from_hdr(hhdr, word_no) ) {
 386                 INCR_WORDS(sz);
 387                 /* object is available - put on list */
 388                     obj_link(p) = list;
 389                     list = ((ptr_t)p);
 390             }
 391             p += sz;
 392             word_no += sz;
 393         }
 394 #   ifdef GATHERSTATS
 395         GC_mem_found += n_words_found;
 396 #   endif
 397     return(list);
 398 }
 399
 400 /* Don't really reclaim objects, just check for unmarked ones: */
 401 /*ARGSUSED*/
 402 void GC_reclaim_check(hbp, hhdr, sz)
 403 register struct hblk *hbp;      /* ptr to current heap block            */
 404 register hdr * hhdr;
 405 register word sz;
 406 {
 407     register int word_no;
 408     register word *p, *plim;
 409 #   ifdef GATHERSTATS
 410         register int n_words_found = 0;
 411 #   endif
 412
 413     p = (word *)(hbp->hb_body);
 414     word_no = HDR_WORDS;
 415     plim = (word *)((((word)hbp) + HBLKSIZE)
 416                    - WORDS_TO_BYTES(sz));
 417
 418     /* go through all words in block */
 419         while( p <= plim )  {
 420             if( !mark_bit_from_hdr(hhdr, word_no) ) {
 421                 FOUND_FREE(hbp, word_no);
 422             }
 423             p += sz;
 424             word_no += sz;
 425         }
 426 }
 427
 428 #ifndef SMALL_CONFIG
 429 /*
 430  * Another special case for 2 word atomic objects:
 431  */
 432 /*ARGSUSED*/
 433 ptr_t GC_reclaim_uninit2(hbp, hhdr, list)
 434 register struct hblk *hbp;      /* ptr to current heap block            */
 435 hdr * hhdr;
 436 register ptr_t list;
 437 {
 438     register word * mark_word_addr = &(hhdr->hb_marks[divWORDSZ(HDR_WORDS)]);
 439     register word *p, *plim;
 440 #   ifdef GATHERSTATS
 441         register int n_words_found = 0;
 442 #   endif
 443     register word mark_word;
 444     register int i;
 445 #   define DO_OBJ(start_displ) \
 446         if (!(mark_word & ((word)1 << start_displ))) { \
 447             p[start_displ] = (word)list; \
 448             list = (ptr_t)(p+start_displ); \
 449             INCR_WORDS(2); \
 450         }
 451
 452     p = (word *)(hbp->hb_body);
 453     plim = (word *)(((word)hbp) + HBLKSIZE);
 454
 455     /* go through all words in block */
 456         while( p < plim )  {
 457             mark_word = *mark_word_addr++;
 458             for (i = 0; i < WORDSZ; i += 8) {
 459                 DO_OBJ(0);
 460                 DO_OBJ(2);
 461                 DO_OBJ(4);
 462                 DO_OBJ(6);
 463                 p += 8;
 464                 mark_word >>= 8;
 465             }
 466         }
 467 #   ifdef GATHERSTATS
 468         GC_mem_found += n_words_found;
 469 #   endif
 470     return(list);
 471 #   undef DO_OBJ
 472 }
 473
 474 /*
 475  * Another special case for 4 word atomic objects:
 476  */
 477 /*ARGSUSED*/
 478 ptr_t GC_reclaim_uninit4(hbp, hhdr, list)
 479 register struct hblk *hbp;      /* ptr to current heap block            */
 480 hdr * hhdr;
 481 register ptr_t list;
 482 {
 483     register word * mark_word_addr = &(hhdr->hb_marks[divWORDSZ(HDR_WORDS)]);
 484     register word *p, *plim;
 485 #   ifdef GATHERSTATS
 486         register int n_words_found = 0;
 487 #   endif
 488     register word mark_word;
 489 #   define DO_OBJ(start_displ) \
 490         if (!(mark_word & ((word)1 << start_displ))) { \
 491             p[start_displ] = (word)list; \
 492             list = (ptr_t)(p+start_displ); \
 493             INCR_WORDS(4); \
 494         }
 495
 496     p = (word *)(hbp->hb_body);
 497     plim = (word *)(((word)hbp) + HBLKSIZE);
 498
 499     /* go through all words in block */
 500         while( p < plim )  {
 501             mark_word = *mark_word_addr++;
 502             DO_OBJ(0);
 503             DO_OBJ(4);
 504             DO_OBJ(8);
 505             DO_OBJ(12);
 506             DO_OBJ(16);
 507             DO_OBJ(20);
 508             DO_OBJ(24);
 509             DO_OBJ(28);
 510 #           if CPP_WORDSZ == 64
 511               DO_OBJ(32);
 512               DO_OBJ(36);
 513               DO_OBJ(40);
 514               DO_OBJ(44);
 515               DO_OBJ(48);
 516               DO_OBJ(52);
 517               DO_OBJ(56);
 518               DO_OBJ(60);
 519 #           endif
 520             p += WORDSZ;
 521         }
 522 #   ifdef GATHERSTATS
 523         GC_mem_found += n_words_found;
 524 #   endif
 525     return(list);
 526 #   undef DO_OBJ
 527 }
 528
 529 /* Finally the one word case, which never requires any clearing: */
 530 /*ARGSUSED*/
 531 ptr_t GC_reclaim1(hbp, hhdr, list)
 532 register struct hblk *hbp;      /* ptr to current heap block            */
 533 hdr * hhdr;
 534 register ptr_t list;
 535 {
 536     register word * mark_word_addr = &(hhdr->hb_marks[divWORDSZ(HDR_WORDS)]);
 537     register word *p, *plim;
 538 #   ifdef GATHERSTATS
 539         register int n_words_found = 0;
 540 #   endif
 541     register word mark_word;
 542     register int i;
 543 #   define DO_OBJ(start_displ) \
 544         if (!(mark_word & ((word)1 << start_displ))) { \
 545             p[start_displ] = (word)list; \
 546             list = (ptr_t)(p+start_displ); \
 547             INCR_WORDS(1); \
 548         }
 549
 550     p = (word *)(hbp->hb_body);
 551     plim = (word *)(((word)hbp) + HBLKSIZE);
 552
 553     /* go through all words in block */
 554         while( p < plim )  {
 555             mark_word = *mark_word_addr++;
 556             for (i = 0; i < WORDSZ; i += 4) {
 557                 DO_OBJ(0);
 558                 DO_OBJ(1);
 559                 DO_OBJ(2);
 560                 DO_OBJ(3);
 561                 p += 4;
 562                 mark_word >>= 4;
 563             }
 564         }
 565 #   ifdef GATHERSTATS
 566         GC_mem_found += n_words_found;
 567 #   endif
 568     return(list);
 569 #   undef DO_OBJ
 570 }
 571
 572 #endif /* !SMALL_CONFIG */
 573
 574 /*
 575  * Restore unmarked small objects in the block pointed to by hbp
 576  * to the appropriate object free list.
 577  * If entirely empty blocks are to be completely deallocated, then
 578  * caller should perform that check.
 579  */
 580 void GC_reclaim_small_nonempty_block(hbp, report_if_found)
 581 register struct hblk *hbp;      /* ptr to current heap block            */
 582 int report_if_found;            /* Abort if a reclaimable object is found */
 583 {
 584     hdr * hhdr;
 585     word sz;            /* size of objects in current block     */
 586     struct obj_kind * ok;
 587     ptr_t * flh;
 588     int kind;
 589     GC_bool full;
 590
 591     hhdr = HDR(hbp);
 592     sz = hhdr -> hb_sz;
 593     hhdr -> hb_last_reclaimed = (unsigned short) GC_gc_no;
 594     kind = hhdr -> hb_obj_kind;
 595     ok = &GC_obj_kinds[kind];
 596     flh = &(ok -> ok_freelist[sz]);
 597
 598     if (report_if_found) {
 599         GC_reclaim_check(hbp, hhdr, sz);
 600     } else if (ok -> ok_init) {
 601       switch(sz) {
 602 #      ifndef SMALL_CONFIG
 603         case 1:
 604             full = GC_block_nearly_full1(hhdr, 0xffffffffl);
 605             if (TRUE == full) goto out;
 606             if (FALSE == full) GC_write_hint(hbp);
 607             /* In the DONT_KNOW case, we let reclaim fault.     */
 608             *flh = GC_reclaim1(hbp, hhdr, *flh);
 609             break;
 610         case 2:
 611             full = GC_block_nearly_full1(hhdr, 0x55555555l);
 612             if (TRUE == full) goto out;
 613             if (FALSE == full) GC_write_hint(hbp);
 614             *flh = GC_reclaim_clear2(hbp, hhdr, *flh);
 615             break;
 616         case 4:
 617             full = GC_block_nearly_full1(hhdr, 0x11111111l);
 618             if (TRUE == full) goto out;
 619             if (FALSE == full) GC_write_hint(hbp);
 620             *flh = GC_reclaim_clear4(hbp, hhdr, *flh);
 621             break;
 622 #      endif
 623         default:
 624             full = GC_block_nearly_full(hhdr);
 625             if (TRUE == full) goto out;
 626             if (FALSE == full) GC_write_hint(hbp);
 627             *flh = GC_reclaim_clear(hbp, hhdr, sz, *flh);
 628             break;
 629       }
 630     } else {
 631       switch(sz) {
 632 #      ifndef SMALL_CONFIG
 633         case 1:
 634             full = GC_block_nearly_full1(hhdr, 0xffffffffl);
 635             if (TRUE == full) goto out;
 636             if (FALSE == full) GC_write_hint(hbp);
 637             *flh = GC_reclaim1(hbp, hhdr, *flh);
 638             break;
 639         case 2:
 640             full = GC_block_nearly_full1(hhdr, 0x55555555l);
 641             if (TRUE == full) goto out;
 642             if (FALSE == full) GC_write_hint(hbp);
 643             *flh = GC_reclaim_uninit2(hbp, hhdr, *flh);
 644             break;
 645         case 4:
 646             full = GC_block_nearly_full1(hhdr, 0x11111111l);
 647             if (TRUE == full) goto out;
 648             if (FALSE == full) GC_write_hint(hbp);
 649             *flh = GC_reclaim_uninit4(hbp, hhdr, *flh);
 650             break;
 651 #      endif
 652         default:
 653             full = GC_block_nearly_full(hhdr);
 654             if (TRUE == full) goto out;
 655             if (FALSE == full) GC_write_hint(hbp);
 656             *flh = GC_reclaim_uninit(hbp, hhdr, sz, *flh);
 657             break;
 658       }
 659     }
 660 out:
 661     if (IS_UNCOLLECTABLE(kind)) GC_set_hdr_marks(hhdr);
 662 }
 663
 664 /*
 665  * Restore an unmarked large object or an entirely empty blocks of small objects
 666  * to the heap block free list.
 667  * Otherwise enqueue the block for later processing
 668  * by GC_reclaim_small_nonempty_block.
 669  * If report_if_found is TRUE, then process any block immediately, and
 670  * simply report free objects; do not actually reclaim them.
 671  */
 672 void GC_reclaim_block(hbp, report_if_found)
 673 register struct hblk *hbp;      /* ptr to current heap block            */
 674 word report_if_found;           /* Abort if a reclaimable object is found */
 675 {
 676     register hdr * hhdr;
 677     register word sz;           /* size of objects in current block     */
 678     register struct obj_kind * ok;
 679     struct hblk ** rlh;
 680
 681     hhdr = HDR(hbp);
 682     sz = hhdr -> hb_sz;
 683     ok = &GC_obj_kinds[hhdr -> hb_obj_kind];
 684
 685     if( sz > MAXOBJSZ ) {  /* 1 big object */
 686         if( !mark_bit_from_hdr(hhdr, HDR_WORDS) ) {
 687             if (report_if_found) {
 688               FOUND_FREE(hbp, HDR_WORDS);
 689             } else {
 690 #             ifdef GATHERSTATS
 691                 GC_mem_found += sz;
 692 #             endif
 693               GC_freehblk(hbp);
 694             }
 695         }
 696     } else {
 697         GC_bool empty = GC_block_empty(hhdr);
 698         if (report_if_found) {
 699           GC_reclaim_small_nonempty_block(hbp, (int)report_if_found);
 700         } else if (empty) {
 701 #         ifdef GATHERSTATS
 702             GC_mem_found += BYTES_TO_WORDS(HBLKSIZE);
 703 #         endif
 704           GC_freehblk(hbp);
 705         } else {
 706           /* group of smaller objects, enqueue the real work */
 707           rlh = &(ok -> ok_reclaim_list[sz]);
 708           hhdr -> hb_next = *rlh;
 709           *rlh = hbp;
 710         }
 711     }
 712 }
 713
 714 #if !defined(NO_DEBUGGING)
 715 /* Routines to gather and print heap block info         */
 716 /* intended for debugging.  Otherwise should be called  */
 717 /* with lock.                                           */
 718 static size_t number_of_blocks;
 719 static size_t total_bytes;
 720
 721 /* Number of set bits in a word.  Not performance critical.     */
 722 static int set_bits(n)
 723 word n;
 724 {
 725     register word m = n;
 726     register int result = 0;
 727
 728     while (m > 0) {
 729         if (m & 1) result++;
 730         m >>= 1;
 731     }
 732     return(result);
 733 }
 734
 735 /* Return the number of set mark bits in the given header       */
 736 int GC_n_set_marks(hhdr)
 737 hdr * hhdr;
 738 {
 739     register int result = 0;
 740     register int i;
 741
 742     for (i = 0; i < MARK_BITS_SZ; i++) {
 743         result += set_bits(hhdr -> hb_marks[i]);
 744     }
 745     return(result);
 746 }
 747
 748 /*ARGSUSED*/
 749 void GC_print_block_descr(h, dummy)
 750 struct hblk *h;
 751 word dummy;
 752 {
 753     register hdr * hhdr = HDR(h);
 754     register size_t bytes = WORDS_TO_BYTES(hhdr -> hb_sz);
 755
 756     GC_printf3("(%lu:%lu,%lu)", (unsigned long)(hhdr -> hb_obj_kind),
 757                                 (unsigned long)bytes,
 758                                 (unsigned long)(GC_n_set_marks(hhdr)));
 759     bytes += HDR_BYTES + HBLKSIZE-1;
 760     bytes &= ~(HBLKSIZE-1);
 761     total_bytes += bytes;
 762     number_of_blocks++;
 763 }
 764
 765 void GC_print_block_list()
 766 {
 767     GC_printf0("(kind(0=ptrfree,1=normal,2=unc.,3=stubborn):size_in_bytes, #_marks_set)\n");
 768     number_of_blocks = 0;
 769     total_bytes = 0;
 770     GC_apply_to_all_blocks(GC_print_block_descr, (word)0);
 771     GC_printf2("\nblocks = %lu, bytes = %lu\n",
 772                (unsigned long)number_of_blocks,
 773                (unsigned long)total_bytes);
 774 }
 775
 776 #endif /* NO_DEBUGGING */
 777
 778 /*
 779  * Perform GC_reclaim_block on the entire heap, after first clearing
 780  * small object free lists (if we are not just looking for leaks).
 781  */
 782 void GC_start_reclaim(report_if_found)
 783 int report_if_found;            /* Abort if a GC_reclaimable object is found */
 784 {
 785     int kind;
 786
 787     /* Clear reclaim- and free-lists */
 788       for (kind = 0; kind < GC_n_kinds; kind++) {
 789         register ptr_t *fop;
 790         register ptr_t *lim;
 791         register struct hblk ** rlp;
 792         register struct hblk ** rlim;
 793         register struct hblk ** rlist = GC_obj_kinds[kind].ok_reclaim_list;
 794
 795         if (rlist == 0) continue;       /* This kind not used.  */
 796         if (!report_if_found) {
 797             lim = &(GC_obj_kinds[kind].ok_freelist[MAXOBJSZ+1]);
 798             for( fop = GC_obj_kinds[kind].ok_freelist; fop < lim; fop++ ) {
 799               *fop = 0;
 800             }
 801         } /* otherwise free list objects are marked,    */
 802           /* and its safe to leave them                 */
 803         rlim = rlist + MAXOBJSZ+1;
 804         for( rlp = rlist; rlp < rlim; rlp++ ) {
 805             *rlp = 0;
 806         }
 807       }
 808
 809 #   ifdef PRINTBLOCKS
 810         GC_printf0("GC_reclaim: current block sizes:\n");
 811         GC_print_block_list();
 812 #   endif
 813
 814   /* Go through all heap blocks (in hblklist) and reclaim unmarked objects */
 815   /* or enqueue the block for later processing.                            */
 816     GC_apply_to_all_blocks(GC_reclaim_block, (word)report_if_found);
 817
 818 }
 819
 820 /*
 821  * Sweep blocks of the indicated object size and kind until either the
 822  * appropriate free list is nonempty, or there are no more blocks to
 823  * sweep.
 824  */
 825 void GC_continue_reclaim(sz, kind)
 826 word sz;        /* words */
 827 int kind;
 828 {
 829     register hdr * hhdr;
 830     register struct hblk * hbp;
 831     register struct obj_kind * ok = &(GC_obj_kinds[kind]);
 832     struct hblk ** rlh = ok -> ok_reclaim_list;
 833     ptr_t *flh = &(ok -> ok_freelist[sz]);
 834
 835     if (rlh == 0) return;       /* No blocks of this kind.      */
 836     rlh += sz;
 837     while ((hbp = *rlh) != 0) {
 838         hhdr = HDR(hbp);
 839         *rlh = hhdr -> hb_next;
 840         GC_reclaim_small_nonempty_block(hbp, FALSE);
 841         if (*flh != 0) break;
 842     }
 843 }
 844
 845 /*
 846  * Reclaim all small blocks waiting to be reclaimed.
 847  * Abort and return FALSE when/if (*stop_func)() returns TRUE.
 848  * If this returns TRUE, then it's safe to restart the world
 849  * with incorrectly cleared mark bits.
 850  * If ignore_old is TRUE, then reclain only blocks that have been
 851  * recently reclaimed, and discard the rest.
 852  * Stop_func may be 0.
 853  */
 854 GC_bool GC_reclaim_all(stop_func, ignore_old)
 855 GC_stop_func stop_func;
 856 GC_bool ignore_old;
 857 {
 858     register word sz;
 859     register int kind;
 860     register hdr * hhdr;
 861     register struct hblk * hbp;
 862     register struct obj_kind * ok;
 863     struct hblk ** rlp;
 864     struct hblk ** rlh;
 865 #   ifdef PRINTTIMES
 866         CLOCK_TYPE start_time;
 867         CLOCK_TYPE done_time;
 868
 869         GET_TIME(start_time);
 870 #   endif
 871
 872     for (kind = 0; kind < GC_n_kinds; kind++) {
 873         ok = &(GC_obj_kinds[kind]);
 874         rlp = ok -> ok_reclaim_list;
 875         if (rlp == 0) continue;
 876         for (sz = 1; sz <= MAXOBJSZ; sz++) {
 877             rlh = rlp + sz;
 878             while ((hbp = *rlh) != 0) {
 879                 if (stop_func != (GC_stop_func)0 && (*stop_func)()) {
 880                     return(FALSE);
 881                 }
 882                 hhdr = HDR(hbp);
 883                 *rlh = hhdr -> hb_next;
 884                 if (!ignore_old || hhdr -> hb_last_reclaimed == GC_gc_no - 1) {
 885                     /* It's likely we'll need it this time, too */
 886                     /* It's been touched recently, so this      */
 887                     /* shouldn't trigger paging.                */
 888                     GC_reclaim_small_nonempty_block(hbp, FALSE);
 889                 }
 890             }
 891         }
 892     }
 893 #   ifdef PRINTTIMES
 894         GET_TIME(done_time);
 895         GC_printf1("Disposing of reclaim lists took %lu msecs\n",
 896                    MS_TIME_DIFF(done_time,start_time));
 897 #   endif
 898     return(TRUE);
 899 }