boehm-gc/dbg_mlc.c

   1 /*
   2  * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
   3  * Copyright (c) 1991-1995 by Xerox Corporation.  All rights reserved.
   4  * Copyright (c) 1997 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 "dbg_mlc.h"
  18
  19 void GC_default_print_heap_obj_proc();
  20 GC_API void GC_register_finalizer_no_order
  21         GC_PROTO((GC_PTR obj, GC_finalization_proc fn, GC_PTR cd,
  22                   GC_finalization_proc *ofn, GC_PTR *ocd));
  23
  24
  25 /* Check whether object with base pointer p has debugging info  */
  26 /* p is assumed to point to a legitimate object in our part     */
  27 /* of the heap.                                                 */
  28 GC_bool GC_has_debug_info(p)
  29 ptr_t p;
  30 {
  31     register oh * ohdr = (oh *)p;
  32     register ptr_t body = (ptr_t)(ohdr + 1);
  33     register word sz = GC_size((ptr_t) ohdr);
  34
  35     if (HBLKPTR((ptr_t)ohdr) != HBLKPTR((ptr_t)body)
  36         || sz < sizeof (oh)) {
  37         return(FALSE);
  38     }
  39     if (ohdr -> oh_sz == sz) {
  40         /* Object may have had debug info, but has been deallocated     */
  41         return(FALSE);
  42     }
  43     if (ohdr -> oh_sf == (START_FLAG ^ (word)body)) return(TRUE);
  44     if (((word *)ohdr)[BYTES_TO_WORDS(sz)-1] == (END_FLAG ^ (word)body)) {
  45         return(TRUE);
  46     }
  47     return(FALSE);
  48 }
  49
  50 #ifdef KEEP_BACK_PTRS
  51   /* Store back pointer to source in dest, if that appears to be possible. */
  52   /* This is not completely safe, since we may mistakenly conclude that    */
  53   /* dest has a debugging wrapper.  But the error probability is very      */
  54   /* small, and this shouldn't be used in production code.                 */
  55   /* We assume that dest is the real base pointer.  Source will usually    */
  56   /* be a pointer to the interior of an object.                            */
  57   void GC_store_back_pointer(ptr_t source, ptr_t dest)
  58   {
  59     if (GC_has_debug_info(dest)) {
  60       ((oh *)dest) -> oh_back_ptr = (ptr_t)HIDE_POINTER(source);
  61     }
  62   }
  63
  64   void GC_marked_for_finalization(ptr_t dest) {
  65     GC_store_back_pointer(MARKED_FOR_FINALIZATION, dest);
  66   }
  67
  68   /* Store information about the object referencing dest in *base_p     */
  69   /* and *offset_p.                                                     */
  70   /*   source is root ==> *base_p = address, *offset_p = 0              */
  71   /*   source is heap object ==> *base_p != 0, *offset_p = offset       */
  72   /*   Returns 1 on success, 0 if source couldn't be determined.        */
  73   /* Dest can be any address within a heap object.                      */
  74   GC_ref_kind GC_get_back_ptr_info(void *dest, void **base_p, size_t *offset_p)
  75   {
  76     oh * hdr = (oh *)GC_base(dest);
  77     ptr_t bp;
  78     ptr_t bp_base;
  79     if (!GC_has_debug_info((ptr_t) hdr)) return GC_NO_SPACE;
  80     bp = hdr -> oh_back_ptr;
  81     if (MARKED_FOR_FINALIZATION == bp) return GC_FINALIZER_REFD;
  82     if (MARKED_FROM_REGISTER == bp) return GC_REFD_FROM_REG;
  83     if (0 == bp) return GC_UNREFERENCED;
  84     bp = REVEAL_POINTER(bp);
  85     bp_base = GC_base(bp);
  86     if (0 == bp_base) {
  87       *base_p = bp;
  88       *offset_p = 0;
  89       return GC_REFD_FROM_ROOT;
  90     } else {
  91       if (GC_has_debug_info(bp_base)) bp_base += sizeof(oh);
  92       *base_p = bp_base;
  93       *offset_p = bp - bp_base;
  94       return GC_REFD_FROM_HEAP;
  95     }
  96   }
  97
  98   /* Generate a random heap address.            */
  99   /* The resulting address is in the heap, but  */
 100   /* not necessarily inside a valid object.     */
 101   void *GC_generate_random_heap_address(void)
 102   {
 103     int i;
 104     int heap_offset = random() % GC_heapsize;
 105     for (i = 0; i < GC_n_heap_sects; ++ i) {
 106         int size = GC_heap_sects[i].hs_bytes;
 107         if (heap_offset < size) {
 108             return GC_heap_sects[i].hs_start + heap_offset;
 109         } else {
 110             heap_offset -= size;
 111         }
 112     }
 113     ABORT("GC_generate_random_heap_address: size inconsistency");
 114     /*NOTREACHED*/
 115     return 0;
 116   }
 117
 118   /* Generate a random address inside a valid marked heap object. */
 119   void *GC_generate_random_valid_address(void)
 120   {
 121     ptr_t result;
 122     ptr_t base;
 123     for (;;) {
 124         result = GC_generate_random_heap_address();
 125         base = GC_base(result);
 126         if (0 == base) continue;
 127         if (!GC_is_marked(base)) continue;
 128         return result;
 129     }
 130   }
 131
 132   /* Print back trace for p */
 133   void GC_print_backtrace(void *p)
 134   {
 135     void *current = p;
 136     int i;
 137     GC_ref_kind source;
 138     size_t offset;
 139     void *base;
 140
 141     GC_print_heap_obj(GC_base(current));
 142     GC_err_printf0("\n");
 143     for (i = 0; ; ++i) {
 144       source = GC_get_back_ptr_info(current, &base, &offset);
 145       if (GC_UNREFERENCED == source) {
 146         GC_err_printf0("Reference could not be found\n");
 147         goto out;
 148       }
 149       if (GC_NO_SPACE == source) {
 150         GC_err_printf0("No debug info in object: Can't find reference\n");
 151         goto out;
 152       }
 153       GC_err_printf1("Reachable via %d levels of pointers from ",
 154                  (unsigned long)i);
 155       switch(source) {
 156         case GC_REFD_FROM_ROOT:
 157           GC_err_printf1("root at 0x%lx\n", (unsigned long)base);
 158           goto out;
 159         case GC_REFD_FROM_REG:
 160           GC_err_printf0("root in register\n");
 161           goto out;
 162         case GC_FINALIZER_REFD:
 163           GC_err_printf0("list of finalizable objects\n");
 164           goto out;
 165         case GC_REFD_FROM_HEAP:
 166           GC_err_printf1("offset %ld in object:\n", (unsigned long)offset);
 167           /* Take GC_base(base) to get real base, i.e. header. */
 168           GC_print_heap_obj(GC_base(base));
 169           GC_err_printf0("\n");
 170           break;
 171       }
 172       current = base;
 173     }
 174     out:;
 175   }
 176
 177   /* Force a garbage collection and generate a backtrace from a */
 178   /* random heap address.                                       */
 179   void GC_generate_random_backtrace(void)
 180   {
 181     void * current;
 182     GC_gcollect();
 183     current = GC_generate_random_valid_address();
 184     GC_printf1("Chose address 0x%lx in object\n", (unsigned long)current);
 185     GC_print_backtrace(current);
 186   }
 187
 188 #endif /* KEEP_BACK_PTRS */
 189
 190 /* Store debugging info into p.  Return displaced pointer. */
 191 /* Assumes we don't hold allocation lock.                  */
 192 ptr_t GC_store_debug_info(p, sz, string, integer)
 193 register ptr_t p;       /* base pointer */
 194 word sz;        /* bytes */
 195 char * string;
 196 word integer;
 197 {
 198     register word * result = (word *)((oh *)p + 1);
 199     DCL_LOCK_STATE;
 200
 201     /* There is some argument that we should dissble signals here.      */
 202     /* But that's expensive.  And this way things should only appear    */
 203     /* inconsistent while we're in the handler.                         */
 204     LOCK();
 205 #   ifdef KEEP_BACK_PTRS
 206       ((oh *)p) -> oh_back_ptr = 0;
 207 #   endif
 208     ((oh *)p) -> oh_string = string;
 209     ((oh *)p) -> oh_int = integer;
 210     ((oh *)p) -> oh_sz = sz;
 211     ((oh *)p) -> oh_sf = START_FLAG ^ (word)result;
 212     ((word *)p)[BYTES_TO_WORDS(GC_size(p))-1] =
 213          result[ROUNDED_UP_WORDS(sz)] = END_FLAG ^ (word)result;
 214     UNLOCK();
 215     return((ptr_t)result);
 216 }
 217
 218 /* Check the object with debugging info at ohdr         */
 219 /* return NIL if it's OK.  Else return clobbered        */
 220 /* address.                                             */
 221 ptr_t GC_check_annotated_obj(ohdr)
 222 register oh * ohdr;
 223 {
 224     register ptr_t body = (ptr_t)(ohdr + 1);
 225     register word gc_sz = GC_size((ptr_t)ohdr);
 226     if (ohdr -> oh_sz + DEBUG_BYTES > gc_sz) {
 227         return((ptr_t)(&(ohdr -> oh_sz)));
 228     }
 229     if (ohdr -> oh_sf != (START_FLAG ^ (word)body)) {
 230         return((ptr_t)(&(ohdr -> oh_sf)));
 231     }
 232     if (((word *)ohdr)[BYTES_TO_WORDS(gc_sz)-1] != (END_FLAG ^ (word)body)) {
 233         return((ptr_t)((word *)ohdr + BYTES_TO_WORDS(gc_sz)-1));
 234     }
 235     if (((word *)body)[ROUNDED_UP_WORDS(ohdr -> oh_sz)]
 236         != (END_FLAG ^ (word)body)) {
 237         return((ptr_t)((word *)body + ROUNDED_UP_WORDS(ohdr -> oh_sz)));
 238     }
 239     return(0);
 240 }
 241
 242 void GC_print_obj(p)
 243 ptr_t p;
 244 {
 245     register oh * ohdr = (oh *)GC_base(p);
 246
 247     GC_err_printf1("0x%lx (", ((unsigned long)ohdr + sizeof(oh)));
 248     GC_err_puts(ohdr -> oh_string);
 249     GC_err_printf2(":%ld, sz=%ld)\n", (unsigned long)(ohdr -> oh_int),
 250                                       (unsigned long)(ohdr -> oh_sz));
 251     PRINT_CALL_CHAIN(ohdr);
 252 }
 253
 254 void GC_debug_print_heap_obj_proc(p)
 255 ptr_t p;
 256 {
 257     if (GC_has_debug_info(p)) {
 258         GC_print_obj(p);
 259     } else {
 260         GC_default_print_heap_obj_proc(p);
 261     }
 262 }
 263
 264 void GC_print_smashed_obj(p, clobbered_addr)
 265 ptr_t p, clobbered_addr;
 266 {
 267     register oh * ohdr = (oh *)GC_base(p);
 268
 269     GC_err_printf2("0x%lx in object at 0x%lx(", (unsigned long)clobbered_addr,
 270                                                 (unsigned long)p);
 271     if (clobbered_addr <= (ptr_t)(&(ohdr -> oh_sz))
 272         || ohdr -> oh_string == 0) {
 273         GC_err_printf1("<smashed>, appr. sz = %ld)\n",
 274                        (GC_size((ptr_t)ohdr) - DEBUG_BYTES));
 275     } else {
 276         if (ohdr -> oh_string[0] == '\0') {
 277             GC_err_puts("EMPTY(smashed?)");
 278         } else {
 279             GC_err_puts(ohdr -> oh_string);
 280         }
 281         GC_err_printf2(":%ld, sz=%ld)\n", (unsigned long)(ohdr -> oh_int),
 282                                           (unsigned long)(ohdr -> oh_sz));
 283         PRINT_CALL_CHAIN(ohdr);
 284     }
 285 }
 286
 287 void GC_check_heap_proc();
 288
 289 void GC_start_debugging()
 290 {
 291     GC_check_heap = GC_check_heap_proc;
 292     GC_print_heap_obj = GC_debug_print_heap_obj_proc;
 293     GC_debugging_started = TRUE;
 294     GC_register_displacement((word)sizeof(oh));
 295 }
 296
 297 # if defined(__STDC__) || defined(__cplusplus)
 298     void GC_debug_register_displacement(GC_word offset)
 299 # else
 300     void GC_debug_register_displacement(offset)
 301     GC_word offset;
 302 # endif
 303 {
 304     GC_register_displacement(offset);
 305     GC_register_displacement((word)sizeof(oh) + offset);
 306 }
 307
 308 # ifdef __STDC__
 309     GC_PTR GC_debug_malloc(size_t lb, GC_EXTRA_PARAMS)
 310 # else
 311     GC_PTR GC_debug_malloc(lb, s, i)
 312     size_t lb;
 313     char * s;
 314     int i;
 315 #   ifdef GC_ADD_CALLER
 316         --> GC_ADD_CALLER not implemented for K&R C
 317 #   endif
 318 # endif
 319 {
 320     GC_PTR result = GC_malloc(lb + DEBUG_BYTES);
 321
 322     if (result == 0) {
 323         GC_err_printf1("GC_debug_malloc(%ld) returning NIL (",
 324                        (unsigned long) lb);
 325         GC_err_puts(s);
 326         GC_err_printf1(":%ld)\n", (unsigned long)i);
 327         return(0);
 328     }
 329     if (!GC_debugging_started) {
 330         GC_start_debugging();
 331     }
 332     ADD_CALL_CHAIN(result, ra);
 333     return (GC_store_debug_info(result, (word)lb, s, (word)i));
 334 }
 335
 336 # ifdef __STDC__
 337     GC_PTR GC_debug_generic_malloc(size_t lb, int k, GC_EXTRA_PARAMS)
 338 # else
 339     GC_PTR GC_debug_malloc(lb, k, s, i)
 340     size_t lb;
 341     int k;
 342     char * s;
 343     int i;
 344 #   ifdef GC_ADD_CALLER
 345         --> GC_ADD_CALLER not implemented for K&R C
 346 #   endif
 347 # endif
 348 {
 349     GC_PTR result = GC_generic_malloc(lb + DEBUG_BYTES, k);
 350
 351     if (result == 0) {
 352         GC_err_printf1("GC_debug_malloc(%ld) returning NIL (",
 353                        (unsigned long) lb);
 354         GC_err_puts(s);
 355         GC_err_printf1(":%ld)\n", (unsigned long)i);
 356         return(0);
 357     }
 358     if (!GC_debugging_started) {
 359         GC_start_debugging();
 360     }
 361     ADD_CALL_CHAIN(result, ra);
 362     return (GC_store_debug_info(result, (word)lb, s, (word)i));
 363 }
 364
 365 #ifdef STUBBORN_ALLOC
 366 # ifdef __STDC__
 367     GC_PTR GC_debug_malloc_stubborn(size_t lb, GC_EXTRA_PARAMS)
 368 # else
 369     GC_PTR GC_debug_malloc_stubborn(lb, s, i)
 370     size_t lb;
 371     char * s;
 372     int i;
 373 # endif
 374 {
 375     GC_PTR result = GC_malloc_stubborn(lb + DEBUG_BYTES);
 376
 377     if (result == 0) {
 378         GC_err_printf1("GC_debug_malloc(%ld) returning NIL (",
 379                        (unsigned long) lb);
 380         GC_err_puts(s);
 381         GC_err_printf1(":%ld)\n", (unsigned long)i);
 382         return(0);
 383     }
 384     if (!GC_debugging_started) {
 385         GC_start_debugging();
 386     }
 387     ADD_CALL_CHAIN(result, ra);
 388     return (GC_store_debug_info(result, (word)lb, s, (word)i));
 389 }
 390
 391 void GC_debug_change_stubborn(p)
 392 GC_PTR p;
 393 {
 394     register GC_PTR q = GC_base(p);
 395     register hdr * hhdr;
 396
 397     if (q == 0) {
 398         GC_err_printf1("Bad argument: 0x%lx to GC_debug_change_stubborn\n",
 399                        (unsigned long) p);
 400         ABORT("GC_debug_change_stubborn: bad arg");
 401     }
 402     hhdr = HDR(q);
 403     if (hhdr -> hb_obj_kind != STUBBORN) {
 404         GC_err_printf1("GC_debug_change_stubborn arg not stubborn: 0x%lx\n",
 405                        (unsigned long) p);
 406         ABORT("GC_debug_change_stubborn: arg not stubborn");
 407     }
 408     GC_change_stubborn(q);
 409 }
 410
 411 void GC_debug_end_stubborn_change(p)
 412 GC_PTR p;
 413 {
 414     register GC_PTR q = GC_base(p);
 415     register hdr * hhdr;
 416
 417     if (q == 0) {
 418         GC_err_printf1("Bad argument: 0x%lx to GC_debug_end_stubborn_change\n",
 419                        (unsigned long) p);
 420         ABORT("GC_debug_end_stubborn_change: bad arg");
 421     }
 422     hhdr = HDR(q);
 423     if (hhdr -> hb_obj_kind != STUBBORN) {
 424         GC_err_printf1("debug_end_stubborn_change arg not stubborn: 0x%lx\n",
 425                        (unsigned long) p);
 426         ABORT("GC_debug_end_stubborn_change: arg not stubborn");
 427     }
 428     GC_end_stubborn_change(q);
 429 }
 430
 431 #endif /* STUBBORN_ALLOC */
 432
 433 # ifdef __STDC__
 434     GC_PTR GC_debug_malloc_atomic(size_t lb, GC_EXTRA_PARAMS)
 435 # else
 436     GC_PTR GC_debug_malloc_atomic(lb, s, i)
 437     size_t lb;
 438     char * s;
 439     int i;
 440 # endif
 441 {
 442     GC_PTR result = GC_malloc_atomic(lb + DEBUG_BYTES);
 443
 444     if (result == 0) {
 445         GC_err_printf1("GC_debug_malloc_atomic(%ld) returning NIL (",
 446                       (unsigned long) lb);
 447         GC_err_puts(s);
 448         GC_err_printf1(":%ld)\n", (unsigned long)i);
 449         return(0);
 450     }
 451     if (!GC_debugging_started) {
 452         GC_start_debugging();
 453     }
 454     ADD_CALL_CHAIN(result, ra);
 455     return (GC_store_debug_info(result, (word)lb, s, (word)i));
 456 }
 457
 458 # ifdef __STDC__
 459     GC_PTR GC_debug_malloc_uncollectable(size_t lb, GC_EXTRA_PARAMS)
 460 # else
 461     GC_PTR GC_debug_malloc_uncollectable(lb, s, i)
 462     size_t lb;
 463     char * s;
 464     int i;
 465 # endif
 466 {
 467     GC_PTR result = GC_malloc_uncollectable(lb + DEBUG_BYTES);
 468
 469     if (result == 0) {
 470         GC_err_printf1("GC_debug_malloc_uncollectable(%ld) returning NIL (",
 471                       (unsigned long) lb);
 472         GC_err_puts(s);
 473         GC_err_printf1(":%ld)\n", (unsigned long)i);
 474         return(0);
 475     }
 476     if (!GC_debugging_started) {
 477         GC_start_debugging();
 478     }
 479     ADD_CALL_CHAIN(result, ra);
 480     return (GC_store_debug_info(result, (word)lb, s, (word)i));
 481 }
 482
 483 #ifdef ATOMIC_UNCOLLECTABLE
 484 # ifdef __STDC__
 485     GC_PTR GC_debug_malloc_atomic_uncollectable(size_t lb, GC_EXTRA_PARAMS)
 486 # else
 487     GC_PTR GC_debug_malloc_atomic_uncollectable(lb, s, i)
 488     size_t lb;
 489     char * s;
 490     int i;
 491 # endif
 492 {
 493     GC_PTR result = GC_malloc_atomic_uncollectable(lb + DEBUG_BYTES);
 494
 495     if (result == 0) {
 496         GC_err_printf1(
 497                 "GC_debug_malloc_atomic_uncollectable(%ld) returning NIL (",
 498                 (unsigned long) lb);
 499         GC_err_puts(s);
 500         GC_err_printf1(":%ld)\n", (unsigned long)i);
 501         return(0);
 502     }
 503     if (!GC_debugging_started) {
 504         GC_start_debugging();
 505     }
 506     ADD_CALL_CHAIN(result, ra);
 507     return (GC_store_debug_info(result, (word)lb, s, (word)i));
 508 }
 509 #endif /* ATOMIC_UNCOLLECTABLE */
 510
 511 # ifdef __STDC__
 512     void GC_debug_free(GC_PTR p)
 513 # else
 514     void GC_debug_free(p)
 515     GC_PTR p;
 516 # endif
 517 {
 518     register GC_PTR base;
 519     register ptr_t clobbered;
 520
 521     if (0 == p) return;
 522     base = GC_base(p);
 523     if (base == 0) {
 524         GC_err_printf1("Attempt to free invalid pointer %lx\n",
 525                        (unsigned long)p);
 526         ABORT("free(invalid pointer)");
 527     }
 528     if ((ptr_t)p - (ptr_t)base != sizeof(oh)) {
 529         GC_err_printf1(
 530                   "GC_debug_free called on pointer %lx wo debugging info\n",
 531                   (unsigned long)p);
 532     } else {
 533       clobbered = GC_check_annotated_obj((oh *)base);
 534       if (clobbered != 0) {
 535         if (((oh *)base) -> oh_sz == GC_size(base)) {
 536             GC_err_printf0(
 537                   "GC_debug_free: found previously deallocated (?) object at ");
 538         } else {
 539             GC_err_printf0("GC_debug_free: found smashed location at ");
 540         }
 541         GC_print_smashed_obj(p, clobbered);
 542       }
 543       /* Invalidate size */
 544       ((oh *)base) -> oh_sz = GC_size(base);
 545     }
 546     if (GC_find_leak) {
 547         GC_free(base);
 548     } else {
 549         register hdr * hhdr = HDR(p);
 550         GC_bool uncollectable = FALSE;
 551
 552         if (hhdr ->  hb_obj_kind == UNCOLLECTABLE) {
 553             uncollectable = TRUE;
 554         }
 555 #       ifdef ATOMIC_UNCOLLECTABLE
 556             if (hhdr ->  hb_obj_kind == AUNCOLLECTABLE) {
 557                     uncollectable = TRUE;
 558             }
 559 #       endif
 560         if (uncollectable) GC_free(base);
 561     } /* !GC_find_leak */
 562 }
 563
 564 # ifdef __STDC__
 565     GC_PTR GC_debug_realloc(GC_PTR p, size_t lb, GC_EXTRA_PARAMS)
 566 # else
 567     GC_PTR GC_debug_realloc(p, lb, s, i)
 568     GC_PTR p;
 569     size_t lb;
 570     char *s;
 571     int i;
 572 # endif
 573 {
 574     register GC_PTR base = GC_base(p);
 575     register ptr_t clobbered;
 576     register GC_PTR result;
 577     register size_t copy_sz = lb;
 578     register size_t old_sz;
 579     register hdr * hhdr;
 580
 581     if (p == 0) return(GC_debug_malloc(lb, OPT_RA s, i));
 582     if (base == 0) {
 583         GC_err_printf1(
 584               "Attempt to reallocate invalid pointer %lx\n", (unsigned long)p);
 585         ABORT("realloc(invalid pointer)");
 586     }
 587     if ((ptr_t)p - (ptr_t)base != sizeof(oh)) {
 588         GC_err_printf1(
 589                 "GC_debug_realloc called on pointer %lx wo debugging info\n",
 590                 (unsigned long)p);
 591         return(GC_realloc(p, lb));
 592     }
 593     hhdr = HDR(base);
 594     switch (hhdr -> hb_obj_kind) {
 595 #    ifdef STUBBORN_ALLOC
 596       case STUBBORN:
 597         result = GC_debug_malloc_stubborn(lb, OPT_RA s, i);
 598         break;
 599 #    endif
 600       case NORMAL:
 601         result = GC_debug_malloc(lb, OPT_RA s, i);
 602         break;
 603       case PTRFREE:
 604         result = GC_debug_malloc_atomic(lb, OPT_RA s, i);
 605         break;
 606       case UNCOLLECTABLE:
 607         result = GC_debug_malloc_uncollectable(lb, OPT_RA s, i);
 608         break;
 609 #    ifdef ATOMIC_UNCOLLECTABLE
 610       case AUNCOLLECTABLE:
 611         result = GC_debug_malloc_atomic_uncollectable(lb, OPT_RA s, i);
 612         break;
 613 #    endif
 614       default:
 615         GC_err_printf0("GC_debug_realloc: encountered bad kind\n");
 616         ABORT("bad kind");
 617     }
 618     clobbered = GC_check_annotated_obj((oh *)base);
 619     if (clobbered != 0) {
 620         GC_err_printf0("GC_debug_realloc: found smashed location at ");
 621         GC_print_smashed_obj(p, clobbered);
 622     }
 623     old_sz = ((oh *)base) -> oh_sz;
 624     if (old_sz < copy_sz) copy_sz = old_sz;
 625     if (result == 0) return(0);
 626     BCOPY(p, result,  copy_sz);
 627     GC_debug_free(p);
 628     return(result);
 629 }
 630
 631 /* Check all marked objects in the given block for validity */
 632 /*ARGSUSED*/
 633 void GC_check_heap_block(hbp, dummy)
 634 register struct hblk *hbp;      /* ptr to current heap block            */
 635 word dummy;
 636 {
 637     register struct hblkhdr * hhdr = HDR(hbp);
 638     register word sz = hhdr -> hb_sz;
 639     register int word_no;
 640     register word *p, *plim;
 641
 642     p = (word *)(hbp->hb_body);
 643     word_no = HDR_WORDS;
 644     if (sz > MAXOBJSZ) {
 645         plim = p;
 646     } else {
 647         plim = (word *)((((word)hbp) + HBLKSIZE) - WORDS_TO_BYTES(sz));
 648     }
 649     /* go through all words in block */
 650         while( p <= plim ) {
 651             if( mark_bit_from_hdr(hhdr, word_no)
 652                 && GC_has_debug_info((ptr_t)p)) {
 653                 ptr_t clobbered = GC_check_annotated_obj((oh *)p);
 654
 655                 if (clobbered != 0) {
 656                     GC_err_printf0(
 657                         "GC_check_heap_block: found smashed location at ");
 658                     GC_print_smashed_obj((ptr_t)p, clobbered);
 659                 }
 660             }
 661             word_no += sz;
 662             p += sz;
 663         }
 664 }
 665
 666
 667 /* This assumes that all accessible objects are marked, and that        */
 668 /* I hold the allocation lock.  Normally called by collector.           */
 669 void GC_check_heap_proc()
 670 {
 671 #   ifndef SMALL_CONFIG
 672         if (sizeof(oh) & (2 * sizeof(word) - 1) != 0) {
 673             ABORT("Alignment problem: object header has inappropriate size\n");
 674         }
 675 #   endif
 676     GC_apply_to_all_blocks(GC_check_heap_block, (word)0);
 677 }
 678
 679 struct closure {
 680     GC_finalization_proc cl_fn;
 681     GC_PTR cl_data;
 682 };
 683
 684 # ifdef __STDC__
 685     void * GC_make_closure(GC_finalization_proc fn, void * data)
 686 # else
 687     GC_PTR GC_make_closure(fn, data)
 688     GC_finalization_proc fn;
 689     GC_PTR data;
 690 # endif
 691 {
 692     struct closure * result =
 693                 (struct closure *) GC_malloc(sizeof (struct closure));
 694
 695     result -> cl_fn = fn;
 696     result -> cl_data = data;
 697     return((GC_PTR)result);
 698 }
 699
 700 # ifdef __STDC__
 701     void GC_debug_invoke_finalizer(void * obj, void * data)
 702 # else
 703     void GC_debug_invoke_finalizer(obj, data)
 704     char * obj;
 705     char * data;
 706 # endif
 707 {
 708     register struct closure * cl = (struct closure *) data;
 709
 710     (*(cl -> cl_fn))((GC_PTR)((char *)obj + sizeof(oh)), cl -> cl_data);
 711 }
 712
 713
 714 # ifdef __STDC__
 715     void GC_debug_register_finalizer(GC_PTR obj, GC_finalization_proc fn,
 716                                      GC_PTR cd, GC_finalization_proc *ofn,
 717                                      GC_PTR *ocd)
 718 # else
 719     void GC_debug_register_finalizer(obj, fn, cd, ofn, ocd)
 720     GC_PTR obj;
 721     GC_finalization_proc fn;
 722     GC_PTR cd;
 723     GC_finalization_proc *ofn;
 724     GC_PTR *ocd;
 725 # endif
 726 {
 727     ptr_t base = GC_base(obj);
 728     if (0 == base || (ptr_t)obj - base != sizeof(oh)) {
 729         GC_err_printf1(
 730             "GC_register_finalizer called with non-base-pointer 0x%lx\n",
 731             obj);
 732     }
 733     GC_register_finalizer(base, GC_debug_invoke_finalizer,
 734                           GC_make_closure(fn,cd), ofn, ocd);
 735 }
 736
 737 # ifdef __STDC__
 738     void GC_debug_register_finalizer_no_order
 739                                     (GC_PTR obj, GC_finalization_proc fn,
 740                                      GC_PTR cd, GC_finalization_proc *ofn,
 741                                      GC_PTR *ocd)
 742 # else
 743     void GC_debug_register_finalizer_no_order
 744                                     (obj, fn, cd, ofn, ocd)
 745     GC_PTR obj;
 746     GC_finalization_proc fn;
 747     GC_PTR cd;
 748     GC_finalization_proc *ofn;
 749     GC_PTR *ocd;
 750 # endif
 751 {
 752     ptr_t base = GC_base(obj);
 753     if (0 == base || (ptr_t)obj - base != sizeof(oh)) {
 754         GC_err_printf1(
 755           "GC_register_finalizer_no_order called with non-base-pointer 0x%lx\n",
 756           obj);
 757     }
 758     GC_register_finalizer_no_order(base, GC_debug_invoke_finalizer,
 759                                       GC_make_closure(fn,cd), ofn, ocd);
 760  }
 761
 762 # ifdef __STDC__
 763     void GC_debug_register_finalizer_ignore_self
 764                                     (GC_PTR obj, GC_finalization_proc fn,
 765                                      GC_PTR cd, GC_finalization_proc *ofn,
 766                                      GC_PTR *ocd)
 767 # else
 768     void GC_debug_register_finalizer_ignore_self
 769                                     (obj, fn, cd, ofn, ocd)
 770     GC_PTR obj;
 771     GC_finalization_proc fn;
 772     GC_PTR cd;
 773     GC_finalization_proc *ofn;
 774     GC_PTR *ocd;
 775 # endif
 776 {
 777     ptr_t base = GC_base(obj);
 778     if (0 == base || (ptr_t)obj - base != sizeof(oh)) {
 779         GC_err_printf1(
 780             "GC_register_finalizer_ignore_self called with non-base-pointer 0x%lx\n",
 781             obj);
 782     }
 783     GC_register_finalizer_ignore_self(base, GC_debug_invoke_finalizer,
 784                                       GC_make_closure(fn,cd), ofn, ocd);
 785 }