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 #else /* !STUBBORN_ALLOC */
 432
 433 # ifdef __STDC__
 434     GC_PTR GC_debug_malloc_stubborn(size_t lb, GC_EXTRA_PARAMS)
 435 # else
 436     GC_PTR GC_debug_malloc_stubborn(lb, s, i)
 437     size_t lb;
 438     char * s;
 439     int i;
 440 # endif
 441 {
 442     return GC_debug_malloc(lb, OPT_RA s, i);
 443 }
 444
 445 void GC_debug_change_stubborn(p)
 446 GC_PTR p;
 447 {
 448 }
 449
 450 void GC_debug_end_stubborn_change(p)
 451 GC_PTR p;
 452 {
 453 }
 454
 455 #endif /* !STUBBORN_ALLOC */
 456
 457 # ifdef __STDC__
 458     GC_PTR GC_debug_malloc_atomic(size_t lb, GC_EXTRA_PARAMS)
 459 # else
 460     GC_PTR GC_debug_malloc_atomic(lb, s, i)
 461     size_t lb;
 462     char * s;
 463     int i;
 464 # endif
 465 {
 466     GC_PTR result = GC_malloc_atomic(lb + DEBUG_BYTES);
 467
 468     if (result == 0) {
 469         GC_err_printf1("GC_debug_malloc_atomic(%ld) returning NIL (",
 470                       (unsigned long) lb);
 471         GC_err_puts(s);
 472         GC_err_printf1(":%ld)\n", (unsigned long)i);
 473         return(0);
 474     }
 475     if (!GC_debugging_started) {
 476         GC_start_debugging();
 477     }
 478     ADD_CALL_CHAIN(result, ra);
 479     return (GC_store_debug_info(result, (word)lb, s, (word)i));
 480 }
 481
 482 # ifdef __STDC__
 483     GC_PTR GC_debug_malloc_uncollectable(size_t lb, GC_EXTRA_PARAMS)
 484 # else
 485     GC_PTR GC_debug_malloc_uncollectable(lb, s, i)
 486     size_t lb;
 487     char * s;
 488     int i;
 489 # endif
 490 {
 491     GC_PTR result = GC_malloc_uncollectable(lb + DEBUG_BYTES);
 492
 493     if (result == 0) {
 494         GC_err_printf1("GC_debug_malloc_uncollectable(%ld) returning NIL (",
 495                       (unsigned long) lb);
 496         GC_err_puts(s);
 497         GC_err_printf1(":%ld)\n", (unsigned long)i);
 498         return(0);
 499     }
 500     if (!GC_debugging_started) {
 501         GC_start_debugging();
 502     }
 503     ADD_CALL_CHAIN(result, ra);
 504     return (GC_store_debug_info(result, (word)lb, s, (word)i));
 505 }
 506
 507 #ifdef ATOMIC_UNCOLLECTABLE
 508 # ifdef __STDC__
 509     GC_PTR GC_debug_malloc_atomic_uncollectable(size_t lb, GC_EXTRA_PARAMS)
 510 # else
 511     GC_PTR GC_debug_malloc_atomic_uncollectable(lb, s, i)
 512     size_t lb;
 513     char * s;
 514     int i;
 515 # endif
 516 {
 517     GC_PTR result = GC_malloc_atomic_uncollectable(lb + DEBUG_BYTES);
 518
 519     if (result == 0) {
 520         GC_err_printf1(
 521                 "GC_debug_malloc_atomic_uncollectable(%ld) returning NIL (",
 522                 (unsigned long) lb);
 523         GC_err_puts(s);
 524         GC_err_printf1(":%ld)\n", (unsigned long)i);
 525         return(0);
 526     }
 527     if (!GC_debugging_started) {
 528         GC_start_debugging();
 529     }
 530     ADD_CALL_CHAIN(result, ra);
 531     return (GC_store_debug_info(result, (word)lb, s, (word)i));
 532 }
 533 #endif /* ATOMIC_UNCOLLECTABLE */
 534
 535 # ifdef __STDC__
 536     void GC_debug_free(GC_PTR p)
 537 # else
 538     void GC_debug_free(p)
 539     GC_PTR p;
 540 # endif
 541 {
 542     register GC_PTR base;
 543     register ptr_t clobbered;
 544
 545     if (0 == p) return;
 546     base = GC_base(p);
 547     if (base == 0) {
 548         GC_err_printf1("Attempt to free invalid pointer %lx\n",
 549                        (unsigned long)p);
 550         ABORT("free(invalid pointer)");
 551     }
 552     if ((ptr_t)p - (ptr_t)base != sizeof(oh)) {
 553         GC_err_printf1(
 554                   "GC_debug_free called on pointer %lx wo debugging info\n",
 555                   (unsigned long)p);
 556     } else {
 557       clobbered = GC_check_annotated_obj((oh *)base);
 558       if (clobbered != 0) {
 559         if (((oh *)base) -> oh_sz == GC_size(base)) {
 560             GC_err_printf0(
 561                   "GC_debug_free: found previously deallocated (?) object at ");
 562         } else {
 563             GC_err_printf0("GC_debug_free: found smashed location at ");
 564         }
 565         GC_print_smashed_obj(p, clobbered);
 566       }
 567       /* Invalidate size */
 568       ((oh *)base) -> oh_sz = GC_size(base);
 569     }
 570     if (GC_find_leak) {
 571         GC_free(base);
 572     } else {
 573         register hdr * hhdr = HDR(p);
 574         GC_bool uncollectable = FALSE;
 575
 576         if (hhdr ->  hb_obj_kind == UNCOLLECTABLE) {
 577             uncollectable = TRUE;
 578         }
 579 #       ifdef ATOMIC_UNCOLLECTABLE
 580             if (hhdr ->  hb_obj_kind == AUNCOLLECTABLE) {
 581                     uncollectable = TRUE;
 582             }
 583 #       endif
 584         if (uncollectable) GC_free(base);
 585     } /* !GC_find_leak */
 586 }
 587
 588 # ifdef __STDC__
 589     GC_PTR GC_debug_realloc(GC_PTR p, size_t lb, GC_EXTRA_PARAMS)
 590 # else
 591     GC_PTR GC_debug_realloc(p, lb, s, i)
 592     GC_PTR p;
 593     size_t lb;
 594     char *s;
 595     int i;
 596 # endif
 597 {
 598     register GC_PTR base = GC_base(p);
 599     register ptr_t clobbered;
 600     register GC_PTR result;
 601     register size_t copy_sz = lb;
 602     register size_t old_sz;
 603     register hdr * hhdr;
 604
 605     if (p == 0) return(GC_debug_malloc(lb, OPT_RA s, i));
 606     if (base == 0) {
 607         GC_err_printf1(
 608               "Attempt to reallocate invalid pointer %lx\n", (unsigned long)p);
 609         ABORT("realloc(invalid pointer)");
 610     }
 611     if ((ptr_t)p - (ptr_t)base != sizeof(oh)) {
 612         GC_err_printf1(
 613                 "GC_debug_realloc called on pointer %lx wo debugging info\n",
 614                 (unsigned long)p);
 615         return(GC_realloc(p, lb));
 616     }
 617     hhdr = HDR(base);
 618     switch (hhdr -> hb_obj_kind) {
 619 #    ifdef STUBBORN_ALLOC
 620       case STUBBORN:
 621         result = GC_debug_malloc_stubborn(lb, OPT_RA s, i);
 622         break;
 623 #    endif
 624       case NORMAL:
 625         result = GC_debug_malloc(lb, OPT_RA s, i);
 626         break;
 627       case PTRFREE:
 628         result = GC_debug_malloc_atomic(lb, OPT_RA s, i);
 629         break;
 630       case UNCOLLECTABLE:
 631         result = GC_debug_malloc_uncollectable(lb, OPT_RA s, i);
 632         break;
 633 #    ifdef ATOMIC_UNCOLLECTABLE
 634       case AUNCOLLECTABLE:
 635         result = GC_debug_malloc_atomic_uncollectable(lb, OPT_RA s, i);
 636         break;
 637 #    endif
 638       default:
 639         GC_err_printf0("GC_debug_realloc: encountered bad kind\n");
 640         ABORT("bad kind");
 641     }
 642     clobbered = GC_check_annotated_obj((oh *)base);
 643     if (clobbered != 0) {
 644         GC_err_printf0("GC_debug_realloc: found smashed location at ");
 645         GC_print_smashed_obj(p, clobbered);
 646     }
 647     old_sz = ((oh *)base) -> oh_sz;
 648     if (old_sz < copy_sz) copy_sz = old_sz;
 649     if (result == 0) return(0);
 650     BCOPY(p, result,  copy_sz);
 651     GC_debug_free(p);
 652     return(result);
 653 }
 654
 655 /* Check all marked objects in the given block for validity */
 656 /*ARGSUSED*/
 657 void GC_check_heap_block(hbp, dummy)
 658 register struct hblk *hbp;      /* ptr to current heap block            */
 659 word dummy;
 660 {
 661     register struct hblkhdr * hhdr = HDR(hbp);
 662     register word sz = hhdr -> hb_sz;
 663     register int word_no;
 664     register word *p, *plim;
 665
 666     p = (word *)(hbp->hb_body);
 667     word_no = HDR_WORDS;
 668     if (sz > MAXOBJSZ) {
 669         plim = p;
 670     } else {
 671         plim = (word *)((((word)hbp) + HBLKSIZE) - WORDS_TO_BYTES(sz));
 672     }
 673     /* go through all words in block */
 674         while( p <= plim ) {
 675             if( mark_bit_from_hdr(hhdr, word_no)
 676                 && GC_has_debug_info((ptr_t)p)) {
 677                 ptr_t clobbered = GC_check_annotated_obj((oh *)p);
 678
 679                 if (clobbered != 0) {
 680                     GC_err_printf0(
 681                         "GC_check_heap_block: found smashed location at ");
 682                     GC_print_smashed_obj((ptr_t)p, clobbered);
 683                 }
 684             }
 685             word_no += sz;
 686             p += sz;
 687         }
 688 }
 689
 690
 691 /* This assumes that all accessible objects are marked, and that        */
 692 /* I hold the allocation lock.  Normally called by collector.           */
 693 void GC_check_heap_proc()
 694 {
 695 #   ifndef SMALL_CONFIG
 696         if (sizeof(oh) & (2 * sizeof(word) - 1) != 0) {
 697             ABORT("Alignment problem: object header has inappropriate size\n");
 698         }
 699 #   endif
 700     GC_apply_to_all_blocks(GC_check_heap_block, (word)0);
 701 }
 702
 703 struct closure {
 704     GC_finalization_proc cl_fn;
 705     GC_PTR cl_data;
 706 };
 707
 708 # ifdef __STDC__
 709     void * GC_make_closure(GC_finalization_proc fn, void * data)
 710 # else
 711     GC_PTR GC_make_closure(fn, data)
 712     GC_finalization_proc fn;
 713     GC_PTR data;
 714 # endif
 715 {
 716     struct closure * result =
 717                 (struct closure *) GC_malloc(sizeof (struct closure));
 718
 719     result -> cl_fn = fn;
 720     result -> cl_data = data;
 721     return((GC_PTR)result);
 722 }
 723
 724 # ifdef __STDC__
 725     void GC_debug_invoke_finalizer(void * obj, void * data)
 726 # else
 727     void GC_debug_invoke_finalizer(obj, data)
 728     char * obj;
 729     char * data;
 730 # endif
 731 {
 732     register struct closure * cl = (struct closure *) data;
 733
 734     (*(cl -> cl_fn))((GC_PTR)((char *)obj + sizeof(oh)), cl -> cl_data);
 735 }
 736
 737
 738 # ifdef __STDC__
 739     void GC_debug_register_finalizer(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(obj, fn, cd, ofn, ocd)
 744     GC_PTR obj;
 745     GC_finalization_proc fn;
 746     GC_PTR cd;
 747     GC_finalization_proc *ofn;
 748     GC_PTR *ocd;
 749 # endif
 750 {
 751     ptr_t base = GC_base(obj);
 752     if (0 == base || (ptr_t)obj - base != sizeof(oh)) {
 753         GC_err_printf1(
 754             "GC_register_finalizer called with non-base-pointer 0x%lx\n",
 755             obj);
 756     }
 757     GC_register_finalizer(base, GC_debug_invoke_finalizer,
 758                           GC_make_closure(fn,cd), ofn, ocd);
 759 }
 760
 761 # ifdef __STDC__
 762     void GC_debug_register_finalizer_no_order
 763                                     (GC_PTR obj, GC_finalization_proc fn,
 764                                      GC_PTR cd, GC_finalization_proc *ofn,
 765                                      GC_PTR *ocd)
 766 # else
 767     void GC_debug_register_finalizer_no_order
 768                                     (obj, fn, cd, ofn, ocd)
 769     GC_PTR obj;
 770     GC_finalization_proc fn;
 771     GC_PTR cd;
 772     GC_finalization_proc *ofn;
 773     GC_PTR *ocd;
 774 # endif
 775 {
 776     ptr_t base = GC_base(obj);
 777     if (0 == base || (ptr_t)obj - base != sizeof(oh)) {
 778         GC_err_printf1(
 779           "GC_register_finalizer_no_order called with non-base-pointer 0x%lx\n",
 780           obj);
 781     }
 782     GC_register_finalizer_no_order(base, GC_debug_invoke_finalizer,
 783                                       GC_make_closure(fn,cd), ofn, ocd);
 784  }
 785
 786 # ifdef __STDC__
 787     void GC_debug_register_finalizer_ignore_self
 788                                     (GC_PTR obj, GC_finalization_proc fn,
 789                                      GC_PTR cd, GC_finalization_proc *ofn,
 790                                      GC_PTR *ocd)
 791 # else
 792     void GC_debug_register_finalizer_ignore_self
 793                                     (obj, fn, cd, ofn, ocd)
 794     GC_PTR obj;
 795     GC_finalization_proc fn;
 796     GC_PTR cd;
 797     GC_finalization_proc *ofn;
 798     GC_PTR *ocd;
 799 # endif
 800 {
 801     ptr_t base = GC_base(obj);
 802     if (0 == base || (ptr_t)obj - base != sizeof(oh)) {
 803         GC_err_printf1(
 804             "GC_register_finalizer_ignore_self called with non-base-pointer 0x%lx\n",
 805             obj);
 806     }
 807     GC_register_finalizer_ignore_self(base, GC_debug_invoke_finalizer,
 808                                       GC_make_closure(fn,cd), ofn, ocd);
 809 }