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.
7 * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
8 * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
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.
17 #include "private/dbg_mlc.h"
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
));
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 */
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 */
35 GC_bool
GC_has_other_debug_info(p
)
38 register oh
* ohdr
= (oh
*)p
;
39 register ptr_t body
= (ptr_t
)(ohdr
+ 1);
40 register word sz
= GC_size((ptr_t
) ohdr
);
42 if (HBLKPTR((ptr_t
)ohdr
) != HBLKPTR((ptr_t
)body
)
43 || sz
< DEBUG_BYTES
+ EXTRA_BYTES
) {
46 if (ohdr
-> oh_sz
== sz
) {
47 /* Object may have had debug info, but has been deallocated */
50 if (ohdr
-> oh_sf
== (START_FLAG
^ (word
)body
)) return(TRUE
);
51 if (((word
*)ohdr
)[BYTES_TO_WORDS(sz
)-1] == (END_FLAG
^ (word
)body
)) {
62 # if defined(LINUX) || defined(SUNOS4) || defined(SUNOS5) \
63 || defined(HPUX) || defined(IRIX) || defined(OSF1)
64 # define RANDOM() random()
66 # define RANDOM() (long)rand()
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
)
77 if (GC_HAS_DEBUG_INFO(dest
)) {
78 ((oh
*)dest
) -> oh_back_ptr
= HIDE_BACK_PTR(source
);
82 void GC_marked_for_finalization(ptr_t dest
) {
83 GC_store_back_pointer(MARKED_FOR_FINALIZATION
, dest
);
86 /* Store information about the object referencing dest in *base_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
)
94 oh
* hdr
= (oh
*)GC_base(dest
);
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
;
103 /* Heuristically try to fix off by 1 errors we introduced by */
104 /* insisting on even addresses. */
106 ptr_t alternate_ptr
= bp
+ 1;
107 ptr_t target
= *(ptr_t
*)bp
;
108 ptr_t alternate_target
= *(ptr_t
*)alternate_ptr
;
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
)) {
118 bp_base
= GC_base(bp
);
122 return GC_REFD_FROM_ROOT
;
124 if (GC_HAS_DEBUG_INFO(bp_base
)) bp_base
+= sizeof(oh
);
126 *offset_p
= bp
- bp_base
;
127 return GC_REFD_FROM_HEAP
;
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)
137 long heap_offset
= RANDOM();
138 if (GC_heapsize
> RAND_MAX
) {
139 heap_offset
*= RAND_MAX
;
140 heap_offset
+= RANDOM();
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
;
154 ABORT("GC_generate_random_heap_address: size inconsistency");
159 /* Generate a random address inside a valid marked heap object. */
160 void *GC_generate_random_valid_address(void)
165 result
= GC_generate_random_heap_address();
166 base
= GC_base(result
);
167 if (0 == base
) continue;
168 if (!GC_is_marked(base
)) continue;
173 /* Print back trace for p */
174 void GC_print_backtrace(void *p
)
182 GC_print_heap_obj(GC_base(current
));
183 GC_err_printf0("\n");
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");
190 if (GC_NO_SPACE
== source
) {
191 GC_err_printf0("No debug info in object: Can't find reference\n");
194 GC_err_printf1("Reachable via %d levels of pointers from ",
197 case GC_REFD_FROM_ROOT
:
198 GC_err_printf1("root at 0x%lx\n", (unsigned long)base
);
200 case GC_REFD_FROM_REG
:
201 GC_err_printf0("root in register\n");
203 case GC_FINALIZER_REFD
:
204 GC_err_printf0("list of finalizable objects\n");
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");
218 /* Force a garbage collection and generate a backtrace from a */
219 /* random heap address. */
220 void GC_generate_random_backtrace(void)
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
);
229 #endif /* KEEP_BACK_PTRS */
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 */
236 GC_CONST
char * string
;
239 register word
* result
= (word
*)((oh
*)p
+ 1);
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. */
246 # ifdef KEEP_BACK_PTRS
247 ((oh
*)p
) -> oh_back_ptr
= HIDE_BACK_PTR(NOT_MARKED
);
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
;
258 return((ptr_t
)result
);
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 */
270 register word
* result
= (word
*)((oh
*)p
+ 1);
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
);
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
;
286 return((ptr_t
)result
);
290 #ifndef SHORT_DBG_HDRS
291 /* Check the object with debugging info at ohdr */
292 /* return NIL if it's OK. Else return clobbered */
294 ptr_t
GC_check_annotated_obj(ohdr
)
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
)));
302 if (ohdr
-> oh_sf
!= (START_FLAG
^ (word
)body
)) {
303 return((ptr_t
)(&(ohdr
-> oh_sf
)));
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));
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
)));
314 #endif /* !SHORT_DBG_HDRS */
319 register oh
* ohdr
= (oh
*)GC_base(p
);
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
));
326 GC_err_printf2(":%ld, sz=%ld)\n", (unsigned long)(ohdr
-> oh_int
),
327 (unsigned long)(ohdr
-> oh_sz
));
329 PRINT_CALL_CHAIN(ohdr
);
332 # if defined(__STDC__) || defined(__cplusplus)
333 void GC_debug_print_heap_obj_proc(ptr_t p
)
335 void GC_debug_print_heap_obj_proc(p
)
339 if (GC_HAS_DEBUG_INFO(p
)) {
342 GC_default_print_heap_obj_proc(p
);
346 #ifndef SHORT_DBG_HDRS
347 void GC_print_smashed_obj(p
, clobbered_addr
)
348 ptr_t p
, clobbered_addr
;
350 register oh
* ohdr
= (oh
*)GC_base(p
);
352 GC_err_printf2("0x%lx in object at 0x%lx(", (unsigned long)clobbered_addr
,
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
));
359 if (ohdr
-> oh_string
[0] == '\0') {
360 GC_err_puts("EMPTY(smashed?)");
362 GC_err_puts(ohdr
-> oh_string
);
364 GC_err_printf2(":%ld, sz=%ld)\n", (unsigned long)(ohdr
-> oh_int
),
365 (unsigned long)(ohdr
-> oh_sz
));
366 PRINT_CALL_CHAIN(ohdr
);
371 void GC_check_heap_proc
GC_PROTO((void));
373 void GC_do_nothing() {}
375 void GC_start_debugging()
377 # ifndef SHORT_DBG_HDRS
378 GC_check_heap
= GC_check_heap_proc
;
380 GC_check_heap
= GC_do_nothing
;
382 GC_print_heap_obj
= GC_debug_print_heap_obj_proc
;
383 GC_debugging_started
= TRUE
;
384 GC_register_displacement((word
)sizeof(oh
));
387 # if defined(__STDC__) || defined(__cplusplus)
388 void GC_debug_register_displacement(GC_word offset
)
390 void GC_debug_register_displacement(offset
)
394 GC_register_displacement(offset
);
395 GC_register_displacement((word
)sizeof(oh
) + offset
);
399 GC_PTR
GC_debug_malloc(size_t lb
, GC_EXTRA_PARAMS
)
401 GC_PTR
GC_debug_malloc(lb
, s
, i
)
405 # ifdef GC_ADD_CALLER
406 --> GC_ADD_CALLER
not implemented
for K
&R C
410 GC_PTR result
= GC_malloc(lb
+ DEBUG_BYTES
);
413 GC_err_printf1("GC_debug_malloc(%ld) returning NIL (",
416 GC_err_printf1(":%ld)\n", (unsigned long)i
);
419 if (!GC_debugging_started
) {
420 GC_start_debugging();
422 ADD_CALL_CHAIN(result
, ra
);
423 return (GC_store_debug_info(result
, (word
)lb
, s
, (word
)i
));
428 * An allocation function for internal use.
429 * Normally internally allocated objects do not have debug information.
430 * But in this case, we need to make sure that all objects have debug
432 * We assume debugging was started in collector initialization,
433 * and we already hold the GC lock.
435 GC_PTR
GC_debug_generic_malloc_inner(size_t lb
, int k
)
437 GC_PTR result
= GC_generic_malloc_inner(lb
+ DEBUG_BYTES
, k
);
440 GC_err_printf1("GC internal allocation (%ld bytes) returning NIL\n",
444 ADD_CALL_CHAIN(result
, ra
);
445 return (GC_store_debug_info_inner(result
, (word
)lb
, "INTERNAL", (word
)0));
448 GC_PTR
GC_debug_generic_malloc_inner_ignore_off_page(size_t lb
, int k
)
450 GC_PTR result
= GC_generic_malloc_inner_ignore_off_page(
451 lb
+ DEBUG_BYTES
, k
);
454 GC_err_printf1("GC internal allocation (%ld bytes) returning NIL\n",
458 ADD_CALL_CHAIN(result
, ra
);
459 return (GC_store_debug_info_inner(result
, (word
)lb
, "INTERNAL", (word
)0));
463 #ifdef STUBBORN_ALLOC
465 GC_PTR
GC_debug_malloc_stubborn(size_t lb
, GC_EXTRA_PARAMS
)
467 GC_PTR
GC_debug_malloc_stubborn(lb
, s
, i
)
473 GC_PTR result
= GC_malloc_stubborn(lb
+ DEBUG_BYTES
);
476 GC_err_printf1("GC_debug_malloc(%ld) returning NIL (",
479 GC_err_printf1(":%ld)\n", (unsigned long)i
);
482 if (!GC_debugging_started
) {
483 GC_start_debugging();
485 ADD_CALL_CHAIN(result
, ra
);
486 return (GC_store_debug_info(result
, (word
)lb
, s
, (word
)i
));
489 void GC_debug_change_stubborn(p
)
492 register GC_PTR q
= GC_base(p
);
496 GC_err_printf1("Bad argument: 0x%lx to GC_debug_change_stubborn\n",
498 ABORT("GC_debug_change_stubborn: bad arg");
501 if (hhdr
-> hb_obj_kind
!= STUBBORN
) {
502 GC_err_printf1("GC_debug_change_stubborn arg not stubborn: 0x%lx\n",
504 ABORT("GC_debug_change_stubborn: arg not stubborn");
506 GC_change_stubborn(q
);
509 void GC_debug_end_stubborn_change(p
)
512 register GC_PTR q
= GC_base(p
);
516 GC_err_printf1("Bad argument: 0x%lx to GC_debug_end_stubborn_change\n",
518 ABORT("GC_debug_end_stubborn_change: bad arg");
521 if (hhdr
-> hb_obj_kind
!= STUBBORN
) {
522 GC_err_printf1("debug_end_stubborn_change arg not stubborn: 0x%lx\n",
524 ABORT("GC_debug_end_stubborn_change: arg not stubborn");
526 GC_end_stubborn_change(q
);
529 #else /* !STUBBORN_ALLOC */
532 GC_PTR
GC_debug_malloc_stubborn(size_t lb
, GC_EXTRA_PARAMS
)
534 GC_PTR
GC_debug_malloc_stubborn(lb
, s
, i
)
540 return GC_debug_malloc(lb
, OPT_RA s
, i
);
543 void GC_debug_change_stubborn(p
)
548 void GC_debug_end_stubborn_change(p
)
553 #endif /* !STUBBORN_ALLOC */
556 GC_PTR
GC_debug_malloc_atomic(size_t lb
, GC_EXTRA_PARAMS
)
558 GC_PTR
GC_debug_malloc_atomic(lb
, s
, i
)
564 GC_PTR result
= GC_malloc_atomic(lb
+ DEBUG_BYTES
);
567 GC_err_printf1("GC_debug_malloc_atomic(%ld) returning NIL (",
570 GC_err_printf1(":%ld)\n", (unsigned long)i
);
573 if (!GC_debugging_started
) {
574 GC_start_debugging();
576 ADD_CALL_CHAIN(result
, ra
);
577 return (GC_store_debug_info(result
, (word
)lb
, s
, (word
)i
));
581 GC_PTR
GC_debug_malloc_uncollectable(size_t lb
, GC_EXTRA_PARAMS
)
583 GC_PTR
GC_debug_malloc_uncollectable(lb
, s
, i
)
589 GC_PTR result
= GC_malloc_uncollectable(lb
+ DEBUG_BYTES
);
592 GC_err_printf1("GC_debug_malloc_uncollectable(%ld) returning NIL (",
595 GC_err_printf1(":%ld)\n", (unsigned long)i
);
598 if (!GC_debugging_started
) {
599 GC_start_debugging();
601 ADD_CALL_CHAIN(result
, ra
);
602 return (GC_store_debug_info(result
, (word
)lb
, s
, (word
)i
));
605 #ifdef ATOMIC_UNCOLLECTABLE
607 GC_PTR
GC_debug_malloc_atomic_uncollectable(size_t lb
, GC_EXTRA_PARAMS
)
609 GC_PTR
GC_debug_malloc_atomic_uncollectable(lb
, s
, i
)
615 GC_PTR result
= GC_malloc_atomic_uncollectable(lb
+ DEBUG_BYTES
);
619 "GC_debug_malloc_atomic_uncollectable(%ld) returning NIL (",
622 GC_err_printf1(":%ld)\n", (unsigned long)i
);
625 if (!GC_debugging_started
) {
626 GC_start_debugging();
628 ADD_CALL_CHAIN(result
, ra
);
629 return (GC_store_debug_info(result
, (word
)lb
, s
, (word
)i
));
631 #endif /* ATOMIC_UNCOLLECTABLE */
634 void GC_debug_free(GC_PTR p
)
636 void GC_debug_free(p
)
640 register GC_PTR base
;
641 register ptr_t clobbered
;
646 GC_err_printf1("Attempt to free invalid pointer %lx\n",
648 ABORT("free(invalid pointer)");
650 if ((ptr_t
)p
- (ptr_t
)base
!= sizeof(oh
)) {
652 "GC_debug_free called on pointer %lx wo debugging info\n",
655 # ifndef SHORT_DBG_HDRS
656 clobbered
= GC_check_annotated_obj((oh
*)base
);
657 if (clobbered
!= 0) {
658 if (((oh
*)base
) -> oh_sz
== GC_size(base
)) {
660 "GC_debug_free: found previously deallocated (?) object at ");
662 GC_err_printf0("GC_debug_free: found smashed location at ");
664 GC_print_smashed_obj(p
, clobbered
);
666 /* Invalidate size */
667 ((oh
*)base
) -> oh_sz
= GC_size(base
);
668 # endif /* SHORT_DBG_HDRS */
673 register hdr
* hhdr
= HDR(p
);
674 GC_bool uncollectable
= FALSE
;
676 if (hhdr
-> hb_obj_kind
== UNCOLLECTABLE
) {
677 uncollectable
= TRUE
;
679 # ifdef ATOMIC_UNCOLLECTABLE
680 if (hhdr
-> hb_obj_kind
== AUNCOLLECTABLE
) {
681 uncollectable
= TRUE
;
684 if (uncollectable
) GC_free(base
);
685 } /* !GC_find_leak */
690 extern void GC_free_inner(GC_PTR p
);
692 /* Used internally; we assume it's called correctly. */
693 void GC_debug_free_inner(GC_PTR p
)
695 GC_free_inner(GC_base(p
));
700 GC_PTR
GC_debug_realloc(GC_PTR p
, size_t lb
, GC_EXTRA_PARAMS
)
702 GC_PTR
GC_debug_realloc(p
, lb
, s
, i
)
709 register GC_PTR base
= GC_base(p
);
710 register ptr_t clobbered
;
711 register GC_PTR result
;
712 register size_t copy_sz
= lb
;
713 register size_t old_sz
;
716 if (p
== 0) return(GC_debug_malloc(lb
, OPT_RA s
, i
));
719 "Attempt to reallocate invalid pointer %lx\n", (unsigned long)p
);
720 ABORT("realloc(invalid pointer)");
722 if ((ptr_t
)p
- (ptr_t
)base
!= sizeof(oh
)) {
724 "GC_debug_realloc called on pointer %lx wo debugging info\n",
726 return(GC_realloc(p
, lb
));
729 switch (hhdr
-> hb_obj_kind
) {
730 # ifdef STUBBORN_ALLOC
732 result
= GC_debug_malloc_stubborn(lb
, OPT_RA s
, i
);
736 result
= GC_debug_malloc(lb
, OPT_RA s
, i
);
739 result
= GC_debug_malloc_atomic(lb
, OPT_RA s
, i
);
742 result
= GC_debug_malloc_uncollectable(lb
, OPT_RA s
, i
);
744 # ifdef ATOMIC_UNCOLLECTABLE
746 result
= GC_debug_malloc_atomic_uncollectable(lb
, OPT_RA s
, i
);
750 GC_err_printf0("GC_debug_realloc: encountered bad kind\n");
753 # ifdef SHORT_DBG_HDRS
754 old_sz
= GC_size(base
) - sizeof(oh
);
756 clobbered
= GC_check_annotated_obj((oh
*)base
);
757 if (clobbered
!= 0) {
758 GC_err_printf0("GC_debug_realloc: found smashed location at ");
759 GC_print_smashed_obj(p
, clobbered
);
761 old_sz
= ((oh
*)base
) -> oh_sz
;
763 if (old_sz
< copy_sz
) copy_sz
= old_sz
;
764 if (result
== 0) return(0);
765 BCOPY(p
, result
, copy_sz
);
770 #ifndef SHORT_DBG_HDRS
771 /* Check all marked objects in the given block for validity */
773 # if defined(__STDC__) || defined(__cplusplus)
774 void GC_check_heap_block(register struct hblk
*hbp
, word dummy
)
776 void GC_check_heap_block(hbp
, dummy
)
777 register struct hblk
*hbp
; /* ptr to current heap block */
781 register struct hblkhdr
* hhdr
= HDR(hbp
);
782 register word sz
= hhdr
-> hb_sz
;
783 register int word_no
;
784 register word
*p
, *plim
;
786 p
= (word
*)(hbp
->hb_body
);
791 plim
= (word
*)((((word
)hbp
) + HBLKSIZE
) - WORDS_TO_BYTES(sz
));
793 /* go through all words in block */
795 if( mark_bit_from_hdr(hhdr
, word_no
)
796 && GC_HAS_DEBUG_INFO((ptr_t
)p
)) {
797 ptr_t clobbered
= GC_check_annotated_obj((oh
*)p
);
799 if (clobbered
!= 0) {
801 "GC_check_heap_block: found smashed location at ");
802 GC_print_smashed_obj((ptr_t
)p
, clobbered
);
811 /* This assumes that all accessible objects are marked, and that */
812 /* I hold the allocation lock. Normally called by collector. */
813 void GC_check_heap_proc()
815 # ifndef SMALL_CONFIG
816 if (sizeof(oh
) & (2 * sizeof(word
) - 1) != 0) {
817 ABORT("Alignment problem: object header has inappropriate size\n");
820 GC_apply_to_all_blocks(GC_check_heap_block
, (word
)0);
823 #endif /* !SHORT_DBG_HDRS */
826 GC_finalization_proc cl_fn
;
831 void * GC_make_closure(GC_finalization_proc fn
, void * data
)
833 GC_PTR
GC_make_closure(fn
, data
)
834 GC_finalization_proc fn
;
838 struct closure
* result
=
840 (struct closure
*) GC_debug_malloc(sizeof (struct closure
),
843 (struct closure
*) GC_malloc(sizeof (struct closure
));
846 result
-> cl_fn
= fn
;
847 result
-> cl_data
= data
;
848 return((GC_PTR
)result
);
852 void GC_debug_invoke_finalizer(void * obj
, void * data
)
854 void GC_debug_invoke_finalizer(obj
, data
)
859 register struct closure
* cl
= (struct closure
*) data
;
861 (*(cl
-> cl_fn
))((GC_PTR
)((char *)obj
+ sizeof(oh
)), cl
-> cl_data
);
864 /* Set ofn and ocd to reflect the values we got back. */
865 static void store_old (obj
, my_old_fn
, my_old_cd
, ofn
, ocd
)
867 GC_finalization_proc my_old_fn
;
868 struct closure
* my_old_cd
;
869 GC_finalization_proc
*ofn
;
872 if (0 != my_old_fn
) {
873 if (my_old_fn
!= GC_debug_invoke_finalizer
) {
874 GC_err_printf1("Debuggable object at 0x%lx had non-debug finalizer.\n",
876 /* This should probably be fatal. */
878 if (ofn
) *ofn
= my_old_cd
-> cl_fn
;
879 if (ocd
) *ocd
= my_old_cd
-> cl_data
;
888 void GC_debug_register_finalizer(GC_PTR obj
, GC_finalization_proc fn
,
889 GC_PTR cd
, GC_finalization_proc
*ofn
,
892 void GC_debug_register_finalizer(obj
, fn
, cd
, ofn
, ocd
)
894 GC_finalization_proc fn
;
896 GC_finalization_proc
*ofn
;
900 GC_finalization_proc my_old_fn
;
902 ptr_t base
= GC_base(obj
);
903 if (0 == base
|| (ptr_t
)obj
- base
!= sizeof(oh
)) {
905 "GC_register_finalizer called with non-base-pointer 0x%lx\n",
909 GC_register_finalizer(base
, 0, 0, &my_old_fn
, &my_old_cd
);
911 GC_register_finalizer(base
, GC_debug_invoke_finalizer
,
912 GC_make_closure(fn
,cd
), &my_old_fn
, &my_old_cd
);
914 store_old(obj
, my_old_fn
, (struct closure
*)my_old_cd
, ofn
, ocd
);
918 void GC_debug_register_finalizer_no_order
919 (GC_PTR obj
, GC_finalization_proc fn
,
920 GC_PTR cd
, GC_finalization_proc
*ofn
,
923 void GC_debug_register_finalizer_no_order
924 (obj
, fn
, cd
, ofn
, ocd
)
926 GC_finalization_proc fn
;
928 GC_finalization_proc
*ofn
;
932 GC_finalization_proc my_old_fn
;
934 ptr_t base
= GC_base(obj
);
935 if (0 == base
|| (ptr_t
)obj
- base
!= sizeof(oh
)) {
937 "GC_register_finalizer_no_order called with non-base-pointer 0x%lx\n",
941 GC_register_finalizer_no_order(base
, 0, 0, &my_old_fn
, &my_old_cd
);
943 GC_register_finalizer_no_order(base
, GC_debug_invoke_finalizer
,
944 GC_make_closure(fn
,cd
), &my_old_fn
,
947 store_old(obj
, my_old_fn
, (struct closure
*)my_old_cd
, ofn
, ocd
);
951 void GC_debug_register_finalizer_ignore_self
952 (GC_PTR obj
, GC_finalization_proc fn
,
953 GC_PTR cd
, GC_finalization_proc
*ofn
,
956 void GC_debug_register_finalizer_ignore_self
957 (obj
, fn
, cd
, ofn
, ocd
)
959 GC_finalization_proc fn
;
961 GC_finalization_proc
*ofn
;
965 GC_finalization_proc my_old_fn
;
967 ptr_t base
= GC_base(obj
);
968 if (0 == base
|| (ptr_t
)obj
- base
!= sizeof(oh
)) {
970 "GC_register_finalizer_ignore_self called with non-base-pointer 0x%lx\n",
974 GC_register_finalizer_ignore_self(base
, 0, 0, &my_old_fn
, &my_old_cd
);
976 GC_register_finalizer_ignore_self(base
, GC_debug_invoke_finalizer
,
977 GC_make_closure(fn
,cd
), &my_old_fn
,
980 store_old(obj
, my_old_fn
, (struct closure
*)my_old_cd
, ofn
, ocd
);
984 # define RA GC_RETURN_ADDR,
989 GC_PTR
GC_debug_malloc_replacement(lb
)
992 return GC_debug_malloc(lb
, RA
"unknown", 0);
995 GC_PTR
GC_debug_realloc_replacement(p
, lb
)
999 return GC_debug_realloc(p
, lb
, RA
"unknown", 0);