Back to index

lightning-sunbird  0.9+nobinonly
dbg_mlc.c
Go to the documentation of this file.
00001 /* 
00002  * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
00003  * Copyright (c) 1991-1995 by Xerox Corporation.  All rights reserved.
00004  * Copyright (c) 1997 by Silicon Graphics.  All rights reserved.
00005  *
00006  * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
00007  * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
00008  *
00009  * Permission is hereby granted to use or copy this program
00010  * for any purpose,  provided the above notices are retained on all copies.
00011  * Permission to modify the code and to distribute modified code is granted,
00012  * provided the above notices are retained, and a notice that the code was
00013  * modified is included with the above copyright notice.
00014  */
00015 /* Boehm, October 9, 1995 1:16 pm PDT */
00016 # include "gc_priv.h"
00017 
00018 void GC_default_print_heap_obj_proc();
00019 GC_API void GC_register_finalizer_no_order
00020         GC_PROTO((GC_PTR obj, GC_finalization_proc fn, GC_PTR cd,
00021           GC_finalization_proc *ofn, GC_PTR *ocd));
00022 
00023 /* Do we want to and know how to save the call stack at the time of */
00024 /* an allocation?  How much space do we want to use in each object? */
00025 
00026 # define START_FLAG ((word)0xfedcedcb)
00027 # define END_FLAG ((word)0xbcdecdef)
00028     /* Stored both one past the end of user object, and one before  */
00029     /* the end of the object as seen by the allocator.      */
00030 
00031 
00032 /* Object header */
00033 typedef struct {
00034     char * oh_string;       /* object descriptor string */
00035     word oh_int;        /* object descriptor integers   */
00036 #   ifdef NEED_CALLINFO
00037       struct callinfo oh_ci[NFRAMES];
00038 #   endif
00039     word oh_sz;         /* Original malloc arg.     */
00040     word oh_sf;         /* start flag */
00041 } oh;
00042 /* The size of the above structure is assumed not to dealign things,    */
00043 /* and to be a multiple of the word length.             */
00044 
00045 #define DEBUG_BYTES (sizeof (oh) + sizeof (word))
00046 #undef ROUNDED_UP_WORDS
00047 #define ROUNDED_UP_WORDS(n) BYTES_TO_WORDS((n) + WORDS_TO_BYTES(1) - 1)
00048 
00049 
00050 #ifdef SAVE_CALL_CHAIN
00051 #   define ADD_CALL_CHAIN(base, ra) GC_save_callers(((oh *)(base)) -> oh_ci)
00052 #   define PRINT_CALL_CHAIN(base) GC_print_callers(((oh *)(base)) -> oh_ci)
00053 #else
00054 # ifdef GC_ADD_CALLER
00055 #   define ADD_CALL_CHAIN(base, ra) ((oh *)(base)) -> oh_ci[0].ci_pc = (ra)
00056 #   define PRINT_CALL_CHAIN(base) GC_print_callers(((oh *)(base)) -> oh_ci)
00057 # else
00058 #   define ADD_CALL_CHAIN(base, ra)
00059 #   define PRINT_CALL_CHAIN(base)
00060 # endif
00061 #endif
00062 
00063 /* Check whether object with base pointer p has debugging info  */ 
00064 /* p is assumed to point to a legitimate object in our part */
00065 /* of the heap.                         */
00066 GC_bool GC_has_debug_info(p)
00067 ptr_t p;
00068 {
00069     register oh * ohdr = (oh *)p;
00070     register ptr_t body = (ptr_t)(ohdr + 1);
00071     register word sz = GC_size((ptr_t) ohdr);
00072     
00073     if (HBLKPTR((ptr_t)ohdr) != HBLKPTR((ptr_t)body)
00074         || sz < sizeof (oh)) {
00075         return(FALSE);
00076     }
00077     if (ohdr -> oh_sz == sz) {
00078         /* Object may have had debug info, but has been deallocated */
00079         return(FALSE);
00080     }
00081     if (ohdr -> oh_sf == (START_FLAG ^ (word)body)) return(TRUE);
00082     if (((word *)ohdr)[BYTES_TO_WORDS(sz)-1] == (END_FLAG ^ (word)body)) {
00083         return(TRUE);
00084     }
00085     return(FALSE);
00086 }
00087 
00088 /* Store debugging info into p.  Return displaced pointer. */
00089 /* Assumes we don't hold allocation lock.          */
00090 ptr_t GC_store_debug_info(p, sz, string, integer)
00091 register ptr_t p;   /* base pointer */
00092 word sz;    /* bytes */
00093 char * string;
00094 word integer;
00095 {
00096     register oh * ohdr = (oh *)p;
00097     register word * result = (word *)(ohdr + 1);
00098     DCL_LOCK_STATE;
00099     
00100     /* There is some argument that we should dissble signals here.  */
00101     /* But that's expensive.  And this way things should only appear    */
00102     /* inconsistent while we're in the handler.             */
00103     LOCK();
00104     ohdr -> oh_string = string;
00105     ohdr -> oh_int = integer;
00106     ohdr -> oh_sz = sz;
00107     ohdr -> oh_sf = START_FLAG ^ (word)result;
00108     ((word *)p)[BYTES_TO_WORDS(GC_size(p))-1] =
00109          result[ROUNDED_UP_WORDS(sz)] = END_FLAG ^ (word)result;
00110     UNLOCK();
00111     return((ptr_t)result);
00112 }
00113 
00114 /* Check the object with debugging info at p        */
00115 /* return NIL if it's OK.  Else return clobbered    */
00116 /* address.                     */
00117 ptr_t GC_check_annotated_obj(ohdr)
00118 register oh * ohdr;
00119 {
00120     register ptr_t body = (ptr_t)(ohdr + 1);
00121     register word gc_sz = GC_size((ptr_t)ohdr);
00122     if (ohdr -> oh_sz + DEBUG_BYTES > gc_sz) {
00123         return((ptr_t)(&(ohdr -> oh_sz)));
00124     }
00125     if (ohdr -> oh_sf != (START_FLAG ^ (word)body)) {
00126         return((ptr_t)(&(ohdr -> oh_sf)));
00127     }
00128     if (((word *)ohdr)[BYTES_TO_WORDS(gc_sz)-1] != (END_FLAG ^ (word)body)) {
00129         return((ptr_t)((word *)ohdr + BYTES_TO_WORDS(gc_sz)-1));
00130     }
00131     if (((word *)body)[ROUNDED_UP_WORDS(ohdr -> oh_sz)]
00132         != (END_FLAG ^ (word)body)) {
00133         return((ptr_t)((word *)body + ROUNDED_UP_WORDS(ohdr -> oh_sz)));
00134     }
00135     return(0);
00136 }
00137 
00138 extern const char* getTypeName(void* ptr);
00139 
00140 void GC_print_obj(p)
00141 ptr_t p;
00142 {
00143     register oh * ohdr = (oh *)GC_base(p);
00144     register word *wp, *wend;
00145     
00146     wp = (word*)((unsigned long)ohdr + sizeof(oh));
00147 
00148     GC_err_printf3("0x%08lX <%s> (%ld)\n", wp, getTypeName(wp),
00149                    (unsigned long)(ohdr -> oh_sz));
00150 
00151     /* print all potential references held by this object. */
00152     wend = (word*)((unsigned long)wp + ohdr -> oh_sz);
00153     while (wp < wend) GC_err_printf1("\t0x%08lX\n", *wp++);
00154 
00155     PRINT_CALL_CHAIN(ohdr);
00156 }
00157 
00158 #if defined(SAVE_CALL_CHAIN)
00159 
00160 #include "call_tree.h"
00161 
00162 #define CALL_TREE(ohdr) ((call_tree*)ohdr->oh_ci[0].ci_pc)
00163 #define NEXT_WORD(ohdr) (ohdr->oh_ci[1].ci_pc)
00164 #define NEXT_OBJECT(ohdr) (*(oh**)&ohdr->oh_ci[1].ci_pc)
00165 #define IS_PLAUSIBLE_POINTER(p) ((p >= GC_least_plausible_heap_addr) && (p < GC_greatest_plausible_heap_addr))
00166 
00167 void GC_mark_object(ptr_t p, word mark)
00168 {
00169     p = GC_base(p);
00170     if (p && GC_has_debug_info(p)) {
00171         oh *ohdr = (oh *)p;
00172         NEXT_WORD(ohdr) = mark;
00173     }
00174 }
00175 
00176 void GC_print_call_tree(call_tree* tree);
00177 
00185 static void print_compressed_call_tree(call_tree* tree, unsigned* next_id)
00186 {
00187     call_tree* parent = tree->parent;
00188     if (parent) {
00189         if (tree->id) {
00190             /* id already assigned, print compressed form. */
00191             GC_err_printf1("<c id=%d/>\n", tree->id);
00192         } else {
00193             if (parent->id == 0) {
00194                 /* parent needs an id as well. */
00195                 print_compressed_call_tree(parent, next_id);
00196             }
00197             tree->id = (*next_id)++;
00198             GC_err_printf2("<c id=%d pid=%d>", tree->id, parent->id);
00199             GC_print_call_tree(tree);
00200             GC_err_printf0("</c>\n");
00201         }
00202     }
00203 }
00204 
00209 void GC_trace_object(ptr_t p, int verbose)
00210 {
00211     register oh *head, *scan, *tail;
00212     register word *wp, *wend;
00213     word total = 0;
00214     call_tree* tree;
00215     unsigned next_id = 1;
00216     DCL_LOCK_STATE;
00217     
00218     DISABLE_SIGNALS();
00219     LOCK();
00220     STOP_WORLD();
00221 
00222     p = GC_base(p);
00223     if (p && GC_has_debug_info(p)) {
00224         head = scan = tail = (oh *)p;
00225 
00226         /* invariant:  end of list always marked with value 1. */
00227         NEXT_WORD(tail) = 1;
00228         
00229         /* trace through every object reachable from this starting point. */
00230         for (;;) {
00231             /* print ADDRESS <type> (size) for each object. */
00232             wp = (word*)((unsigned long)scan + sizeof(oh));
00233             GC_err_printf3("0x%08lX <%s> (%ld)\n", wp, getTypeName(wp), scan->oh_sz);
00234             total += scan->oh_sz;
00235 
00236             /* scan/print all plausible references held by this object. */
00237             wend = (word*)((word)wp + scan->oh_sz);
00238             while (wp < wend) {
00239                 p = (ptr_t) *wp++;
00240                 if (verbose) GC_err_printf1("\t0x%08lX\n", p);
00241                 if (IS_PLAUSIBLE_POINTER(p)) {
00242                     p = GC_base(p);
00243                     if (p && GC_has_debug_info(p)) {
00244                         oh *ohdr = (oh *)p;
00245                         if (NEXT_WORD(ohdr) == 0) {
00246                             NEXT_OBJECT(tail) = ohdr;
00247                             tail = ohdr;
00248                             NEXT_WORD(tail) = 1;
00249                         }
00250                     }
00251                 }
00252             }
00253             if (verbose) {
00254                 /* to save space, compress call trees. */
00255                 tree = CALL_TREE(scan);
00256                 if (tree) print_compressed_call_tree(tree, &next_id);
00257             }
00258             if (NEXT_WORD(scan) == 1)
00259                 break;
00260             scan = NEXT_OBJECT(scan);
00261         }
00262         GC_printf1("GC_trace_object: total = %ld\n", total);
00263 
00264         /* clear all marks. */
00265         scan = head;
00266         NEXT_WORD(tail) = 0;
00267         while (scan) {
00268             tail = NEXT_OBJECT(scan);
00269             NEXT_WORD(scan) = 0;
00270             tree = CALL_TREE(scan);
00271             while (tree && tree->id) {
00272                 tree->id = 0;
00273                 tree = tree->parent;
00274             }
00275             scan = tail;
00276         }
00277     }
00278 
00279     START_WORLD();
00280     UNLOCK();
00281     ENABLE_SIGNALS();
00282 }
00283 
00284 #endif /* SAVE_CALL_CHAIN */
00285 
00286 void GC_debug_print_heap_obj_proc(p)
00287 ptr_t p;
00288 {
00289     if (GC_has_debug_info(p)) {
00290         GC_print_obj(p);
00291     } else {
00292         GC_default_print_heap_obj_proc(p);
00293     }
00294 }
00295 
00296 void GC_print_smashed_obj(p, clobbered_addr)
00297 ptr_t p, clobbered_addr;
00298 {
00299     register oh * ohdr = (oh *)GC_base(p);
00300     
00301     GC_err_printf2("0x%lx in object at 0x%lx(", (unsigned long)clobbered_addr,
00302                                 (unsigned long)p);
00303     if (clobbered_addr <= (ptr_t)(&(ohdr -> oh_sz))
00304         || ohdr -> oh_string == 0) {
00305         GC_err_printf1("<smashed>, appr. sz = %ld)\n",
00306                    (GC_size((ptr_t)ohdr) - DEBUG_BYTES));
00307     } else {
00308         if (ohdr -> oh_string[0] == '\0') {
00309             GC_err_puts("EMPTY(smashed?)");
00310         } else {
00311             GC_err_puts(ohdr -> oh_string);
00312         }
00313         GC_err_printf2(":%ld, sz=%ld)\n", (unsigned long)(ohdr -> oh_int),
00314                               (unsigned long)(ohdr -> oh_sz));
00315         PRINT_CALL_CHAIN(ohdr);
00316     }
00317 }
00318 
00319 void GC_check_heap_proc();
00320 
00321 void GC_start_debugging()
00322 {
00323     GC_check_heap = GC_check_heap_proc;
00324     GC_print_heap_obj = GC_debug_print_heap_obj_proc;
00325     GC_debugging_started = TRUE;
00326     GC_register_displacement((word)sizeof(oh));
00327 }
00328 
00329 # if defined(__STDC__) || defined(__cplusplus)
00330     void GC_debug_register_displacement(GC_word offset)
00331 # else
00332     void GC_debug_register_displacement(offset) 
00333     GC_word offset;
00334 # endif
00335 {
00336     GC_register_displacement(offset);
00337     GC_register_displacement((word)sizeof(oh) + offset);
00338 }
00339 
00340 # ifdef GC_ADD_CALLER
00341 #   define EXTRA_ARGS word ra, char * s, int i
00342 #   define OPT_RA ra,
00343 # else
00344 #   define EXTRA_ARGS char * s, int i
00345 #   define OPT_RA
00346 # endif
00347 
00348 # ifdef __STDC__
00349     GC_PTR GC_debug_malloc(size_t lb, EXTRA_ARGS)
00350 # else
00351     GC_PTR GC_debug_malloc(lb, s, i)
00352     size_t lb;
00353     char * s;
00354     int i;
00355 #   ifdef GC_ADD_CALLER
00356     --> GC_ADD_CALLER not implemented for K&R C
00357 #   endif
00358 # endif
00359 {
00360     GC_PTR result = GC_malloc(lb + DEBUG_BYTES);
00361     
00362     if (result == 0) {
00363         GC_err_printf1("GC_debug_malloc(%ld) returning NIL (",
00364                    (unsigned long) lb);
00365         GC_err_puts(s);
00366         GC_err_printf1(":%ld)\n", (unsigned long)i);
00367         return(0);
00368     }
00369     if (!GC_debugging_started) {
00370         GC_start_debugging();
00371     }
00372     ADD_CALL_CHAIN(result, ra);
00373     return (GC_store_debug_info(result, (word)lb, s, (word)i));
00374 }
00375 
00376 #ifdef STUBBORN_ALLOC
00377 # ifdef __STDC__
00378     GC_PTR GC_debug_malloc_stubborn(size_t lb, EXTRA_ARGS)
00379 # else
00380     GC_PTR GC_debug_malloc_stubborn(lb, s, i)
00381     size_t lb;
00382     char * s;
00383     int i;
00384 # endif
00385 {
00386     GC_PTR result = GC_malloc_stubborn(lb + DEBUG_BYTES);
00387     
00388     if (result == 0) {
00389         GC_err_printf1("GC_debug_malloc(%ld) returning NIL (",
00390                    (unsigned long) lb);
00391         GC_err_puts(s);
00392         GC_err_printf1(":%ld)\n", (unsigned long)i);
00393         return(0);
00394     }
00395     if (!GC_debugging_started) {
00396         GC_start_debugging();
00397     }
00398     ADD_CALL_CHAIN(result, ra);
00399     return (GC_store_debug_info(result, (word)lb, s, (word)i));
00400 }
00401 
00402 void GC_debug_change_stubborn(p)
00403 GC_PTR p;
00404 {
00405     register GC_PTR q = GC_base(p);
00406     register hdr * hhdr;
00407     
00408     if (q == 0) {
00409         GC_err_printf1("Bad argument: 0x%lx to GC_debug_change_stubborn\n",
00410                    (unsigned long) p);
00411         ABORT("GC_debug_change_stubborn: bad arg");
00412     }
00413     hhdr = HDR(q);
00414     if (hhdr -> hb_obj_kind != STUBBORN) {
00415         GC_err_printf1("GC_debug_change_stubborn arg not stubborn: 0x%lx\n",
00416                    (unsigned long) p);
00417         ABORT("GC_debug_change_stubborn: arg not stubborn");
00418     }
00419     GC_change_stubborn(q);
00420 }
00421 
00422 void GC_debug_end_stubborn_change(p)
00423 GC_PTR p;
00424 {
00425     register GC_PTR q = GC_base(p);
00426     register hdr * hhdr;
00427     
00428     if (q == 0) {
00429         GC_err_printf1("Bad argument: 0x%lx to GC_debug_end_stubborn_change\n",
00430                    (unsigned long) p);
00431         ABORT("GC_debug_end_stubborn_change: bad arg");
00432     }
00433     hhdr = HDR(q);
00434     if (hhdr -> hb_obj_kind != STUBBORN) {
00435         GC_err_printf1("debug_end_stubborn_change arg not stubborn: 0x%lx\n",
00436                    (unsigned long) p);
00437         ABORT("GC_debug_end_stubborn_change: arg not stubborn");
00438     }
00439     GC_end_stubborn_change(q);
00440 }
00441 
00442 #endif /* STUBBORN_ALLOC */
00443 
00444 # ifdef __STDC__
00445     GC_PTR GC_debug_malloc_atomic(size_t lb, EXTRA_ARGS)
00446 # else
00447     GC_PTR GC_debug_malloc_atomic(lb, s, i)
00448     size_t lb;
00449     char * s;
00450     int i;
00451 # endif
00452 {
00453     GC_PTR result = GC_malloc_atomic(lb + DEBUG_BYTES);
00454     
00455     if (result == 0) {
00456         GC_err_printf1("GC_debug_malloc_atomic(%ld) returning NIL (",
00457                   (unsigned long) lb);
00458         GC_err_puts(s);
00459         GC_err_printf1(":%ld)\n", (unsigned long)i);
00460         return(0);
00461     }
00462     if (!GC_debugging_started) {
00463         GC_start_debugging();
00464     }
00465     ADD_CALL_CHAIN(result, ra);
00466     return (GC_store_debug_info(result, (word)lb, s, (word)i));
00467 }
00468 
00469 # ifdef __STDC__
00470     GC_PTR GC_debug_malloc_uncollectable(size_t lb, EXTRA_ARGS)
00471 # else
00472     GC_PTR GC_debug_malloc_uncollectable(lb, s, i)
00473     size_t lb;
00474     char * s;
00475     int i;
00476 # endif
00477 {
00478     GC_PTR result = GC_malloc_uncollectable(lb + DEBUG_BYTES);
00479     
00480     if (result == 0) {
00481         GC_err_printf1("GC_debug_malloc_uncollectable(%ld) returning NIL (",
00482                   (unsigned long) lb);
00483         GC_err_puts(s);
00484         GC_err_printf1(":%ld)\n", (unsigned long)i);
00485         return(0);
00486     }
00487     if (!GC_debugging_started) {
00488         GC_start_debugging();
00489     }
00490     ADD_CALL_CHAIN(result, ra);
00491     return (GC_store_debug_info(result, (word)lb, s, (word)i));
00492 }
00493 
00494 #ifdef ATOMIC_UNCOLLECTABLE
00495 # ifdef __STDC__
00496     GC_PTR GC_debug_malloc_atomic_uncollectable(size_t lb, EXTRA_ARGS)
00497 # else
00498     GC_PTR GC_debug_malloc_atomic_uncollectable(lb, s, i)
00499     size_t lb;
00500     char * s;
00501     int i;
00502 # endif
00503 {
00504     GC_PTR result = GC_malloc_atomic_uncollectable(lb + DEBUG_BYTES);
00505     
00506     if (result == 0) {
00507         GC_err_printf1(
00508         "GC_debug_malloc_atomic_uncollectable(%ld) returning NIL (",
00509                 (unsigned long) lb);
00510         GC_err_puts(s);
00511         GC_err_printf1(":%ld)\n", (unsigned long)i);
00512         return(0);
00513     }
00514     if (!GC_debugging_started) {
00515         GC_start_debugging();
00516     }
00517     ADD_CALL_CHAIN(result, ra);
00518     return (GC_store_debug_info(result, (word)lb, s, (word)i));
00519 }
00520 #endif /* ATOMIC_UNCOLLECTABLE */
00521 
00522 # ifdef __STDC__
00523     void GC_debug_free(GC_PTR p)
00524 # else
00525     void GC_debug_free(p)
00526     GC_PTR p;
00527 # endif
00528 {
00529     register GC_PTR base = GC_base(p);
00530     register ptr_t clobbered;
00531     
00532     /* ignore free(NULL) */
00533     if (p == 0)
00534       return;
00535 
00536     if (base == 0) {
00537         GC_err_printf1("Attempt to free invalid pointer %lx\n",
00538                    (unsigned long)p);
00539         if (p != 0) ABORT("free(invalid pointer)");
00540     }
00541     if ((ptr_t)p - (ptr_t)base != sizeof(oh)) {
00542         GC_err_printf1(
00543               "GC_debug_free called on pointer %lx wo debugging info\n",
00544               (unsigned long)p);
00545     } else {
00546       oh * ohdr = (oh *)base;
00547       clobbered = GC_check_annotated_obj(ohdr);
00548       if (clobbered != 0) {
00549         if (ohdr -> oh_sz == GC_size(base)) {
00550             GC_err_printf0(
00551                   "GC_debug_free: found previously deallocated (?) object at ");
00552         } else {
00553             GC_err_printf0("GC_debug_free: found smashed object at ");
00554         }
00555         GC_print_smashed_obj(p, clobbered);
00556       }
00557       /* Invalidate size */
00558       ohdr -> oh_sz = GC_size(base);
00559     }
00560 #   ifdef FIND_LEAK
00561         GC_free(base);
00562 #   else
00563     {
00564         register hdr * hhdr = HDR(p);
00565         GC_bool uncollectable = FALSE;
00566 
00567         if (hhdr ->  hb_obj_kind == UNCOLLECTABLE) {
00568         uncollectable = TRUE;
00569         }
00570 #       ifdef ATOMIC_UNCOLLECTABLE
00571         if (hhdr ->  hb_obj_kind == AUNCOLLECTABLE) {
00572             uncollectable = TRUE;
00573         }
00574 #       endif
00575         if (uncollectable) GC_free(base);
00576     }
00577 #   endif
00578 }
00579 
00580 # ifdef __STDC__
00581     GC_PTR GC_debug_realloc(GC_PTR p, size_t lb, EXTRA_ARGS)
00582 # else
00583     GC_PTR GC_debug_realloc(p, lb, s, i)
00584     GC_PTR p;
00585     size_t lb;
00586     char *s;
00587     int i;
00588 # endif
00589 {
00590     register GC_PTR base = GC_base(p);
00591     register ptr_t clobbered;
00592     register GC_PTR result;
00593     register size_t copy_sz = lb;
00594     register size_t old_sz;
00595     register hdr * hhdr;
00596     
00597     if (p == 0) return(GC_debug_malloc(lb, OPT_RA s, i));
00598     if (base == 0) {
00599         GC_err_printf1(
00600               "Attempt to reallocate invalid pointer %lx\n", (unsigned long)p);
00601         ABORT("realloc(invalid pointer)");
00602     }
00603     if ((ptr_t)p - (ptr_t)base != sizeof(oh)) {
00604         GC_err_printf1(
00605             "GC_debug_realloc called on pointer %lx wo debugging info\n",
00606             (unsigned long)p);
00607         return(GC_realloc(p, lb));
00608     }
00609     hhdr = HDR(base);
00610     switch (hhdr -> hb_obj_kind) {
00611 #    ifdef STUBBORN_ALLOC
00612       case STUBBORN:
00613         result = GC_debug_malloc_stubborn(lb, OPT_RA s, i);
00614         break;
00615 #    endif
00616       case NORMAL:
00617         result = GC_debug_malloc(lb, OPT_RA s, i);
00618         break;
00619       case PTRFREE:
00620         result = GC_debug_malloc_atomic(lb, OPT_RA s, i);
00621         break;
00622       case UNCOLLECTABLE:
00623     result = GC_debug_malloc_uncollectable(lb, OPT_RA s, i);
00624     break;
00625 #    ifdef ATOMIC_UNCOLLECTABLE
00626       case AUNCOLLECTABLE:
00627     result = GC_debug_malloc_atomic_uncollectable(lb, OPT_RA s, i);
00628     break;
00629 #    endif
00630       default:
00631         GC_err_printf0("GC_debug_realloc: encountered bad kind\n");
00632         ABORT("bad kind");
00633     }
00634     clobbered = GC_check_annotated_obj((oh *)base);
00635     if (clobbered != 0) {
00636         GC_err_printf0("GC_debug_realloc: found smashed object at ");
00637         GC_print_smashed_obj(p, clobbered);
00638     }
00639     old_sz = ((oh *)base) -> oh_sz;
00640     if (old_sz < copy_sz) copy_sz = old_sz;
00641     if (result == 0) return(0);
00642     BCOPY(p, result,  copy_sz);
00643     GC_debug_free(p);
00644     return(result);
00645 }
00646 
00647 /* Check all marked objects in the given block for validity */
00648 /*ARGSUSED*/
00649 void GC_check_heap_block(hbp, dummy)
00650 register struct hblk *hbp;  /* ptr to current heap block        */
00651 word dummy;
00652 {
00653     register struct hblkhdr * hhdr = HDR(hbp);
00654     register word sz = hhdr -> hb_sz;
00655     register int word_no;
00656     register word *p, *plim;
00657     
00658     p = (word *)(hbp->hb_body);
00659     word_no = HDR_WORDS;
00660     if (sz > MAXOBJSZ) {
00661     plim = p;
00662     } else {
00663         plim = (word *)((((word)hbp) + HBLKSIZE) - WORDS_TO_BYTES(sz));
00664     }
00665     /* go through all words in block */
00666     while( p <= plim ) {
00667         if( mark_bit_from_hdr(hhdr, word_no)
00668             && GC_has_debug_info((ptr_t)p)) {
00669             ptr_t clobbered = GC_check_annotated_obj((oh *)p);
00670             
00671             if (clobbered != 0) {
00672                 GC_err_printf0(
00673                     "GC_check_heap_block: found smashed object at ");
00674                 GC_print_smashed_obj((ptr_t)p, clobbered);
00675             }
00676         }
00677         word_no += sz;
00678         p += sz;
00679     }
00680 }
00681 
00682 
00683 /* This assumes that all accessible objects are marked, and that    */
00684 /* I hold the allocation lock.  Normally called by collector.       */
00685 void GC_check_heap_proc()
00686 {
00687 #   ifndef SMALL_CONFIG
00688     if (sizeof(oh) & (2 * sizeof(word) - 1) != 0) {
00689         ABORT("Alignment problem: object header has inappropriate size\n");
00690     }
00691 #   endif
00692     GC_apply_to_all_blocks(GC_check_heap_block, (word)0);
00693 }
00694 
00695 struct closure {
00696     GC_finalization_proc cl_fn;
00697     GC_PTR cl_data;
00698 };
00699 
00700 # ifdef __STDC__
00701     void * GC_make_closure(GC_finalization_proc fn, void * data)
00702 # else
00703     GC_PTR GC_make_closure(fn, data)
00704     GC_finalization_proc fn;
00705     GC_PTR data;
00706 # endif
00707 {
00708     struct closure * result =
00709             (struct closure *) GC_malloc(sizeof (struct closure));
00710     
00711     result -> cl_fn = fn;
00712     result -> cl_data = data;
00713     return((GC_PTR)result);
00714 }
00715 
00716 # ifdef __STDC__
00717     void GC_debug_invoke_finalizer(void * obj, void * data)
00718 # else
00719     void GC_debug_invoke_finalizer(obj, data)
00720     char * obj;
00721     char * data;
00722 # endif
00723 {
00724     register struct closure * cl = (struct closure *) data;
00725     
00726     (*(cl -> cl_fn))((GC_PTR)((char *)obj + sizeof(oh)), cl -> cl_data);
00727 } 
00728 
00729 
00730 # ifdef __STDC__
00731     void GC_debug_register_finalizer(GC_PTR obj, GC_finalization_proc fn,
00732                          GC_PTR cd, GC_finalization_proc *ofn,
00733                      GC_PTR *ocd)
00734 # else
00735     void GC_debug_register_finalizer(obj, fn, cd, ofn, ocd)
00736     GC_PTR obj;
00737     GC_finalization_proc fn;
00738     GC_PTR cd;
00739     GC_finalization_proc *ofn;
00740     GC_PTR *ocd;
00741 # endif
00742 {
00743     ptr_t base = GC_base(obj);
00744     if (0 == base || (ptr_t)obj - base != sizeof(oh)) {
00745         GC_err_printf1(
00746         "GC_register_finalizer called with non-base-pointer 0x%lx\n",
00747         obj);
00748     }
00749     GC_register_finalizer(base, GC_debug_invoke_finalizer,
00750                   GC_make_closure(fn,cd), ofn, ocd);
00751 }
00752 
00753 # ifdef __STDC__
00754     void GC_debug_register_finalizer_no_order
00755                         (GC_PTR obj, GC_finalization_proc fn,
00756                          GC_PTR cd, GC_finalization_proc *ofn,
00757                      GC_PTR *ocd)
00758 # else
00759     void GC_debug_register_finalizer_no_order
00760                         (obj, fn, cd, ofn, ocd)
00761     GC_PTR obj;
00762     GC_finalization_proc fn;
00763     GC_PTR cd;
00764     GC_finalization_proc *ofn;
00765     GC_PTR *ocd;
00766 # endif
00767 {
00768     ptr_t base = GC_base(obj);
00769     if (0 == base || (ptr_t)obj - base != sizeof(oh)) {
00770         GC_err_printf1(
00771       "GC_register_finalizer_no_order called with non-base-pointer 0x%lx\n",
00772       obj);
00773     }
00774     GC_register_finalizer_no_order(base, GC_debug_invoke_finalizer,
00775                           GC_make_closure(fn,cd), ofn, ocd);
00776  }
00777 
00778 # ifdef __STDC__
00779     void GC_debug_register_finalizer_ignore_self
00780                         (GC_PTR obj, GC_finalization_proc fn,
00781                          GC_PTR cd, GC_finalization_proc *ofn,
00782                      GC_PTR *ocd)
00783 # else
00784     void GC_debug_register_finalizer_ignore_self
00785                         (obj, fn, cd, ofn, ocd)
00786     GC_PTR obj;
00787     GC_finalization_proc fn;
00788     GC_PTR cd;
00789     GC_finalization_proc *ofn;
00790     GC_PTR *ocd;
00791 # endif
00792 {
00793     ptr_t base = GC_base(obj);
00794     if (0 == base || (ptr_t)obj - base != sizeof(oh)) {
00795         GC_err_printf1(
00796         "GC_register_finalizer_ignore_self called with non-base-pointer 0x%lx\n",
00797         obj);
00798     }
00799     GC_register_finalizer_ignore_self(base, GC_debug_invoke_finalizer,
00800                           GC_make_closure(fn,cd), ofn, ocd);
00801 }