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  *
   6  * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
   7  * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
   8  *
   9  * Permission is hereby granted to use or copy this program
  10  * for any purpose,  provided the above notices are retained on all copies.
  11  * Permission to modify the code and to distribute modified code is granted,
  12  * provided the above notices are retained, and a notice that the code was
  13  * modified is included with the above copyright notice.
  14  */
  15 /* Boehm, October 9, 1995 1:16 pm PDT */
  16 # include "gc_priv.h"
  17
  18 void GC_default_print_heap_obj_proc();
  19 GC_API void GC_register_finalizer_no_order
  20         GC_PROTO((GC_PTR obj, GC_finalization_proc fn, GC_PTR cd,
  21                   GC_finalization_proc *ofn, GC_PTR *ocd));
  22
  23 /* Do we want to and know how to save the call stack at the time of     */
  24 /* an allocation?  How much space do we want to use in each object?     */
  25
  26 # define START_FLAG ((word)0xfedcedcb)
  27 # define END_FLAG ((word)0xbcdecdef)
  28         /* Stored both one past the end of user object, and one before  */
  29         /* the end of the object as seen by the allocator.              */
  30
  31
  32 /* Object header */
  33 typedef struct {
  34     char * oh_string;           /* object descriptor string     */
  35     word oh_int;                /* object descriptor integers   */
  36 #   ifdef NEED_CALLINFO
  37       struct callinfo oh_ci[NFRAMES];
  38 #   endif
  39     word oh_sz;                 /* Original malloc arg.         */
  40     word oh_sf;                 /* start flag */
  41 } oh;
  42 /* The size of the above structure is assumed not to dealign things,    */
  43 /* and to be a multiple of the word length.                             */
  44
  45 #define DEBUG_BYTES (sizeof (oh) + sizeof (word))
  46 #undef ROUNDED_UP_WORDS
  47 #define ROUNDED_UP_WORDS(n) BYTES_TO_WORDS((n) + WORDS_TO_BYTES(1) - 1)
  48
  49
  50 #ifdef SAVE_CALL_CHAIN
  51 #   define ADD_CALL_CHAIN(base, ra) GC_save_callers(((oh *)(base)) -> oh_ci)
  52 #   define PRINT_CALL_CHAIN(base) GC_print_callers(((oh *)(base)) -> oh_ci)
  53 #else
  54 # ifdef GC_ADD_CALLER
  55 #   define ADD_CALL_CHAIN(base, ra) ((oh *)(base)) -> oh_ci[0].ci_pc = (ra)
  56 #   define PRINT_CALL_CHAIN(base) GC_print_callers(((oh *)(base)) -> oh_ci)
  57 # else
  58 #   define ADD_CALL_CHAIN(base, ra)
  59 #   define PRINT_CALL_CHAIN(base)
  60 # endif
  61 #endif
  62
  63 /* Check whether object with base pointer p has debugging info  */
  64 /* p is assumed to point to a legitimate object in our part     */
  65 /* of the heap.                                                 */
  66 GC_bool GC_has_debug_info(p)
  67 ptr_t p;
  68 {
  69     register oh * ohdr = (oh *)p;
  70     register ptr_t body = (ptr_t)(ohdr + 1);
  71     register word sz = GC_size((ptr_t) ohdr);
  72
  73     if (HBLKPTR((ptr_t)ohdr) != HBLKPTR((ptr_t)body)
  74         || sz < sizeof (oh)) {
  75         return(FALSE);
  76     }
  77     if (ohdr -> oh_sz == sz) {
  78         /* Object may have had debug info, but has been deallocated     */
  79         return(FALSE);
  80     }
  81     if (ohdr -> oh_sf == (START_FLAG ^ (word)body)) return(TRUE);
  82     if (((word *)ohdr)[BYTES_TO_WORDS(sz)-1] == (END_FLAG ^ (word)body)) {
  83         return(TRUE);
  84     }
  85     return(FALSE);
  86 }
  87
  88 /* Store debugging info into p.  Return displaced pointer. */
  89 /* Assumes we don't hold allocation lock.                  */
  90 ptr_t GC_store_debug_info(p, sz, string, integer)
  91 register ptr_t p;       /* base pointer */
  92 word sz;        /* bytes */
  93 char * string;
  94 word integer;
  95 {
  96     register word * result = (word *)((oh *)p + 1);
  97     DCL_LOCK_STATE;
  98
  99     /* There is some argument that we should dissble signals here.      */
 100     /* But that's expensive.  And this way things should only appear    */
 101     /* inconsistent while we're in the handler.                         */
 102     LOCK();
 103     ((oh *)p) -> oh_string = string;
 104     ((oh *)p) -> oh_int = integer;
 105     ((oh *)p) -> oh_sz = sz;
 106     ((oh *)p) -> oh_sf = START_FLAG ^ (word)result;
 107     ((word *)p)[BYTES_TO_WORDS(GC_size(p))-1] =
 108          result[ROUNDED_UP_WORDS(sz)] = END_FLAG ^ (word)result;
 109     UNLOCK();
 110     return((ptr_t)result);
 111 }
 112
 113 /* Check the object with debugging info at ohdr         */
 114 /* return NIL if it's OK.  Else return clobbered        */
 115 /* address.                                             */
 116 ptr_t GC_check_annotated_obj(ohdr)
 117 register oh * ohdr;
 118 {
 119     register ptr_t body = (ptr_t)(ohdr + 1);
 120     register word gc_sz = GC_size((ptr_t)ohdr);
 121     if (ohdr -> oh_sz + DEBUG_BYTES > gc_sz) {
 122         return((ptr_t)(&(ohdr -> oh_sz)));
 123     }
 124     if (ohdr -> oh_sf != (START_FLAG ^ (word)body)) {
 125         return((ptr_t)(&(ohdr -> oh_sf)));
 126     }
 127     if (((word *)ohdr)[BYTES_TO_WORDS(gc_sz)-1] != (END_FLAG ^ (word)body)) {
 128         return((ptr_t)((word *)ohdr + BYTES_TO_WORDS(gc_sz)-1));
 129     }
 130     if (((word *)body)[ROUNDED_UP_WORDS(ohdr -> oh_sz)]
 131         != (END_FLAG ^ (word)body)) {
 132         return((ptr_t)((word *)body + ROUNDED_UP_WORDS(ohdr -> oh_sz)));
 133     }
 134     return(0);
 135 }
 136
 137 void GC_print_obj(p)
 138 ptr_t p;
 139 {
 140     register oh * ohdr = (oh *)GC_base(p);
 141
 142     GC_err_printf1("0x%lx (", ((unsigned long)ohdr + sizeof(oh)));
 143     GC_err_puts(ohdr -> oh_string);
 144     GC_err_printf2(":%ld, sz=%ld)\n", (unsigned long)(ohdr -> oh_int),
 145                                       (unsigned long)(ohdr -> oh_sz));
 146     PRINT_CALL_CHAIN(ohdr);
 147 }
 148
 149 void GC_debug_print_heap_obj_proc(p)
 150 ptr_t p;
 151 {
 152     if (GC_has_debug_info(p)) {
 153         GC_print_obj(p);
 154     } else {
 155         GC_default_print_heap_obj_proc(p);
 156     }
 157 }
 158
 159 void GC_print_smashed_obj(p, clobbered_addr)
 160 ptr_t p, clobbered_addr;
 161 {
 162     register oh * ohdr = (oh *)GC_base(p);
 163
 164     GC_err_printf2("0x%lx in object at 0x%lx(", (unsigned long)clobbered_addr,
 165                                                 (unsigned long)p);
 166     if (clobbered_addr <= (ptr_t)(&(ohdr -> oh_sz))
 167         || ohdr -> oh_string == 0) {
 168         GC_err_printf1("<smashed>, appr. sz = %ld)\n",
 169                        (GC_size((ptr_t)ohdr) - DEBUG_BYTES));
 170     } else {
 171         if (ohdr -> oh_string[0] == '\0') {
 172             GC_err_puts("EMPTY(smashed?)");
 173         } else {
 174             GC_err_puts(ohdr -> oh_string);
 175         }
 176         GC_err_printf2(":%ld, sz=%ld)\n", (unsigned long)(ohdr -> oh_int),
 177                                           (unsigned long)(ohdr -> oh_sz));
 178         PRINT_CALL_CHAIN(ohdr);
 179     }
 180 }
 181
 182 void GC_check_heap_proc();
 183
 184 void GC_start_debugging()
 185 {
 186     GC_check_heap = GC_check_heap_proc;
 187     GC_print_heap_obj = GC_debug_print_heap_obj_proc;
 188     GC_debugging_started = TRUE;
 189     GC_register_displacement((word)sizeof(oh));
 190 }
 191
 192 # if defined(__STDC__) || defined(__cplusplus)
 193     void GC_debug_register_displacement(GC_word offset)
 194 # else
 195     void GC_debug_register_displacement(offset)
 196     GC_word offset;
 197 # endif
 198 {
 199     GC_register_displacement(offset);
 200     GC_register_displacement((word)sizeof(oh) + offset);
 201 }
 202
 203 # ifdef GC_ADD_CALLER
 204 #   define EXTRA_ARGS word ra, char * s, int i
 205 #   define OPT_RA ra,
 206 # else
 207 #   define EXTRA_ARGS char * s, int i
 208 #   define OPT_RA
 209 # endif
 210
 211 # ifdef __STDC__
 212     GC_PTR GC_debug_malloc(size_t lb, EXTRA_ARGS)
 213 # else
 214     GC_PTR GC_debug_malloc(lb, s, i)
 215     size_t lb;
 216     char * s;
 217     int i;
 218 #   ifdef GC_ADD_CALLER
 219         --> GC_ADD_CALLER not implemented for K&R C
 220 #   endif
 221 # endif
 222 {
 223     GC_PTR result = GC_malloc(lb + DEBUG_BYTES);
 224
 225     if (result == 0) {
 226         GC_err_printf1("GC_debug_malloc(%ld) returning NIL (",
 227                        (unsigned long) lb);
 228         GC_err_puts(s);
 229         GC_err_printf1(":%ld)\n", (unsigned long)i);
 230         return(0);
 231     }
 232     if (!GC_debugging_started) {
 233         GC_start_debugging();
 234     }
 235     ADD_CALL_CHAIN(result, ra);
 236     return (GC_store_debug_info(result, (word)lb, s, (word)i));
 237 }
 238
 239 #ifdef STUBBORN_ALLOC
 240 # ifdef __STDC__
 241     GC_PTR GC_debug_malloc_stubborn(size_t lb, EXTRA_ARGS)
 242 # else
 243     GC_PTR GC_debug_malloc_stubborn(lb, s, i)
 244     size_t lb;
 245     char * s;
 246     int i;
 247 # endif
 248 {
 249     GC_PTR result = GC_malloc_stubborn(lb + DEBUG_BYTES);
 250
 251     if (result == 0) {
 252         GC_err_printf1("GC_debug_malloc(%ld) returning NIL (",
 253                        (unsigned long) lb);
 254         GC_err_puts(s);
 255         GC_err_printf1(":%ld)\n", (unsigned long)i);
 256         return(0);
 257     }
 258     if (!GC_debugging_started) {
 259         GC_start_debugging();
 260     }
 261     ADD_CALL_CHAIN(result, ra);
 262     return (GC_store_debug_info(result, (word)lb, s, (word)i));
 263 }
 264
 265 void GC_debug_change_stubborn(p)
 266 GC_PTR p;
 267 {
 268     register GC_PTR q = GC_base(p);
 269     register hdr * hhdr;
 270
 271     if (q == 0) {
 272         GC_err_printf1("Bad argument: 0x%lx to GC_debug_change_stubborn\n",
 273                        (unsigned long) p);
 274         ABORT("GC_debug_change_stubborn: bad arg");
 275     }
 276     hhdr = HDR(q);
 277     if (hhdr -> hb_obj_kind != STUBBORN) {
 278         GC_err_printf1("GC_debug_change_stubborn arg not stubborn: 0x%lx\n",
 279                        (unsigned long) p);
 280         ABORT("GC_debug_change_stubborn: arg not stubborn");
 281     }
 282     GC_change_stubborn(q);
 283 }
 284
 285 void GC_debug_end_stubborn_change(p)
 286 GC_PTR p;
 287 {
 288     register GC_PTR q = GC_base(p);
 289     register hdr * hhdr;
 290
 291     if (q == 0) {
 292         GC_err_printf1("Bad argument: 0x%lx to GC_debug_end_stubborn_change\n",
 293                        (unsigned long) p);
 294         ABORT("GC_debug_end_stubborn_change: bad arg");
 295     }
 296     hhdr = HDR(q);
 297     if (hhdr -> hb_obj_kind != STUBBORN) {
 298         GC_err_printf1("debug_end_stubborn_change arg not stubborn: 0x%lx\n",
 299                        (unsigned long) p);
 300         ABORT("GC_debug_end_stubborn_change: arg not stubborn");
 301     }
 302     GC_end_stubborn_change(q);
 303 }
 304
 305 #endif /* STUBBORN_ALLOC */
 306
 307 # ifdef __STDC__
 308     GC_PTR GC_debug_malloc_atomic(size_t lb, EXTRA_ARGS)
 309 # else
 310     GC_PTR GC_debug_malloc_atomic(lb, s, i)
 311     size_t lb;
 312     char * s;
 313     int i;
 314 # endif
 315 {
 316     GC_PTR result = GC_malloc_atomic(lb + DEBUG_BYTES);
 317
 318     if (result == 0) {
 319         GC_err_printf1("GC_debug_malloc_atomic(%ld) returning NIL (",
 320                       (unsigned long) lb);
 321         GC_err_puts(s);
 322         GC_err_printf1(":%ld)\n", (unsigned long)i);
 323         return(0);
 324     }
 325     if (!GC_debugging_started) {
 326         GC_start_debugging();
 327     }
 328     ADD_CALL_CHAIN(result, ra);
 329     return (GC_store_debug_info(result, (word)lb, s, (word)i));
 330 }
 331
 332 # ifdef __STDC__
 333     GC_PTR GC_debug_malloc_uncollectable(size_t lb, EXTRA_ARGS)
 334 # else
 335     GC_PTR GC_debug_malloc_uncollectable(lb, s, i)
 336     size_t lb;
 337     char * s;
 338     int i;
 339 # endif
 340 {
 341     GC_PTR result = GC_malloc_uncollectable(lb + DEBUG_BYTES);
 342
 343     if (result == 0) {
 344         GC_err_printf1("GC_debug_malloc_uncollectable(%ld) returning NIL (",
 345                       (unsigned long) lb);
 346         GC_err_puts(s);
 347         GC_err_printf1(":%ld)\n", (unsigned long)i);
 348         return(0);
 349     }
 350     if (!GC_debugging_started) {
 351         GC_start_debugging();
 352     }
 353     ADD_CALL_CHAIN(result, ra);
 354     return (GC_store_debug_info(result, (word)lb, s, (word)i));
 355 }
 356
 357 #ifdef ATOMIC_UNCOLLECTABLE
 358 # ifdef __STDC__
 359     GC_PTR GC_debug_malloc_atomic_uncollectable(size_t lb, EXTRA_ARGS)
 360 # else
 361     GC_PTR GC_debug_malloc_atomic_uncollectable(lb, s, i)
 362     size_t lb;
 363     char * s;
 364     int i;
 365 # endif
 366 {
 367     GC_PTR result = GC_malloc_atomic_uncollectable(lb + DEBUG_BYTES);
 368
 369     if (result == 0) {
 370         GC_err_printf1(
 371                 "GC_debug_malloc_atomic_uncollectable(%ld) returning NIL (",
 372                 (unsigned long) lb);
 373         GC_err_puts(s);
 374         GC_err_printf1(":%ld)\n", (unsigned long)i);
 375         return(0);
 376     }
 377     if (!GC_debugging_started) {
 378         GC_start_debugging();
 379     }
 380     ADD_CALL_CHAIN(result, ra);
 381     return (GC_store_debug_info(result, (word)lb, s, (word)i));
 382 }
 383 #endif /* ATOMIC_UNCOLLECTABLE */
 384
 385 # ifdef __STDC__
 386     void GC_debug_free(GC_PTR p)
 387 # else
 388     void GC_debug_free(p)
 389     GC_PTR p;
 390 # endif
 391 {
 392     register GC_PTR base = GC_base(p);
 393     register ptr_t clobbered;
 394
 395     if (base == 0) {
 396         GC_err_printf1("Attempt to free invalid pointer %lx\n",
 397                        (unsigned long)p);
 398         if (p != 0) ABORT("free(invalid pointer)");
 399     }
 400     if ((ptr_t)p - (ptr_t)base != sizeof(oh)) {
 401         GC_err_printf1(
 402                   "GC_debug_free called on pointer %lx wo debugging info\n",
 403                   (unsigned long)p);
 404     } else {
 405       clobbered = GC_check_annotated_obj((oh *)base);
 406       if (clobbered != 0) {
 407         if (((oh *)base) -> oh_sz == GC_size(base)) {
 408             GC_err_printf0(
 409                   "GC_debug_free: found previously deallocated (?) object at ");
 410         } else {
 411             GC_err_printf0("GC_debug_free: found smashed location at ");
 412         }
 413         GC_print_smashed_obj(p, clobbered);
 414       }
 415       /* Invalidate size */
 416       ((oh *)base) -> oh_sz = GC_size(base);
 417     }
 418 #   ifdef FIND_LEAK
 419         GC_free(base);
 420 #   else
 421         {
 422             register hdr * hhdr = HDR(p);
 423             GC_bool uncollectable = FALSE;
 424
 425             if (hhdr ->  hb_obj_kind == UNCOLLECTABLE) {
 426                 uncollectable = TRUE;
 427             }
 428 #           ifdef ATOMIC_UNCOLLECTABLE
 429                 if (hhdr ->  hb_obj_kind == AUNCOLLECTABLE) {
 430                     uncollectable = TRUE;
 431                 }
 432 #           endif
 433             if (uncollectable) GC_free(base);
 434         }
 435 #   endif
 436 }
 437
 438 # ifdef __STDC__
 439     GC_PTR GC_debug_realloc(GC_PTR p, size_t lb, EXTRA_ARGS)
 440 # else
 441     GC_PTR GC_debug_realloc(p, lb, s, i)
 442     GC_PTR p;
 443     size_t lb;
 444     char *s;
 445     int i;
 446 # endif
 447 {
 448     register GC_PTR base = GC_base(p);
 449     register ptr_t clobbered;
 450     register GC_PTR result;
 451     register size_t copy_sz = lb;
 452     register size_t old_sz;
 453     register hdr * hhdr;
 454
 455     if (p == 0) return(GC_debug_malloc(lb, OPT_RA s, i));
 456     if (base == 0) {
 457         GC_err_printf1(
 458               "Attempt to reallocate invalid pointer %lx\n", (unsigned long)p);
 459         ABORT("realloc(invalid pointer)");
 460     }
 461     if ((ptr_t)p - (ptr_t)base != sizeof(oh)) {
 462         GC_err_printf1(
 463                 "GC_debug_realloc called on pointer %lx wo debugging info\n",
 464                 (unsigned long)p);
 465         return(GC_realloc(p, lb));
 466     }
 467     hhdr = HDR(base);
 468     switch (hhdr -> hb_obj_kind) {
 469 #    ifdef STUBBORN_ALLOC
 470       case STUBBORN:
 471         result = GC_debug_malloc_stubborn(lb, OPT_RA s, i);
 472         break;
 473 #    endif
 474       case NORMAL:
 475         result = GC_debug_malloc(lb, OPT_RA s, i);
 476         break;
 477       case PTRFREE:
 478         result = GC_debug_malloc_atomic(lb, OPT_RA s, i);
 479         break;
 480       case UNCOLLECTABLE:
 481         result = GC_debug_malloc_uncollectable(lb, OPT_RA s, i);
 482         break;
 483 #    ifdef ATOMIC_UNCOLLECTABLE
 484       case AUNCOLLECTABLE:
 485         result = GC_debug_malloc_atomic_uncollectable(lb, OPT_RA s, i);
 486         break;
 487 #    endif
 488       default:
 489         GC_err_printf0("GC_debug_realloc: encountered bad kind\n");
 490         ABORT("bad kind");
 491     }
 492     clobbered = GC_check_annotated_obj((oh *)base);
 493     if (clobbered != 0) {
 494         GC_err_printf0("GC_debug_realloc: found smashed location at ");
 495         GC_print_smashed_obj(p, clobbered);
 496     }
 497     old_sz = ((oh *)base) -> oh_sz;
 498     if (old_sz < copy_sz) copy_sz = old_sz;
 499     if (result == 0) return(0);
 500     BCOPY(p, result,  copy_sz);
 501     GC_debug_free(p);
 502     return(result);
 503 }
 504
 505 /* Check all marked objects in the given block for validity */
 506 /*ARGSUSED*/
 507 void GC_check_heap_block(hbp, dummy)
 508 register struct hblk *hbp;      /* ptr to current heap block            */
 509 word dummy;
 510 {
 511     register struct hblkhdr * hhdr = HDR(hbp);
 512     register word sz = hhdr -> hb_sz;
 513     register int word_no;
 514     register word *p, *plim;
 515
 516     p = (word *)(hbp->hb_body);
 517     word_no = HDR_WORDS;
 518     if (sz > MAXOBJSZ) {
 519         plim = p;
 520     } else {
 521         plim = (word *)((((word)hbp) + HBLKSIZE) - WORDS_TO_BYTES(sz));
 522     }
 523     /* go through all words in block */
 524         while( p <= plim ) {
 525             if( mark_bit_from_hdr(hhdr, word_no)
 526                 && GC_has_debug_info((ptr_t)p)) {
 527                 ptr_t clobbered = GC_check_annotated_obj((oh *)p);
 528
 529                 if (clobbered != 0) {
 530                     GC_err_printf0(
 531                         "GC_check_heap_block: found smashed location at ");
 532                     GC_print_smashed_obj((ptr_t)p, clobbered);
 533                 }
 534             }
 535             word_no += sz;
 536             p += sz;
 537         }
 538 }
 539
 540
 541 /* This assumes that all accessible objects are marked, and that        */
 542 /* I hold the allocation lock.  Normally called by collector.           */
 543 void GC_check_heap_proc()
 544 {
 545 #   ifndef SMALL_CONFIG
 546         if (sizeof(oh) & (2 * sizeof(word) - 1) != 0) {
 547             ABORT("Alignment problem: object header has inappropriate size\n");
 548         }
 549 #   endif
 550     GC_apply_to_all_blocks(GC_check_heap_block, (word)0);
 551 }
 552
 553 struct closure {
 554     GC_finalization_proc cl_fn;
 555     GC_PTR cl_data;
 556 };
 557
 558 # ifdef __STDC__
 559     void * GC_make_closure(GC_finalization_proc fn, void * data)
 560 # else
 561     GC_PTR GC_make_closure(fn, data)
 562     GC_finalization_proc fn;
 563     GC_PTR data;
 564 # endif
 565 {
 566     struct closure * result =
 567                 (struct closure *) GC_malloc(sizeof (struct closure));
 568
 569     result -> cl_fn = fn;
 570     result -> cl_data = data;
 571     return((GC_PTR)result);
 572 }
 573
 574 # ifdef __STDC__
 575     void GC_debug_invoke_finalizer(void * obj, void * data)
 576 # else
 577     void GC_debug_invoke_finalizer(obj, data)
 578     char * obj;
 579     char * data;
 580 # endif
 581 {
 582     register struct closure * cl = (struct closure *) data;
 583
 584     (*(cl -> cl_fn))((GC_PTR)((char *)obj + sizeof(oh)), cl -> cl_data);
 585 }
 586
 587
 588 # ifdef __STDC__
 589     void GC_debug_register_finalizer(GC_PTR obj, GC_finalization_proc fn,
 590                                      GC_PTR cd, GC_finalization_proc *ofn,
 591                                      GC_PTR *ocd)
 592 # else
 593     void GC_debug_register_finalizer(obj, fn, cd, ofn, ocd)
 594     GC_PTR obj;
 595     GC_finalization_proc fn;
 596     GC_PTR cd;
 597     GC_finalization_proc *ofn;
 598     GC_PTR *ocd;
 599 # endif
 600 {
 601     ptr_t base = GC_base(obj);
 602     if (0 == base || (ptr_t)obj - base != sizeof(oh)) {
 603         GC_err_printf1(
 604             "GC_register_finalizer called with non-base-pointer 0x%lx\n",
 605             obj);
 606     }
 607     GC_register_finalizer(base, GC_debug_invoke_finalizer,
 608                           GC_make_closure(fn,cd), ofn, ocd);
 609 }
 610
 611 # ifdef __STDC__
 612     void GC_debug_register_finalizer_no_order
 613                                     (GC_PTR obj, GC_finalization_proc fn,
 614                                      GC_PTR cd, GC_finalization_proc *ofn,
 615                                      GC_PTR *ocd)
 616 # else
 617     void GC_debug_register_finalizer_no_order
 618                                     (obj, fn, cd, ofn, ocd)
 619     GC_PTR obj;
 620     GC_finalization_proc fn;
 621     GC_PTR cd;
 622     GC_finalization_proc *ofn;
 623     GC_PTR *ocd;
 624 # endif
 625 {
 626     ptr_t base = GC_base(obj);
 627     if (0 == base || (ptr_t)obj - base != sizeof(oh)) {
 628         GC_err_printf1(
 629           "GC_register_finalizer_no_order called with non-base-pointer 0x%lx\n",
 630           obj);
 631     }
 632     GC_register_finalizer_no_order(base, GC_debug_invoke_finalizer,
 633                                       GC_make_closure(fn,cd), ofn, ocd);
 634  }
 635
 636 # ifdef __STDC__
 637     void GC_debug_register_finalizer_ignore_self
 638                                     (GC_PTR obj, GC_finalization_proc fn,
 639                                      GC_PTR cd, GC_finalization_proc *ofn,
 640                                      GC_PTR *ocd)
 641 # else
 642     void GC_debug_register_finalizer_ignore_self
 643                                     (obj, fn, cd, ofn, ocd)
 644     GC_PTR obj;
 645     GC_finalization_proc fn;
 646     GC_PTR cd;
 647     GC_finalization_proc *ofn;
 648     GC_PTR *ocd;
 649 # endif
 650 {
 651     ptr_t base = GC_base(obj);
 652     if (0 == base || (ptr_t)obj - base != sizeof(oh)) {
 653         GC_err_printf1(
 654             "GC_register_finalizer_ignore_self called with non-base-pointer 0x%lx\n",
 655             obj);
 656     }
 657     GC_register_finalizer_ignore_self(base, GC_debug_invoke_finalizer,
 658                                       GC_make_closure(fn,cd), ofn, ocd);
 659 }