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