dbg_mlc.c

   1 /*
   2  * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
   3  * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
   4  *
   5  * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
   6  * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
   7  *
   8  * Permission is hereby granted to use or copy this program
   9  * for any purpose,  provided the above notices are retained on all copies.
  10  * Permission to modify the code and to distribute modified code is granted,
  11  * provided the above notices are retained, and a notice that the code was
  12  * modified is included with the above copyright notice.
  13  */
  14 /* Boehm, April 18, 1995 3:29 pm PDT */
  15 # include "gc_priv.h"
  16
  17 /* Do we want to and know how to save the call stack at the time of     */
  18 /* an allocation?  How much space do we want to use in each object?     */
  19
  20 # define START_FLAG ((word)0xfedcedcb)
  21 # define END_FLAG ((word)0xbcdecdef)
  22         /* Stored both one past the end of user object, and one before  */
  23         /* the end of the object as seen by the allocator.              */
  24
  25
  26 /* Object header */
  27 typedef struct {
  28     char * oh_string;           /* object descriptor string     */
  29     word oh_int;                /* object descriptor integers   */
  30 #   ifdef SAVE_CALL_CHAIN
  31       struct callinfo oh_ci[NFRAMES];
  32 #   endif
  33     word oh_sz;                 /* Original malloc arg.         */
  34     word oh_sf;                 /* start flag */
  35 } oh;
  36 /* The size of the above structure is assumed not to dealign things,    */
  37 /* and to be a multiple of the word length.                             */
  38
  39 #define DEBUG_BYTES (sizeof (oh) + sizeof (word))
  40 #undef ROUNDED_UP_WORDS
  41 #define ROUNDED_UP_WORDS(n) BYTES_TO_WORDS((n) + WORDS_TO_BYTES(1) - 1)
  42
  43
  44 #ifdef SAVE_CALL_CHAIN
  45 #   define ADD_CALL_CHAIN(base) GC_save_callers(((oh *)(base)) -> oh_ci)
  46 #   define PRINT_CALL_CHAIN(base) GC_print_callers(((oh *)(base)) -> oh_ci)
  47 #else
  48 #   define ADD_CALL_CHAIN(base)
  49 #   define PRINT_CALL_CHAIN(base)
  50 #endif
  51
  52 /* Check whether object with base pointer p has debugging info  */
  53 /* p is assumed to point to a legitimate object in our part     */
  54 /* of the heap.                                                 */
  55 bool GC_has_debug_info(p)
  56 ptr_t p;
  57 {
  58     register oh * ohdr = (oh *)p;
  59     register ptr_t body = (ptr_t)(ohdr + 1);
  60     register word sz = GC_size((ptr_t) ohdr);
  61
  62     if (HBLKPTR((ptr_t)ohdr) != HBLKPTR((ptr_t)body)
  63         || sz < sizeof (oh)) {
  64         return(FALSE);
  65     }
  66     if (ohdr -> oh_sz == sz) {
  67         /* Object may have had debug info, but has been deallocated     */
  68         return(FALSE);
  69     }
  70     if (ohdr -> oh_sf == (START_FLAG ^ (word)body)) return(TRUE);
  71     if (((word *)ohdr)[BYTES_TO_WORDS(sz)-1] == (END_FLAG ^ (word)body)) {
  72         return(TRUE);
  73     }
  74     return(FALSE);
  75 }
  76
  77 /* Store debugging info into p.  Return displaced pointer. */
  78 /* Assumes we don't hold allocation lock.                  */
  79 ptr_t GC_store_debug_info(p, sz, string, integer)
  80 register ptr_t p;       /* base pointer */
  81 word sz;        /* bytes */
  82 char * string;
  83 word integer;
  84 {
  85     register word * result = (word *)((oh *)p + 1);
  86     DCL_LOCK_STATE;
  87
  88     /* There is some argument that we should dissble signals here.      */
  89     /* But that's expensive.  And this way things should only appear    */
  90     /* inconsistent while we're in the handler.                         */
  91     LOCK();
  92     ((oh *)p) -> oh_string = string;
  93     ((oh *)p) -> oh_int = integer;
  94     ((oh *)p) -> oh_sz = sz;
  95     ((oh *)p) -> oh_sf = START_FLAG ^ (word)result;
  96     ((word *)p)[BYTES_TO_WORDS(GC_size(p))-1] =
  97          result[ROUNDED_UP_WORDS(sz)] = END_FLAG ^ (word)result;
  98     UNLOCK();
  99     return((ptr_t)result);
 100 }
 101
 102 /* Check the object with debugging info at p            */
 103 /* return NIL if it's OK.  Else return clobbered        */
 104 /* address.                                             */
 105 ptr_t GC_check_annotated_obj(ohdr)
 106 register oh * ohdr;
 107 {
 108     register ptr_t body = (ptr_t)(ohdr + 1);
 109     register word gc_sz = GC_size((ptr_t)ohdr);
 110     if (ohdr -> oh_sz + DEBUG_BYTES > gc_sz) {
 111         return((ptr_t)(&(ohdr -> oh_sz)));
 112     }
 113     if (ohdr -> oh_sf != (START_FLAG ^ (word)body)) {
 114         return((ptr_t)(&(ohdr -> oh_sf)));
 115     }
 116     if (((word *)ohdr)[BYTES_TO_WORDS(gc_sz)-1] != (END_FLAG ^ (word)body)) {
 117         return((ptr_t)((word *)ohdr + BYTES_TO_WORDS(gc_sz)-1));
 118     }
 119     if (((word *)body)[ROUNDED_UP_WORDS(ohdr -> oh_sz)]
 120         != (END_FLAG ^ (word)body)) {
 121         return((ptr_t)((word *)body + ROUNDED_UP_WORDS(ohdr -> oh_sz)));
 122     }
 123     return(0);
 124 }
 125
 126 void GC_print_obj(p)
 127 ptr_t p;
 128 {
 129     register oh * ohdr = (oh *)GC_base(p);
 130
 131     GC_err_printf1("0x%lx (", (unsigned long)ohdr + sizeof(oh));
 132     GC_err_puts(ohdr -> oh_string);
 133     GC_err_printf2(":%ld, sz=%ld)\n", (unsigned long)(ohdr -> oh_int),
 134                                       (unsigned long)(ohdr -> oh_sz));
 135     PRINT_CALL_CHAIN(ohdr);
 136 }
 137 void GC_print_smashed_obj(p, clobbered_addr)
 138 ptr_t p, clobbered_addr;
 139 {
 140     register oh * ohdr = (oh *)GC_base(p);
 141
 142     GC_err_printf2("0x%lx in object at 0x%lx(", (unsigned long)clobbered_addr,
 143                                                 (unsigned long)p);
 144     if (clobbered_addr <= (ptr_t)(&(ohdr -> oh_sz))
 145         || ohdr -> oh_string == 0) {
 146         GC_err_printf1("<smashed>, appr. sz = %ld)\n",
 147                        GC_size((ptr_t)ohdr) - DEBUG_BYTES);
 148     } else {
 149         if (ohdr -> oh_string[0] == '\0') {
 150             GC_err_puts("EMPTY(smashed?)");
 151         } else {
 152             GC_err_puts(ohdr -> oh_string);
 153         }
 154         GC_err_printf2(":%ld, sz=%ld)\n", (unsigned long)(ohdr -> oh_int),
 155                                           (unsigned long)(ohdr -> oh_sz));
 156         PRINT_CALL_CHAIN(ohdr);
 157     }
 158 }
 159
 160 void GC_check_heap_proc();
 161
 162 void GC_start_debugging()
 163 {
 164     GC_check_heap = GC_check_heap_proc;
 165     GC_debugging_started = TRUE;
 166     GC_register_displacement((word)sizeof(oh));
 167 }
 168
 169 void GC_debug_register_displacement(n)
 170 word n;
 171 {
 172     GC_register_displacement(n);
 173     GC_register_displacement((word)sizeof(oh) + n);
 174 }
 175
 176 # ifdef __STDC__
 177     extern_ptr_t GC_debug_malloc(size_t lb, char * s, int i)
 178 # else
 179     extern_ptr_t GC_debug_malloc(lb, s, i)
 180     size_t lb;
 181     char * s;
 182     int i;
 183 # endif
 184 {
 185     extern_ptr_t result = GC_malloc(lb + DEBUG_BYTES);
 186
 187     if (result == 0) {
 188         GC_err_printf1("GC_debug_malloc(%ld) returning NIL (",
 189                        (unsigned long) lb);
 190         GC_err_puts(s);
 191         GC_err_printf1(":%ld)\n", (unsigned long)i);
 192         return(0);
 193     }
 194     if (!GC_debugging_started) {
 195         GC_start_debugging();
 196     }
 197     ADD_CALL_CHAIN(result);
 198     return (GC_store_debug_info(result, (word)lb, s, (word)i));
 199 }
 200
 201 #ifdef STUBBORN_ALLOC
 202 # ifdef __STDC__
 203     extern_ptr_t GC_debug_malloc_stubborn(size_t lb, char * s, int i)
 204 # else
 205     extern_ptr_t GC_debug_malloc_stubborn(lb, s, i)
 206     size_t lb;
 207     char * s;
 208     int i;
 209 # endif
 210 {
 211     extern_ptr_t result = GC_malloc_stubborn(lb + DEBUG_BYTES);
 212
 213     if (result == 0) {
 214         GC_err_printf1("GC_debug_malloc(%ld) returning NIL (",
 215                        (unsigned long) lb);
 216         GC_err_puts(s);
 217         GC_err_printf1(":%ld)\n", (unsigned long)i);
 218         return(0);
 219     }
 220     if (!GC_debugging_started) {
 221         GC_start_debugging();
 222     }
 223     ADD_CALL_CHAIN(result);
 224     return (GC_store_debug_info(result, (word)lb, s, (word)i));
 225 }
 226
 227 void GC_debug_change_stubborn(p)
 228 extern_ptr_t p;
 229 {
 230     register extern_ptr_t q = GC_base(p);
 231     register hdr * hhdr;
 232
 233     if (q == 0) {
 234         GC_err_printf1("Bad argument: 0x%lx to GC_debug_change_stubborn\n",
 235                        (unsigned long) p);
 236         ABORT("GC_debug_change_stubborn: bad arg");
 237     }
 238     hhdr = HDR(q);
 239     if (hhdr -> hb_obj_kind != STUBBORN) {
 240         GC_err_printf1("GC_debug_change_stubborn arg not stubborn: 0x%lx\n",
 241                        (unsigned long) p);
 242         ABORT("GC_debug_change_stubborn: arg not stubborn");
 243     }
 244     GC_change_stubborn(q);
 245 }
 246
 247 void GC_debug_end_stubborn_change(p)
 248 extern_ptr_t p;
 249 {
 250     register extern_ptr_t q = GC_base(p);
 251     register hdr * hhdr;
 252
 253     if (q == 0) {
 254         GC_err_printf1("Bad argument: 0x%lx to GC_debug_end_stubborn_change\n",
 255                        (unsigned long) p);
 256         ABORT("GC_debug_end_stubborn_change: bad arg");
 257     }
 258     hhdr = HDR(q);
 259     if (hhdr -> hb_obj_kind != STUBBORN) {
 260         GC_err_printf1("debug_end_stubborn_change arg not stubborn: 0x%lx\n",
 261                        (unsigned long) p);
 262         ABORT("GC_debug_end_stubborn_change: arg not stubborn");
 263     }
 264     GC_end_stubborn_change(q);
 265 }
 266
 267 #endif /* STUBBORN_ALLOC */
 268
 269 # ifdef __STDC__
 270     extern_ptr_t GC_debug_malloc_atomic(size_t lb, char * s, int i)
 271 # else
 272     extern_ptr_t GC_debug_malloc_atomic(lb, s, i)
 273     size_t lb;
 274     char * s;
 275     int i;
 276 # endif
 277 {
 278     extern_ptr_t result = GC_malloc_atomic(lb + DEBUG_BYTES);
 279
 280     if (result == 0) {
 281         GC_err_printf1("GC_debug_malloc_atomic(%ld) returning NIL (",
 282                       (unsigned long) lb);
 283         GC_err_puts(s);
 284         GC_err_printf1(":%ld)\n", (unsigned long)i);
 285         return(0);
 286     }
 287     if (!GC_debugging_started) {
 288         GC_start_debugging();
 289     }
 290     ADD_CALL_CHAIN(result);
 291     return (GC_store_debug_info(result, (word)lb, s, (word)i));
 292 }
 293
 294 # ifdef __STDC__
 295     extern_ptr_t GC_debug_malloc_uncollectable(size_t lb, char * s, int i)
 296 # else
 297     extern_ptr_t GC_debug_malloc_uncollectable(lb, s, i)
 298     size_t lb;
 299     char * s;
 300     int i;
 301 # endif
 302 {
 303     extern_ptr_t result = GC_malloc_uncollectable(lb + DEBUG_BYTES);
 304
 305     if (result == 0) {
 306         GC_err_printf1("GC_debug_malloc_uncollectable(%ld) returning NIL (",
 307                       (unsigned long) lb);
 308         GC_err_puts(s);
 309         GC_err_printf1(":%ld)\n", (unsigned long)i);
 310         return(0);
 311     }
 312     if (!GC_debugging_started) {
 313         GC_start_debugging();
 314     }
 315     ADD_CALL_CHAIN(result);
 316     return (GC_store_debug_info(result, (word)lb, s, (word)i));
 317 }
 318
 319
 320 # ifdef __STDC__
 321     void GC_debug_free(extern_ptr_t p)
 322 # else
 323     void GC_debug_free(p)
 324     extern_ptr_t p;
 325 # endif
 326 {
 327     register extern_ptr_t base = GC_base(p);
 328     register ptr_t clobbered;
 329
 330     if (base == 0) {
 331         GC_err_printf1("Attempt to free invalid pointer %lx\n",
 332                        (unsigned long)p);
 333         if (p != 0) ABORT("free(invalid pointer)");
 334     }
 335     if ((ptr_t)p - (ptr_t)base != sizeof(oh)) {
 336         GC_err_printf1(
 337                   "GC_debug_free called on pointer %lx wo debugging info\n",
 338                   (unsigned long)p);
 339     } else {
 340       clobbered = GC_check_annotated_obj((oh *)base);
 341       if (clobbered != 0) {
 342         if (((oh *)base) -> oh_sz == GC_size(base)) {
 343             GC_err_printf0(
 344                   "GC_debug_free: found previously deallocated (?) object at ");
 345         } else {
 346             GC_err_printf0("GC_debug_free: found smashed object at ");
 347         }
 348         GC_print_smashed_obj(p, clobbered);
 349       }
 350       /* Invalidate size */
 351       ((oh *)base) -> oh_sz = GC_size(base);
 352     }
 353 #   ifdef FIND_LEAK
 354         GC_free(base);
 355 #   endif
 356 }
 357
 358 # ifdef __STDC__
 359     extern_ptr_t GC_debug_realloc(extern_ptr_t p, size_t lb, char *s, int i)
 360 # else
 361     extern_ptr_t GC_debug_realloc(p, lb, s, i)
 362     extern_ptr_t p;
 363     size_t lb;
 364     char *s;
 365     int i;
 366 # endif
 367 {
 368     register extern_ptr_t base = GC_base(p);
 369     register ptr_t clobbered;
 370     register extern_ptr_t result = GC_debug_malloc(lb, s, i);
 371     register size_t copy_sz = lb;
 372     register size_t old_sz;
 373     register hdr * hhdr;
 374
 375     if (p == 0) return(GC_debug_malloc(lb, s, i));
 376     if (base == 0) {
 377         GC_err_printf1(
 378               "Attempt to free invalid pointer %lx\n", (unsigned long)p);
 379         ABORT("realloc(invalid pointer)");
 380     }
 381     if ((ptr_t)p - (ptr_t)base != sizeof(oh)) {
 382         GC_err_printf1(
 383                 "GC_debug_realloc called on pointer %lx wo debugging info\n",
 384                 (unsigned long)p);
 385         return(GC_realloc(p, lb));
 386     }
 387     hhdr = HDR(base);
 388     switch (hhdr -> hb_obj_kind) {
 389 #    ifdef STUBBORN_ALLOC
 390       case STUBBORN:
 391         result = GC_debug_malloc_stubborn(lb, s, i);
 392         break;
 393 #    endif
 394       case NORMAL:
 395         result = GC_debug_malloc(lb, s, i);
 396         break;
 397       case PTRFREE:
 398         result = GC_debug_malloc_atomic(lb, s, i);
 399         break;
 400       default:
 401         GC_err_printf0("GC_debug_realloc: encountered bad kind\n");
 402         ABORT("bad kind");
 403     }
 404     clobbered = GC_check_annotated_obj((oh *)base);
 405     if (clobbered != 0) {
 406         GC_err_printf0("GC_debug_realloc: found smashed object at ");
 407         GC_print_smashed_obj(p, clobbered);
 408     }
 409     old_sz = ((oh *)base) -> oh_sz;
 410     if (old_sz < copy_sz) copy_sz = old_sz;
 411     if (result == 0) return(0);
 412     BCOPY(p, result,  copy_sz);
 413     return(result);
 414 }
 415
 416 /* Check all marked objects in the given block for validity */
 417 /*ARGSUSED*/
 418 void GC_check_heap_block(hbp, dummy)
 419 register struct hblk *hbp;      /* ptr to current heap block            */
 420 word dummy;
 421 {
 422     register struct hblkhdr * hhdr = HDR(hbp);
 423     register word sz = hhdr -> hb_sz;
 424     register int word_no;
 425     register word *p, *plim;
 426
 427     p = (word *)(hbp->hb_body);
 428     word_no = HDR_WORDS;
 429     plim = (word *)((((word)hbp) + HBLKSIZE)
 430                    - WORDS_TO_BYTES(sz));
 431
 432     /* go through all words in block */
 433         do {
 434             if( mark_bit_from_hdr(hhdr, word_no)
 435                 && GC_has_debug_info((ptr_t)p)) {
 436                 ptr_t clobbered = GC_check_annotated_obj((oh *)p);
 437
 438                 if (clobbered != 0) {
 439                     GC_err_printf0(
 440                         "GC_check_heap_block: found smashed object at ");
 441                     GC_print_smashed_obj((ptr_t)p, clobbered);
 442                 }
 443             }
 444             word_no += sz;
 445             p += sz;
 446         } while( p <= plim );
 447 }
 448
 449
 450 /* This assumes that all accessible objects are marked, and that        */
 451 /* I hold the allocation lock.  Normally called by collector.           */
 452 void GC_check_heap_proc()
 453 {
 454 #   ifndef SMALL_CONFIG
 455         if (sizeof(oh) & (2 * sizeof(word) - 1) != 0) {
 456             ABORT("Alignment problem: object header has inappropriate size\n");
 457         }
 458 #   endif
 459     GC_apply_to_all_blocks(GC_check_heap_block, (word)0);
 460 }
 461
 462 struct closure {
 463     GC_finalization_proc cl_fn;
 464     extern_ptr_t cl_data;
 465 };
 466
 467 # ifdef __STDC__
 468     void * GC_make_closure(GC_finalization_proc fn, void * data)
 469 # else
 470     extern_ptr_t GC_make_closure(fn, data)
 471     GC_finalization_proc fn;
 472     extern_ptr_t data;
 473 # endif
 474 {
 475     struct closure * result =
 476                 (struct closure *) GC_malloc(sizeof (struct closure));
 477
 478     result -> cl_fn = fn;
 479     result -> cl_data = data;
 480     return((extern_ptr_t)result);
 481 }
 482
 483 # ifdef __STDC__
 484     void GC_debug_invoke_finalizer(void * obj, void * data)
 485 # else
 486     void GC_debug_invoke_finalizer(obj, data)
 487     char * obj;
 488     char * data;
 489 # endif
 490 {
 491     register struct closure * cl = (struct closure *) data;
 492
 493     (*(cl -> cl_fn))((extern_ptr_t)((char *)obj + sizeof(oh)), cl -> cl_data);
 494 }
 495