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