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-2000 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 "private/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 #ifndef SHORT_DBG_HDRS
  26 /* Check whether object with base pointer p has debugging info  */
  27 /* p is assumed to point to a legitimate object in our part     */
  28 /* of the heap.                                                 */
  29 /* This excludes the check as to whether the back pointer is    */
  30 /* odd, which is added by the GC_HAS_DEBUG_INFO macro.          */
  31 /* Note that if DBG_HDRS_ALL is set, uncollectable objects      */
  32 /* on free lists may not have debug information set.  Thus it's */
  33 /* not always safe to return TRUE, even if the client does      */
  34 /* its part.                                                    */
  35 GC_bool GC_has_other_debug_info(p)
  36 ptr_t p;
  37 {
  38     register oh * ohdr = (oh *)p;
  39     register ptr_t body = (ptr_t)(ohdr + 1);
  40     register word sz = GC_size((ptr_t) ohdr);
  41
  42     if (HBLKPTR((ptr_t)ohdr) != HBLKPTR((ptr_t)body)
  43         || sz < sizeof (oh)) {
  44         return(FALSE);
  45     }
  46     if (ohdr -> oh_sz == sz) {
  47         /* Object may have had debug info, but has been deallocated     */
  48         return(FALSE);
  49     }
  50     if (ohdr -> oh_sf == (START_FLAG ^ (word)body)) return(TRUE);
  51     if (((word *)ohdr)[BYTES_TO_WORDS(sz)-1] == (END_FLAG ^ (word)body)) {
  52         return(TRUE);
  53     }
  54     return(FALSE);
  55 }
  56 #endif
  57
  58 #ifdef KEEP_BACK_PTRS
  59
  60 # include <stdlib.h>
  61
  62 # if defined(LINUX) || defined(SUNOS4) || defined(SUNOS5) \
  63      || defined(HPUX) || defined(IRIX) || defined(OSF1)
  64 #   define RANDOM() random()
  65 # else
  66 #   define RANDOM() (long)rand()
  67 # endif
  68
  69   /* Store back pointer to source in dest, if that appears to be possible. */
  70   /* This is not completely safe, since we may mistakenly conclude that    */
  71   /* dest has a debugging wrapper.  But the error probability is very      */
  72   /* small, and this shouldn't be used in production code.                 */
  73   /* We assume that dest is the real base pointer.  Source will usually    */
  74   /* be a pointer to the interior of an object.                            */
  75   void GC_store_back_pointer(ptr_t source, ptr_t dest)
  76   {
  77     if (GC_HAS_DEBUG_INFO(dest)) {
  78       ((oh *)dest) -> oh_back_ptr = HIDE_BACK_PTR(source);
  79     }
  80   }
  81
  82   void GC_marked_for_finalization(ptr_t dest) {
  83     GC_store_back_pointer(MARKED_FOR_FINALIZATION, dest);
  84   }
  85
  86   /* Store information about the object referencing dest in *base_p     */
  87   /* and *offset_p.                                                     */
  88   /*   source is root ==> *base_p = address, *offset_p = 0              */
  89   /*   source is heap object ==> *base_p != 0, *offset_p = offset       */
  90   /*   Returns 1 on success, 0 if source couldn't be determined.        */
  91   /* Dest can be any address within a heap object.                      */
  92   GC_ref_kind GC_get_back_ptr_info(void *dest, void **base_p, size_t *offset_p)
  93   {
  94     oh * hdr = (oh *)GC_base(dest);
  95     ptr_t bp;
  96     ptr_t bp_base;
  97     if (!GC_HAS_DEBUG_INFO((ptr_t) hdr)) return GC_NO_SPACE;
  98     bp = REVEAL_POINTER(hdr -> oh_back_ptr);
  99     if (MARKED_FOR_FINALIZATION == bp) return GC_FINALIZER_REFD;
 100     if (MARKED_FROM_REGISTER == bp) return GC_REFD_FROM_REG;
 101     if (NOT_MARKED == bp) return GC_UNREFERENCED;
 102 #   if ALIGNMENT == 1
 103       /* Heuristically try to fix off by 1 errors we introduced by      */
 104       /* insisting on even addresses.                                   */
 105       {
 106         ptr_t alternate_ptr = bp + 1;
 107         ptr_t target = *(ptr_t *)bp;
 108         ptr_t alternate_target = *(ptr_t *)alternate_ptr;
 109
 110         if (alternate_target >= GC_least_plausible_heap_addr
 111             && alternate_target <= GC_greatest_plausible_heap_addr
 112             && (target < GC_least_plausible_heap_addr
 113                 || target > GC_greatest_plausible_heap_addr)) {
 114             bp = alternate_ptr;
 115         }
 116       }
 117 #   endif
 118     bp_base = GC_base(bp);
 119     if (0 == bp_base) {
 120       *base_p = bp;
 121       *offset_p = 0;
 122       return GC_REFD_FROM_ROOT;
 123     } else {
 124       if (GC_HAS_DEBUG_INFO(bp_base)) bp_base += sizeof(oh);
 125       *base_p = bp_base;
 126       *offset_p = bp - bp_base;
 127       return GC_REFD_FROM_HEAP;
 128     }
 129   }
 130
 131   /* Generate a random heap address.            */
 132   /* The resulting address is in the heap, but  */
 133   /* not necessarily inside a valid object.     */
 134   void *GC_generate_random_heap_address(void)
 135   {
 136     int i;
 137     long heap_offset = RANDOM();
 138     if (GC_heapsize > RAND_MAX) {
 139         heap_offset *= RAND_MAX;
 140         heap_offset += RANDOM();
 141     }
 142     heap_offset %= GC_heapsize;
 143         /* This doesn't yield a uniform distribution, especially if     */
 144         /* e.g. RAND_MAX = 1.5* GC_heapsize.  But for typical cases,    */
 145         /* it's not too bad.                                            */
 146     for (i = 0; i < GC_n_heap_sects; ++ i) {
 147         int size = GC_heap_sects[i].hs_bytes;
 148         if (heap_offset < size) {
 149             return GC_heap_sects[i].hs_start + heap_offset;
 150         } else {
 151             heap_offset -= size;
 152         }
 153     }
 154     ABORT("GC_generate_random_heap_address: size inconsistency");
 155     /*NOTREACHED*/
 156     return 0;
 157   }
 158
 159   /* Generate a random address inside a valid marked heap object. */
 160   void *GC_generate_random_valid_address(void)
 161   {
 162     ptr_t result;
 163     ptr_t base;
 164     for (;;) {
 165         result = GC_generate_random_heap_address();
 166         base = GC_base(result);
 167         if (0 == base) continue;
 168         if (!GC_is_marked(base)) continue;
 169         return result;
 170     }
 171   }
 172
 173   /* Print back trace for p */
 174   void GC_print_backtrace(void *p)
 175   {
 176     void *current = p;
 177     int i;
 178     GC_ref_kind source;
 179     size_t offset;
 180     void *base;
 181
 182     GC_print_heap_obj(GC_base(current));
 183     GC_err_printf0("\n");
 184     for (i = 0; ; ++i) {
 185       source = GC_get_back_ptr_info(current, &base, &offset);
 186       if (GC_UNREFERENCED == source) {
 187         GC_err_printf0("Reference could not be found\n");
 188         goto out;
 189       }
 190       if (GC_NO_SPACE == source) {
 191         GC_err_printf0("No debug info in object: Can't find reference\n");
 192         goto out;
 193       }
 194       GC_err_printf1("Reachable via %d levels of pointers from ",
 195                  (unsigned long)i);
 196       switch(source) {
 197         case GC_REFD_FROM_ROOT:
 198           GC_err_printf1("root at 0x%lx\n", (unsigned long)base);
 199           goto out;
 200         case GC_REFD_FROM_REG:
 201           GC_err_printf0("root in register\n");
 202           goto out;
 203         case GC_FINALIZER_REFD:
 204           GC_err_printf0("list of finalizable objects\n");
 205           goto out;
 206         case GC_REFD_FROM_HEAP:
 207           GC_err_printf1("offset %ld in object:\n", (unsigned long)offset);
 208           /* Take GC_base(base) to get real base, i.e. header. */
 209           GC_print_heap_obj(GC_base(base));
 210           GC_err_printf0("\n");
 211           break;
 212       }
 213       current = base;
 214     }
 215     out:;
 216   }
 217
 218   /* Force a garbage collection and generate a backtrace from a */
 219   /* random heap address.                                       */
 220   void GC_generate_random_backtrace(void)
 221   {
 222     void * current;
 223     GC_gcollect();
 224     current = GC_generate_random_valid_address();
 225     GC_printf1("Chose address 0x%lx in object\n", (unsigned long)current);
 226     GC_print_backtrace(current);
 227   }
 228
 229 #endif /* KEEP_BACK_PTRS */
 230
 231 /* Store debugging info into p.  Return displaced pointer. */
 232 /* Assumes we don't hold allocation lock.                  */
 233 ptr_t GC_store_debug_info(p, sz, string, integer)
 234 register ptr_t p;       /* base pointer */
 235 word sz;        /* bytes */
 236 GC_CONST char * string;
 237 word integer;
 238 {
 239     register word * result = (word *)((oh *)p + 1);
 240     DCL_LOCK_STATE;
 241
 242     /* There is some argument that we should dissble signals here.      */
 243     /* But that's expensive.  And this way things should only appear    */
 244     /* inconsistent while we're in the handler.                         */
 245     LOCK();
 246 #   ifdef KEEP_BACK_PTRS
 247       ((oh *)p) -> oh_back_ptr = HIDE_BACK_PTR(NOT_MARKED);
 248 #   endif
 249     ((oh *)p) -> oh_string = string;
 250     ((oh *)p) -> oh_int = integer;
 251 #   ifndef SHORT_DBG_HDRS
 252       ((oh *)p) -> oh_sz = sz;
 253       ((oh *)p) -> oh_sf = START_FLAG ^ (word)result;
 254       ((word *)p)[BYTES_TO_WORDS(GC_size(p))-1] =
 255          result[SIMPLE_ROUNDED_UP_WORDS(sz)] = END_FLAG ^ (word)result;
 256 #   endif
 257     UNLOCK();
 258     return((ptr_t)result);
 259 }
 260
 261 #ifdef DBG_HDRS_ALL
 262 /* Store debugging info into p.  Return displaced pointer.         */
 263 /* This version assumes we do hold the allocation lock.            */
 264 ptr_t GC_store_debug_info_inner(p, sz, string, integer)
 265 register ptr_t p;       /* base pointer */
 266 word sz;        /* bytes */
 267 char * string;
 268 word integer;
 269 {
 270     register word * result = (word *)((oh *)p + 1);
 271
 272     /* There is some argument that we should disable signals here.      */
 273     /* But that's expensive.  And this way things should only appear    */
 274     /* inconsistent while we're in the handler.                         */
 275 #   ifdef KEEP_BACK_PTRS
 276       ((oh *)p) -> oh_back_ptr = HIDE_BACK_PTR(NOT_MARKED);
 277 #   endif
 278     ((oh *)p) -> oh_string = string;
 279     ((oh *)p) -> oh_int = integer;
 280 #   ifndef SHORT_DBG_HDRS
 281       ((oh *)p) -> oh_sz = sz;
 282       ((oh *)p) -> oh_sf = START_FLAG ^ (word)result;
 283       ((word *)p)[BYTES_TO_WORDS(GC_size(p))-1] =
 284          result[SIMPLE_ROUNDED_UP_WORDS(sz)] = END_FLAG ^ (word)result;
 285 #   endif
 286     return((ptr_t)result);
 287 }
 288 #endif
 289
 290 #ifndef SHORT_DBG_HDRS
 291 /* Check the object with debugging info at ohdr         */
 292 /* return NIL if it's OK.  Else return clobbered        */
 293 /* address.                                             */
 294 ptr_t GC_check_annotated_obj(ohdr)
 295 register oh * ohdr;
 296 {
 297     register ptr_t body = (ptr_t)(ohdr + 1);
 298     register word gc_sz = GC_size((ptr_t)ohdr);
 299     if (ohdr -> oh_sz + DEBUG_BYTES > gc_sz) {
 300         return((ptr_t)(&(ohdr -> oh_sz)));
 301     }
 302     if (ohdr -> oh_sf != (START_FLAG ^ (word)body)) {
 303         return((ptr_t)(&(ohdr -> oh_sf)));
 304     }
 305     if (((word *)ohdr)[BYTES_TO_WORDS(gc_sz)-1] != (END_FLAG ^ (word)body)) {
 306         return((ptr_t)((word *)ohdr + BYTES_TO_WORDS(gc_sz)-1));
 307     }
 308     if (((word *)body)[SIMPLE_ROUNDED_UP_WORDS(ohdr -> oh_sz)]
 309         != (END_FLAG ^ (word)body)) {
 310         return((ptr_t)((word *)body + SIMPLE_ROUNDED_UP_WORDS(ohdr -> oh_sz)));
 311     }
 312     return(0);
 313 }
 314 #endif /* !SHORT_DBG_HDRS */
 315
 316 void GC_print_obj(p)
 317 ptr_t p;
 318 {
 319     register oh * ohdr = (oh *)GC_base(p);
 320
 321     GC_err_printf1("0x%lx (", ((unsigned long)ohdr + sizeof(oh)));
 322     GC_err_puts(ohdr -> oh_string);
 323 #   ifdef SHORT_DBG_HDRS
 324       GC_err_printf1(":%ld, sz=%ld)\n", (unsigned long)(ohdr -> oh_int));
 325 #   else
 326       GC_err_printf2(":%ld, sz=%ld)\n", (unsigned long)(ohdr -> oh_int),
 327                                         (unsigned long)(ohdr -> oh_sz));
 328 #   endif
 329     PRINT_CALL_CHAIN(ohdr);
 330 }
 331
 332 # if defined(__STDC__) || defined(__cplusplus)
 333     void GC_debug_print_heap_obj_proc(ptr_t p)
 334 # else
 335     void GC_debug_print_heap_obj_proc(p)
 336     ptr_t p;
 337 # endif
 338 {
 339     if (GC_HAS_DEBUG_INFO(p)) {
 340         GC_print_obj(p);
 341     } else {
 342         GC_default_print_heap_obj_proc(p);
 343     }
 344 }
 345
 346 #ifndef SHORT_DBG_HDRS
 347 void GC_print_smashed_obj(p, clobbered_addr)
 348 ptr_t p, clobbered_addr;
 349 {
 350     register oh * ohdr = (oh *)GC_base(p);
 351
 352     GC_err_printf2("0x%lx in object at 0x%lx(", (unsigned long)clobbered_addr,
 353                                                 (unsigned long)p);
 354     if (clobbered_addr <= (ptr_t)(&(ohdr -> oh_sz))
 355         || ohdr -> oh_string == 0) {
 356         GC_err_printf1("<smashed>, appr. sz = %ld)\n",
 357                        (GC_size((ptr_t)ohdr) - DEBUG_BYTES));
 358     } else {
 359         if (ohdr -> oh_string[0] == '\0') {
 360             GC_err_puts("EMPTY(smashed?)");
 361         } else {
 362             GC_err_puts(ohdr -> oh_string);
 363         }
 364         GC_err_printf2(":%ld, sz=%ld)\n", (unsigned long)(ohdr -> oh_int),
 365                                           (unsigned long)(ohdr -> oh_sz));
 366         PRINT_CALL_CHAIN(ohdr);
 367     }
 368 }
 369 #endif
 370
 371 void GC_check_heap_proc GC_PROTO((void));
 372
 373 void GC_do_nothing() {}
 374
 375 void GC_start_debugging()
 376 {
 377 #   ifndef SHORT_DBG_HDRS
 378       GC_check_heap = GC_check_heap_proc;
 379 #   else
 380       GC_check_heap = GC_do_nothing;
 381 #   endif
 382     GC_print_heap_obj = GC_debug_print_heap_obj_proc;
 383     GC_debugging_started = TRUE;
 384     GC_register_displacement((word)sizeof(oh));
 385 }
 386
 387 # if defined(__STDC__) || defined(__cplusplus)
 388     void GC_debug_register_displacement(GC_word offset)
 389 # else
 390     void GC_debug_register_displacement(offset)
 391     GC_word offset;
 392 # endif
 393 {
 394     GC_register_displacement(offset);
 395     GC_register_displacement((word)sizeof(oh) + offset);
 396 }
 397
 398 # ifdef __STDC__
 399     GC_PTR GC_debug_malloc(size_t lb, GC_EXTRA_PARAMS)
 400 # else
 401     GC_PTR GC_debug_malloc(lb, s, i)
 402     size_t lb;
 403     char * s;
 404     int i;
 405 #   ifdef GC_ADD_CALLER
 406         --> GC_ADD_CALLER not implemented for K&R C
 407 #   endif
 408 # endif
 409 {
 410     GC_PTR result = GC_malloc(lb + DEBUG_BYTES);
 411
 412     if (result == 0) {
 413         GC_err_printf1("GC_debug_malloc(%ld) returning NIL (",
 414                        (unsigned long) lb);
 415         GC_err_puts(s);
 416         GC_err_printf1(":%ld)\n", (unsigned long)i);
 417         return(0);
 418     }
 419     if (!GC_debugging_started) {
 420         GC_start_debugging();
 421     }
 422     ADD_CALL_CHAIN(result, ra);
 423     return (GC_store_debug_info(result, (word)lb, s, (word)i));
 424 }
 425
 426 # ifdef __STDC__
 427     GC_PTR GC_debug_generic_malloc(size_t lb, int k, GC_EXTRA_PARAMS)
 428 # else
 429     GC_PTR GC_debug_malloc(lb, k, s, i)
 430     size_t lb;
 431     int k;
 432     char * s;
 433     int i;
 434 #   ifdef GC_ADD_CALLER
 435         --> GC_ADD_CALLER not implemented for K&R C
 436 #   endif
 437 # endif
 438 {
 439     GC_PTR result = GC_generic_malloc(lb + DEBUG_BYTES, k);
 440
 441     if (result == 0) {
 442         GC_err_printf1("GC_debug_malloc(%ld) returning NIL (",
 443                        (unsigned long) lb);
 444         GC_err_puts(s);
 445         GC_err_printf1(":%ld)\n", (unsigned long)i);
 446         return(0);
 447     }
 448     if (!GC_debugging_started) {
 449         GC_start_debugging();
 450     }
 451     ADD_CALL_CHAIN(result, ra);
 452     return (GC_store_debug_info(result, (word)lb, s, (word)i));
 453 }
 454
 455 # ifdef DBG_HDRS_ALL
 456 /*
 457  * An allocation function for internal use.
 458  * Normally internally allocated objects do not have debug information.
 459  * But in this case, we need to make sure that all objects have debug
 460  * headers.
 461  * We assume debugging was started in collector initialization,
 462  * and we already hold the GC lock.
 463  */
 464   GC_PTR GC_debug_generic_malloc_inner(size_t lb, int k)
 465   {
 466     GC_PTR result = GC_generic_malloc_inner(lb + DEBUG_BYTES, k);
 467
 468     if (result == 0) {
 469         GC_err_printf1("GC internal allocation (%ld bytes) returning NIL\n",
 470                        (unsigned long) lb);
 471         return(0);
 472     }
 473     ADD_CALL_CHAIN(result, ra);
 474     return (GC_store_debug_info_inner(result, (word)lb, "INTERNAL", (word)0));
 475   }
 476
 477   GC_PTR GC_debug_generic_malloc_inner_ignore_off_page(size_t lb, int k)
 478   {
 479     GC_PTR result = GC_generic_malloc_inner_ignore_off_page(
 480                                                 lb + DEBUG_BYTES, k);
 481
 482     if (result == 0) {
 483         GC_err_printf1("GC internal allocation (%ld bytes) returning NIL\n",
 484                        (unsigned long) lb);
 485         return(0);
 486     }
 487     ADD_CALL_CHAIN(result, ra);
 488     return (GC_store_debug_info_inner(result, (word)lb, "INTERNAL", (word)0));
 489   }
 490 # endif
 491
 492 #ifdef STUBBORN_ALLOC
 493 # ifdef __STDC__
 494     GC_PTR GC_debug_malloc_stubborn(size_t lb, GC_EXTRA_PARAMS)
 495 # else
 496     GC_PTR GC_debug_malloc_stubborn(lb, s, i)
 497     size_t lb;
 498     char * s;
 499     int i;
 500 # endif
 501 {
 502     GC_PTR result = GC_malloc_stubborn(lb + DEBUG_BYTES);
 503
 504     if (result == 0) {
 505         GC_err_printf1("GC_debug_malloc(%ld) returning NIL (",
 506                        (unsigned long) lb);
 507         GC_err_puts(s);
 508         GC_err_printf1(":%ld)\n", (unsigned long)i);
 509         return(0);
 510     }
 511     if (!GC_debugging_started) {
 512         GC_start_debugging();
 513     }
 514     ADD_CALL_CHAIN(result, ra);
 515     return (GC_store_debug_info(result, (word)lb, s, (word)i));
 516 }
 517
 518 void GC_debug_change_stubborn(p)
 519 GC_PTR p;
 520 {
 521     register GC_PTR q = GC_base(p);
 522     register hdr * hhdr;
 523
 524     if (q == 0) {
 525         GC_err_printf1("Bad argument: 0x%lx to GC_debug_change_stubborn\n",
 526                        (unsigned long) p);
 527         ABORT("GC_debug_change_stubborn: bad arg");
 528     }
 529     hhdr = HDR(q);
 530     if (hhdr -> hb_obj_kind != STUBBORN) {
 531         GC_err_printf1("GC_debug_change_stubborn arg not stubborn: 0x%lx\n",
 532                        (unsigned long) p);
 533         ABORT("GC_debug_change_stubborn: arg not stubborn");
 534     }
 535     GC_change_stubborn(q);
 536 }
 537
 538 void GC_debug_end_stubborn_change(p)
 539 GC_PTR p;
 540 {
 541     register GC_PTR q = GC_base(p);
 542     register hdr * hhdr;
 543
 544     if (q == 0) {
 545         GC_err_printf1("Bad argument: 0x%lx to GC_debug_end_stubborn_change\n",
 546                        (unsigned long) p);
 547         ABORT("GC_debug_end_stubborn_change: bad arg");
 548     }
 549     hhdr = HDR(q);
 550     if (hhdr -> hb_obj_kind != STUBBORN) {
 551         GC_err_printf1("debug_end_stubborn_change arg not stubborn: 0x%lx\n",
 552                        (unsigned long) p);
 553         ABORT("GC_debug_end_stubborn_change: arg not stubborn");
 554     }
 555     GC_end_stubborn_change(q);
 556 }
 557
 558 #else /* !STUBBORN_ALLOC */
 559
 560 # ifdef __STDC__
 561     GC_PTR GC_debug_malloc_stubborn(size_t lb, GC_EXTRA_PARAMS)
 562 # else
 563     GC_PTR GC_debug_malloc_stubborn(lb, s, i)
 564     size_t lb;
 565     char * s;
 566     int i;
 567 # endif
 568 {
 569     return GC_debug_malloc(lb, OPT_RA s, i);
 570 }
 571
 572 void GC_debug_change_stubborn(p)
 573 GC_PTR p;
 574 {
 575 }
 576
 577 void GC_debug_end_stubborn_change(p)
 578 GC_PTR p;
 579 {
 580 }
 581
 582 #endif /* !STUBBORN_ALLOC */
 583
 584 # ifdef __STDC__
 585     GC_PTR GC_debug_malloc_atomic(size_t lb, GC_EXTRA_PARAMS)
 586 # else
 587     GC_PTR GC_debug_malloc_atomic(lb, s, i)
 588     size_t lb;
 589     char * s;
 590     int i;
 591 # endif
 592 {
 593     GC_PTR result = GC_malloc_atomic(lb + DEBUG_BYTES);
 594
 595     if (result == 0) {
 596         GC_err_printf1("GC_debug_malloc_atomic(%ld) returning NIL (",
 597                       (unsigned long) lb);
 598         GC_err_puts(s);
 599         GC_err_printf1(":%ld)\n", (unsigned long)i);
 600         return(0);
 601     }
 602     if (!GC_debugging_started) {
 603         GC_start_debugging();
 604     }
 605     ADD_CALL_CHAIN(result, ra);
 606     return (GC_store_debug_info(result, (word)lb, s, (word)i));
 607 }
 608
 609 # ifdef __STDC__
 610     GC_PTR GC_debug_malloc_uncollectable(size_t lb, GC_EXTRA_PARAMS)
 611 # else
 612     GC_PTR GC_debug_malloc_uncollectable(lb, s, i)
 613     size_t lb;
 614     char * s;
 615     int i;
 616 # endif
 617 {
 618     GC_PTR result = GC_malloc_uncollectable(lb + DEBUG_BYTES);
 619
 620     if (result == 0) {
 621         GC_err_printf1("GC_debug_malloc_uncollectable(%ld) returning NIL (",
 622                       (unsigned long) lb);
 623         GC_err_puts(s);
 624         GC_err_printf1(":%ld)\n", (unsigned long)i);
 625         return(0);
 626     }
 627     if (!GC_debugging_started) {
 628         GC_start_debugging();
 629     }
 630     ADD_CALL_CHAIN(result, ra);
 631     return (GC_store_debug_info(result, (word)lb, s, (word)i));
 632 }
 633
 634 #ifdef ATOMIC_UNCOLLECTABLE
 635 # ifdef __STDC__
 636     GC_PTR GC_debug_malloc_atomic_uncollectable(size_t lb, GC_EXTRA_PARAMS)
 637 # else
 638     GC_PTR GC_debug_malloc_atomic_uncollectable(lb, s, i)
 639     size_t lb;
 640     char * s;
 641     int i;
 642 # endif
 643 {
 644     GC_PTR result = GC_malloc_atomic_uncollectable(lb + DEBUG_BYTES);
 645
 646     if (result == 0) {
 647         GC_err_printf1(
 648                 "GC_debug_malloc_atomic_uncollectable(%ld) returning NIL (",
 649                 (unsigned long) lb);
 650         GC_err_puts(s);
 651         GC_err_printf1(":%ld)\n", (unsigned long)i);
 652         return(0);
 653     }
 654     if (!GC_debugging_started) {
 655         GC_start_debugging();
 656     }
 657     ADD_CALL_CHAIN(result, ra);
 658     return (GC_store_debug_info(result, (word)lb, s, (word)i));
 659 }
 660 #endif /* ATOMIC_UNCOLLECTABLE */
 661
 662 # ifdef __STDC__
 663     void GC_debug_free(GC_PTR p)
 664 # else
 665     void GC_debug_free(p)
 666     GC_PTR p;
 667 # endif
 668 {
 669     register GC_PTR base;
 670     register ptr_t clobbered;
 671
 672     if (0 == p) return;
 673     base = GC_base(p);
 674     if (base == 0) {
 675         GC_err_printf1("Attempt to free invalid pointer %lx\n",
 676                        (unsigned long)p);
 677         ABORT("free(invalid pointer)");
 678     }
 679     if ((ptr_t)p - (ptr_t)base != sizeof(oh)) {
 680         GC_err_printf1(
 681                   "GC_debug_free called on pointer %lx wo debugging info\n",
 682                   (unsigned long)p);
 683     } else {
 684 #     ifndef SHORT_DBG_HDRS
 685         clobbered = GC_check_annotated_obj((oh *)base);
 686         if (clobbered != 0) {
 687           if (((oh *)base) -> oh_sz == GC_size(base)) {
 688             GC_err_printf0(
 689                   "GC_debug_free: found previously deallocated (?) object at ");
 690           } else {
 691             GC_err_printf0("GC_debug_free: found smashed location at ");
 692           }
 693           GC_print_smashed_obj(p, clobbered);
 694         }
 695         /* Invalidate size */
 696         ((oh *)base) -> oh_sz = GC_size(base);
 697 #     endif /* SHORT_DBG_HDRS */
 698     }
 699     if (GC_find_leak) {
 700         GC_free(base);
 701     } else {
 702         register hdr * hhdr = HDR(p);
 703         GC_bool uncollectable = FALSE;
 704
 705         if (hhdr ->  hb_obj_kind == UNCOLLECTABLE) {
 706             uncollectable = TRUE;
 707         }
 708 #       ifdef ATOMIC_UNCOLLECTABLE
 709             if (hhdr ->  hb_obj_kind == AUNCOLLECTABLE) {
 710                     uncollectable = TRUE;
 711             }
 712 #       endif
 713         if (uncollectable) GC_free(base);
 714     } /* !GC_find_leak */
 715 }
 716
 717 #ifdef THREADS
 718
 719 extern void GC_free_inner(GC_PTR p);
 720
 721 /* Used internally; we assume it's called correctly.    */
 722 void GC_debug_free_inner(GC_PTR p)
 723 {
 724     GC_free_inner(GC_base(p));
 725 }
 726 #endif
 727
 728 # ifdef __STDC__
 729     GC_PTR GC_debug_realloc(GC_PTR p, size_t lb, GC_EXTRA_PARAMS)
 730 # else
 731     GC_PTR GC_debug_realloc(p, lb, s, i)
 732     GC_PTR p;
 733     size_t lb;
 734     char *s;
 735     int i;
 736 # endif
 737 {
 738     register GC_PTR base = GC_base(p);
 739     register ptr_t clobbered;
 740     register GC_PTR result;
 741     register size_t copy_sz = lb;
 742     register size_t old_sz;
 743     register hdr * hhdr;
 744
 745     if (p == 0) return(GC_debug_malloc(lb, OPT_RA s, i));
 746     if (base == 0) {
 747         GC_err_printf1(
 748               "Attempt to reallocate invalid pointer %lx\n", (unsigned long)p);
 749         ABORT("realloc(invalid pointer)");
 750     }
 751     if ((ptr_t)p - (ptr_t)base != sizeof(oh)) {
 752         GC_err_printf1(
 753                 "GC_debug_realloc called on pointer %lx wo debugging info\n",
 754                 (unsigned long)p);
 755         return(GC_realloc(p, lb));
 756     }
 757     hhdr = HDR(base);
 758     switch (hhdr -> hb_obj_kind) {
 759 #    ifdef STUBBORN_ALLOC
 760       case STUBBORN:
 761         result = GC_debug_malloc_stubborn(lb, OPT_RA s, i);
 762         break;
 763 #    endif
 764       case NORMAL:
 765         result = GC_debug_malloc(lb, OPT_RA s, i);
 766         break;
 767       case PTRFREE:
 768         result = GC_debug_malloc_atomic(lb, OPT_RA s, i);
 769         break;
 770       case UNCOLLECTABLE:
 771         result = GC_debug_malloc_uncollectable(lb, OPT_RA s, i);
 772         break;
 773 #    ifdef ATOMIC_UNCOLLECTABLE
 774       case AUNCOLLECTABLE:
 775         result = GC_debug_malloc_atomic_uncollectable(lb, OPT_RA s, i);
 776         break;
 777 #    endif
 778       default:
 779         GC_err_printf0("GC_debug_realloc: encountered bad kind\n");
 780         ABORT("bad kind");
 781     }
 782 #   ifdef SHORT_DBG_HDRS
 783       old_sz = GC_size(base) - sizeof(oh);
 784 #   else
 785       clobbered = GC_check_annotated_obj((oh *)base);
 786       if (clobbered != 0) {
 787         GC_err_printf0("GC_debug_realloc: found smashed location at ");
 788         GC_print_smashed_obj(p, clobbered);
 789       }
 790       old_sz = ((oh *)base) -> oh_sz;
 791 #   endif
 792     if (old_sz < copy_sz) copy_sz = old_sz;
 793     if (result == 0) return(0);
 794     BCOPY(p, result,  copy_sz);
 795     GC_debug_free(p);
 796     return(result);
 797 }
 798
 799 #ifndef SHORT_DBG_HDRS
 800 /* Check all marked objects in the given block for validity */
 801 /*ARGSUSED*/
 802 # if defined(__STDC__) || defined(__cplusplus)
 803     void GC_check_heap_block(register struct hblk *hbp, word dummy)
 804 # else
 805     void GC_check_heap_block(hbp, dummy)
 806     register struct hblk *hbp;  /* ptr to current heap block            */
 807     word dummy;
 808 # endif
 809 {
 810     register struct hblkhdr * hhdr = HDR(hbp);
 811     register word sz = hhdr -> hb_sz;
 812     register int word_no;
 813     register word *p, *plim;
 814
 815     p = (word *)(hbp->hb_body);
 816     word_no = 0;
 817     if (sz > MAXOBJSZ) {
 818         plim = p;
 819     } else {
 820         plim = (word *)((((word)hbp) + HBLKSIZE) - WORDS_TO_BYTES(sz));
 821     }
 822     /* go through all words in block */
 823         while( p <= plim ) {
 824             if( mark_bit_from_hdr(hhdr, word_no)
 825                 && GC_HAS_DEBUG_INFO((ptr_t)p)) {
 826                 ptr_t clobbered = GC_check_annotated_obj((oh *)p);
 827
 828                 if (clobbered != 0) {
 829                     GC_err_printf0(
 830                         "GC_check_heap_block: found smashed location at ");
 831                     GC_print_smashed_obj((ptr_t)p, clobbered);
 832                 }
 833             }
 834             word_no += sz;
 835             p += sz;
 836         }
 837 }
 838
 839
 840 /* This assumes that all accessible objects are marked, and that        */
 841 /* I hold the allocation lock.  Normally called by collector.           */
 842 void GC_check_heap_proc()
 843 {
 844 #   ifndef SMALL_CONFIG
 845         if (sizeof(oh) & (2 * sizeof(word) - 1) != 0) {
 846             ABORT("Alignment problem: object header has inappropriate size\n");
 847         }
 848 #   endif
 849     GC_apply_to_all_blocks(GC_check_heap_block, (word)0);
 850 }
 851
 852 #endif /* !SHORT_DBG_HDRS */
 853
 854 struct closure {
 855     GC_finalization_proc cl_fn;
 856     GC_PTR cl_data;
 857 };
 858
 859 # ifdef __STDC__
 860     void * GC_make_closure(GC_finalization_proc fn, void * data)
 861 # else
 862     GC_PTR GC_make_closure(fn, data)
 863     GC_finalization_proc fn;
 864     GC_PTR data;
 865 # endif
 866 {
 867     struct closure * result =
 868 #               ifdef DBG_HDRS_ALL
 869                   (struct closure *) GC_debug_malloc(sizeof (struct closure),
 870                                                      GC_EXTRAS);
 871 #               else
 872                   (struct closure *) GC_malloc(sizeof (struct closure));
 873 #               endif
 874
 875     result -> cl_fn = fn;
 876     result -> cl_data = data;
 877     return((GC_PTR)result);
 878 }
 879
 880 # ifdef __STDC__
 881     void GC_debug_invoke_finalizer(void * obj, void * data)
 882 # else
 883     void GC_debug_invoke_finalizer(obj, data)
 884     char * obj;
 885     char * data;
 886 # endif
 887 {
 888     register struct closure * cl = (struct closure *) data;
 889
 890     (*(cl -> cl_fn))((GC_PTR)((char *)obj + sizeof(oh)), cl -> cl_data);
 891 }
 892
 893
 894 # ifdef __STDC__
 895     void GC_debug_register_finalizer(GC_PTR obj, GC_finalization_proc fn,
 896                                      GC_PTR cd, GC_finalization_proc *ofn,
 897                                      GC_PTR *ocd)
 898 # else
 899     void GC_debug_register_finalizer(obj, fn, cd, ofn, ocd)
 900     GC_PTR obj;
 901     GC_finalization_proc fn;
 902     GC_PTR cd;
 903     GC_finalization_proc *ofn;
 904     GC_PTR *ocd;
 905 # endif
 906 {
 907     ptr_t base = GC_base(obj);
 908     if (0 == base || (ptr_t)obj - base != sizeof(oh)) {
 909         GC_err_printf1(
 910             "GC_register_finalizer called with non-base-pointer 0x%lx\n",
 911             obj);
 912     }
 913     GC_register_finalizer(base, GC_debug_invoke_finalizer,
 914                           GC_make_closure(fn,cd), ofn, ocd);
 915 }
 916
 917 # ifdef __STDC__
 918     void GC_debug_register_finalizer_no_order
 919                                     (GC_PTR obj, GC_finalization_proc fn,
 920                                      GC_PTR cd, GC_finalization_proc *ofn,
 921                                      GC_PTR *ocd)
 922 # else
 923     void GC_debug_register_finalizer_no_order
 924                                     (obj, fn, cd, ofn, ocd)
 925     GC_PTR obj;
 926     GC_finalization_proc fn;
 927     GC_PTR cd;
 928     GC_finalization_proc *ofn;
 929     GC_PTR *ocd;
 930 # endif
 931 {
 932     ptr_t base = GC_base(obj);
 933     if (0 == base || (ptr_t)obj - base != sizeof(oh)) {
 934         GC_err_printf1(
 935           "GC_register_finalizer_no_order called with non-base-pointer 0x%lx\n",
 936           obj);
 937     }
 938     GC_register_finalizer_no_order(base, GC_debug_invoke_finalizer,
 939                                       GC_make_closure(fn,cd), ofn, ocd);
 940  }
 941
 942 # ifdef __STDC__
 943     void GC_debug_register_finalizer_ignore_self
 944                                     (GC_PTR obj, GC_finalization_proc fn,
 945                                      GC_PTR cd, GC_finalization_proc *ofn,
 946                                      GC_PTR *ocd)
 947 # else
 948     void GC_debug_register_finalizer_ignore_self
 949                                     (obj, fn, cd, ofn, ocd)
 950     GC_PTR obj;
 951     GC_finalization_proc fn;
 952     GC_PTR cd;
 953     GC_finalization_proc *ofn;
 954     GC_PTR *ocd;
 955 # endif
 956 {
 957     ptr_t base = GC_base(obj);
 958     if (0 == base || (ptr_t)obj - base != sizeof(oh)) {
 959         GC_err_printf1(
 960             "GC_register_finalizer_ignore_self called with non-base-pointer 0x%lx\n",
 961             obj);
 962     }
 963     GC_register_finalizer_ignore_self(base, GC_debug_invoke_finalizer,
 964                                       GC_make_closure(fn,cd), ofn, ocd);
 965 }
 966
 967 #ifdef GC_ADD_CALLER
 968 # define RA GC_RETURN_ADDR,
 969 #else
 970 # define RA
 971 #endif
 972
 973 GC_PTR GC_debug_malloc_replacement(lb)
 974 size_t lb;
 975 {
 976     return GC_debug_malloc(lb, RA "unknown", 0);
 977 }
 978
 979 GC_PTR GC_debug_realloc_replacement(p, lb)
 980 GC_PTR p;
 981 size_t lb;
 982 {
 983     return GC_debug_realloc(p, lb, RA "unknown", 0);
 984 }