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 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.
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 /* Check whether object with base pointer p has debugging info */
26 /* p is assumed to point to a legitimate object in our part */
28 GC_bool
GC_has_debug_info(p
)
31 register oh
* ohdr
= (oh
*)p
;
32 register ptr_t body
= (ptr_t
)(ohdr
+ 1);
33 register word sz
= GC_size((ptr_t
) ohdr
);
35 if (HBLKPTR((ptr_t
)ohdr
) != HBLKPTR((ptr_t
)body
)
36 || sz
< sizeof (oh
)) {
39 if (ohdr
-> oh_sz
== sz
) {
40 /* Object may have had debug info, but has been deallocated */
43 if (ohdr
-> oh_sf
== (START_FLAG
^ (word
)body
)) return(TRUE
);
44 if (((word
*)ohdr
)[BYTES_TO_WORDS(sz
)-1] == (END_FLAG
^ (word
)body
)) {
51 /* Store back pointer to source in dest, if that appears to be possible. */
52 /* This is not completely safe, since we may mistakenly conclude that */
53 /* dest has a debugging wrapper. But the error probability is very */
54 /* small, and this shouldn't be used in production code. */
55 /* We assume that dest is the real base pointer. Source will usually */
56 /* be a pointer to the interior of an object. */
57 void GC_store_back_pointer(ptr_t source
, ptr_t dest
)
59 if (GC_has_debug_info(dest
)) {
60 ((oh
*)dest
) -> oh_back_ptr
= (ptr_t
)HIDE_POINTER(source
);
64 void GC_marked_for_finalization(ptr_t dest
) {
65 GC_store_back_pointer(MARKED_FOR_FINALIZATION
, dest
);
68 /* Store information about the object referencing dest in *base_p */
70 /* source is root ==> *base_p = address, *offset_p = 0 */
71 /* source is heap object ==> *base_p != 0, *offset_p = offset */
72 /* Returns 1 on success, 0 if source couldn't be determined. */
73 /* Dest can be any address within a heap object. */
74 GC_ref_kind
GC_get_back_ptr_info(void *dest
, void **base_p
, size_t *offset_p
)
76 oh
* hdr
= (oh
*)GC_base(dest
);
79 if (!GC_has_debug_info((ptr_t
) hdr
)) return GC_NO_SPACE
;
80 bp
= hdr
-> oh_back_ptr
;
81 if (MARKED_FOR_FINALIZATION
== bp
) return GC_FINALIZER_REFD
;
82 if (MARKED_FROM_REGISTER
== bp
) return GC_REFD_FROM_REG
;
83 if (0 == bp
) return GC_UNREFERENCED
;
84 bp
= REVEAL_POINTER(bp
);
85 bp_base
= GC_base(bp
);
89 return GC_REFD_FROM_ROOT
;
91 if (GC_has_debug_info(bp_base
)) bp_base
+= sizeof(oh
);
93 *offset_p
= bp
- bp_base
;
94 return GC_REFD_FROM_HEAP
;
98 /* Generate a random heap address. */
99 /* The resulting address is in the heap, but */
100 /* not necessarily inside a valid object. */
101 void *GC_generate_random_heap_address(void)
104 int heap_offset
= random() % GC_heapsize
;
105 for (i
= 0; i
< GC_n_heap_sects
; ++ i
) {
106 int size
= GC_heap_sects
[i
].hs_bytes
;
107 if (heap_offset
< size
) {
108 return GC_heap_sects
[i
].hs_start
+ heap_offset
;
113 ABORT("GC_generate_random_heap_address: size inconsistency");
118 /* Generate a random address inside a valid marked heap object. */
119 void *GC_generate_random_valid_address(void)
124 result
= GC_generate_random_heap_address();
125 base
= GC_base(result
);
126 if (0 == base
) continue;
127 if (!GC_is_marked(base
)) continue;
132 /* Print back trace for p */
133 void GC_print_backtrace(void *p
)
141 GC_print_heap_obj(GC_base(current
));
142 GC_err_printf0("\n");
144 source
= GC_get_back_ptr_info(current
, &base
, &offset
);
145 if (GC_UNREFERENCED
== source
) {
146 GC_err_printf0("Reference could not be found\n");
149 if (GC_NO_SPACE
== source
) {
150 GC_err_printf0("No debug info in object: Can't find reference\n");
153 GC_err_printf1("Reachable via %d levels of pointers from ",
156 case GC_REFD_FROM_ROOT
:
157 GC_err_printf1("root at 0x%lx\n", (unsigned long)base
);
159 case GC_REFD_FROM_REG
:
160 GC_err_printf0("root in register\n");
162 case GC_FINALIZER_REFD
:
163 GC_err_printf0("list of finalizable objects\n");
165 case GC_REFD_FROM_HEAP
:
166 GC_err_printf1("offset %ld in object:\n", (unsigned long)offset
);
167 /* Take GC_base(base) to get real base, i.e. header. */
168 GC_print_heap_obj(GC_base(base
));
169 GC_err_printf0("\n");
177 /* Force a garbage collection and generate a backtrace from a */
178 /* random heap address. */
179 void GC_generate_random_backtrace(void)
183 current
= GC_generate_random_valid_address();
184 GC_printf1("Chose address 0x%lx in object\n", (unsigned long)current
);
185 GC_print_backtrace(current
);
188 #endif /* KEEP_BACK_PTRS */
190 /* Store debugging info into p. Return displaced pointer. */
191 /* Assumes we don't hold allocation lock. */
192 ptr_t
GC_store_debug_info(p
, sz
, string
, integer
)
193 register ptr_t p
; /* base pointer */
198 register word
* result
= (word
*)((oh
*)p
+ 1);
201 /* There is some argument that we should dissble signals here. */
202 /* But that's expensive. And this way things should only appear */
203 /* inconsistent while we're in the handler. */
205 # ifdef KEEP_BACK_PTRS
206 ((oh
*)p
) -> oh_back_ptr
= 0;
208 ((oh
*)p
) -> oh_string
= string
;
209 ((oh
*)p
) -> oh_int
= integer
;
210 ((oh
*)p
) -> oh_sz
= sz
;
211 ((oh
*)p
) -> oh_sf
= START_FLAG
^ (word
)result
;
212 ((word
*)p
)[BYTES_TO_WORDS(GC_size(p
))-1] =
213 result
[ROUNDED_UP_WORDS(sz
)] = END_FLAG
^ (word
)result
;
215 return((ptr_t
)result
);
218 /* Check the object with debugging info at ohdr */
219 /* return NIL if it's OK. Else return clobbered */
221 ptr_t
GC_check_annotated_obj(ohdr
)
224 register ptr_t body
= (ptr_t
)(ohdr
+ 1);
225 register word gc_sz
= GC_size((ptr_t
)ohdr
);
226 if (ohdr
-> oh_sz
+ DEBUG_BYTES
> gc_sz
) {
227 return((ptr_t
)(&(ohdr
-> oh_sz
)));
229 if (ohdr
-> oh_sf
!= (START_FLAG
^ (word
)body
)) {
230 return((ptr_t
)(&(ohdr
-> oh_sf
)));
232 if (((word
*)ohdr
)[BYTES_TO_WORDS(gc_sz
)-1] != (END_FLAG
^ (word
)body
)) {
233 return((ptr_t
)((word
*)ohdr
+ BYTES_TO_WORDS(gc_sz
)-1));
235 if (((word
*)body
)[ROUNDED_UP_WORDS(ohdr
-> oh_sz
)]
236 != (END_FLAG
^ (word
)body
)) {
237 return((ptr_t
)((word
*)body
+ ROUNDED_UP_WORDS(ohdr
-> oh_sz
)));
245 register oh
* ohdr
= (oh
*)GC_base(p
);
247 GC_err_printf1("0x%lx (", ((unsigned long)ohdr
+ sizeof(oh
)));
248 GC_err_puts(ohdr
-> oh_string
);
249 GC_err_printf2(":%ld, sz=%ld)\n", (unsigned long)(ohdr
-> oh_int
),
250 (unsigned long)(ohdr
-> oh_sz
));
251 PRINT_CALL_CHAIN(ohdr
);
254 void GC_debug_print_heap_obj_proc(p
)
257 if (GC_has_debug_info(p
)) {
260 GC_default_print_heap_obj_proc(p
);
264 void GC_print_smashed_obj(p
, clobbered_addr
)
265 ptr_t p
, clobbered_addr
;
267 register oh
* ohdr
= (oh
*)GC_base(p
);
269 GC_err_printf2("0x%lx in object at 0x%lx(", (unsigned long)clobbered_addr
,
271 if (clobbered_addr
<= (ptr_t
)(&(ohdr
-> oh_sz
))
272 || ohdr
-> oh_string
== 0) {
273 GC_err_printf1("<smashed>, appr. sz = %ld)\n",
274 (GC_size((ptr_t
)ohdr
) - DEBUG_BYTES
));
276 if (ohdr
-> oh_string
[0] == '\0') {
277 GC_err_puts("EMPTY(smashed?)");
279 GC_err_puts(ohdr
-> oh_string
);
281 GC_err_printf2(":%ld, sz=%ld)\n", (unsigned long)(ohdr
-> oh_int
),
282 (unsigned long)(ohdr
-> oh_sz
));
283 PRINT_CALL_CHAIN(ohdr
);
287 void GC_check_heap_proc();
289 void GC_start_debugging()
291 GC_check_heap
= GC_check_heap_proc
;
292 GC_print_heap_obj
= GC_debug_print_heap_obj_proc
;
293 GC_debugging_started
= TRUE
;
294 GC_register_displacement((word
)sizeof(oh
));
297 # if defined(__STDC__) || defined(__cplusplus)
298 void GC_debug_register_displacement(GC_word offset
)
300 void GC_debug_register_displacement(offset
)
304 GC_register_displacement(offset
);
305 GC_register_displacement((word
)sizeof(oh
) + offset
);
309 GC_PTR
GC_debug_malloc(size_t lb
, GC_EXTRA_PARAMS
)
311 GC_PTR
GC_debug_malloc(lb
, s
, i
)
315 # ifdef GC_ADD_CALLER
316 --> GC_ADD_CALLER
not implemented
for K
&R C
320 GC_PTR result
= GC_malloc(lb
+ DEBUG_BYTES
);
323 GC_err_printf1("GC_debug_malloc(%ld) returning NIL (",
326 GC_err_printf1(":%ld)\n", (unsigned long)i
);
329 if (!GC_debugging_started
) {
330 GC_start_debugging();
332 ADD_CALL_CHAIN(result
, ra
);
333 return (GC_store_debug_info(result
, (word
)lb
, s
, (word
)i
));
337 GC_PTR
GC_debug_generic_malloc(size_t lb
, int k
, GC_EXTRA_PARAMS
)
339 GC_PTR
GC_debug_malloc(lb
, k
, s
, i
)
344 # ifdef GC_ADD_CALLER
345 --> GC_ADD_CALLER
not implemented
for K
&R C
349 GC_PTR result
= GC_generic_malloc(lb
+ DEBUG_BYTES
, k
);
352 GC_err_printf1("GC_debug_malloc(%ld) returning NIL (",
355 GC_err_printf1(":%ld)\n", (unsigned long)i
);
358 if (!GC_debugging_started
) {
359 GC_start_debugging();
361 ADD_CALL_CHAIN(result
, ra
);
362 return (GC_store_debug_info(result
, (word
)lb
, s
, (word
)i
));
365 #ifdef STUBBORN_ALLOC
367 GC_PTR
GC_debug_malloc_stubborn(size_t lb
, GC_EXTRA_PARAMS
)
369 GC_PTR
GC_debug_malloc_stubborn(lb
, s
, i
)
375 GC_PTR result
= GC_malloc_stubborn(lb
+ DEBUG_BYTES
);
378 GC_err_printf1("GC_debug_malloc(%ld) returning NIL (",
381 GC_err_printf1(":%ld)\n", (unsigned long)i
);
384 if (!GC_debugging_started
) {
385 GC_start_debugging();
387 ADD_CALL_CHAIN(result
, ra
);
388 return (GC_store_debug_info(result
, (word
)lb
, s
, (word
)i
));
391 void GC_debug_change_stubborn(p
)
394 register GC_PTR q
= GC_base(p
);
398 GC_err_printf1("Bad argument: 0x%lx to GC_debug_change_stubborn\n",
400 ABORT("GC_debug_change_stubborn: bad arg");
403 if (hhdr
-> hb_obj_kind
!= STUBBORN
) {
404 GC_err_printf1("GC_debug_change_stubborn arg not stubborn: 0x%lx\n",
406 ABORT("GC_debug_change_stubborn: arg not stubborn");
408 GC_change_stubborn(q
);
411 void GC_debug_end_stubborn_change(p
)
414 register GC_PTR q
= GC_base(p
);
418 GC_err_printf1("Bad argument: 0x%lx to GC_debug_end_stubborn_change\n",
420 ABORT("GC_debug_end_stubborn_change: bad arg");
423 if (hhdr
-> hb_obj_kind
!= STUBBORN
) {
424 GC_err_printf1("debug_end_stubborn_change arg not stubborn: 0x%lx\n",
426 ABORT("GC_debug_end_stubborn_change: arg not stubborn");
428 GC_end_stubborn_change(q
);
431 #endif /* STUBBORN_ALLOC */
434 GC_PTR
GC_debug_malloc_atomic(size_t lb
, GC_EXTRA_PARAMS
)
436 GC_PTR
GC_debug_malloc_atomic(lb
, s
, i
)
442 GC_PTR result
= GC_malloc_atomic(lb
+ DEBUG_BYTES
);
445 GC_err_printf1("GC_debug_malloc_atomic(%ld) returning NIL (",
448 GC_err_printf1(":%ld)\n", (unsigned long)i
);
451 if (!GC_debugging_started
) {
452 GC_start_debugging();
454 ADD_CALL_CHAIN(result
, ra
);
455 return (GC_store_debug_info(result
, (word
)lb
, s
, (word
)i
));
459 GC_PTR
GC_debug_malloc_uncollectable(size_t lb
, GC_EXTRA_PARAMS
)
461 GC_PTR
GC_debug_malloc_uncollectable(lb
, s
, i
)
467 GC_PTR result
= GC_malloc_uncollectable(lb
+ DEBUG_BYTES
);
470 GC_err_printf1("GC_debug_malloc_uncollectable(%ld) returning NIL (",
473 GC_err_printf1(":%ld)\n", (unsigned long)i
);
476 if (!GC_debugging_started
) {
477 GC_start_debugging();
479 ADD_CALL_CHAIN(result
, ra
);
480 return (GC_store_debug_info(result
, (word
)lb
, s
, (word
)i
));
483 #ifdef ATOMIC_UNCOLLECTABLE
485 GC_PTR
GC_debug_malloc_atomic_uncollectable(size_t lb
, GC_EXTRA_PARAMS
)
487 GC_PTR
GC_debug_malloc_atomic_uncollectable(lb
, s
, i
)
493 GC_PTR result
= GC_malloc_atomic_uncollectable(lb
+ DEBUG_BYTES
);
497 "GC_debug_malloc_atomic_uncollectable(%ld) returning NIL (",
500 GC_err_printf1(":%ld)\n", (unsigned long)i
);
503 if (!GC_debugging_started
) {
504 GC_start_debugging();
506 ADD_CALL_CHAIN(result
, ra
);
507 return (GC_store_debug_info(result
, (word
)lb
, s
, (word
)i
));
509 #endif /* ATOMIC_UNCOLLECTABLE */
512 void GC_debug_free(GC_PTR p
)
514 void GC_debug_free(p
)
518 register GC_PTR base
;
519 register ptr_t clobbered
;
524 GC_err_printf1("Attempt to free invalid pointer %lx\n",
526 ABORT("free(invalid pointer)");
528 if ((ptr_t
)p
- (ptr_t
)base
!= sizeof(oh
)) {
530 "GC_debug_free called on pointer %lx wo debugging info\n",
533 clobbered
= GC_check_annotated_obj((oh
*)base
);
534 if (clobbered
!= 0) {
535 if (((oh
*)base
) -> oh_sz
== GC_size(base
)) {
537 "GC_debug_free: found previously deallocated (?) object at ");
539 GC_err_printf0("GC_debug_free: found smashed location at ");
541 GC_print_smashed_obj(p
, clobbered
);
543 /* Invalidate size */
544 ((oh
*)base
) -> oh_sz
= GC_size(base
);
549 register hdr
* hhdr
= HDR(p
);
550 GC_bool uncollectable
= FALSE
;
552 if (hhdr
-> hb_obj_kind
== UNCOLLECTABLE
) {
553 uncollectable
= TRUE
;
555 # ifdef ATOMIC_UNCOLLECTABLE
556 if (hhdr
-> hb_obj_kind
== AUNCOLLECTABLE
) {
557 uncollectable
= TRUE
;
560 if (uncollectable
) GC_free(base
);
561 } /* !GC_find_leak */
565 GC_PTR
GC_debug_realloc(GC_PTR p
, size_t lb
, GC_EXTRA_PARAMS
)
567 GC_PTR
GC_debug_realloc(p
, lb
, s
, i
)
574 register GC_PTR base
= GC_base(p
);
575 register ptr_t clobbered
;
576 register GC_PTR result
;
577 register size_t copy_sz
= lb
;
578 register size_t old_sz
;
581 if (p
== 0) return(GC_debug_malloc(lb
, OPT_RA s
, i
));
584 "Attempt to reallocate invalid pointer %lx\n", (unsigned long)p
);
585 ABORT("realloc(invalid pointer)");
587 if ((ptr_t
)p
- (ptr_t
)base
!= sizeof(oh
)) {
589 "GC_debug_realloc called on pointer %lx wo debugging info\n",
591 return(GC_realloc(p
, lb
));
594 switch (hhdr
-> hb_obj_kind
) {
595 # ifdef STUBBORN_ALLOC
597 result
= GC_debug_malloc_stubborn(lb
, OPT_RA s
, i
);
601 result
= GC_debug_malloc(lb
, OPT_RA s
, i
);
604 result
= GC_debug_malloc_atomic(lb
, OPT_RA s
, i
);
607 result
= GC_debug_malloc_uncollectable(lb
, OPT_RA s
, i
);
609 # ifdef ATOMIC_UNCOLLECTABLE
611 result
= GC_debug_malloc_atomic_uncollectable(lb
, OPT_RA s
, i
);
615 GC_err_printf0("GC_debug_realloc: encountered bad kind\n");
618 clobbered
= GC_check_annotated_obj((oh
*)base
);
619 if (clobbered
!= 0) {
620 GC_err_printf0("GC_debug_realloc: found smashed location at ");
621 GC_print_smashed_obj(p
, clobbered
);
623 old_sz
= ((oh
*)base
) -> oh_sz
;
624 if (old_sz
< copy_sz
) copy_sz
= old_sz
;
625 if (result
== 0) return(0);
626 BCOPY(p
, result
, copy_sz
);
631 /* Check all marked objects in the given block for validity */
633 void GC_check_heap_block(hbp
, dummy
)
634 register struct hblk
*hbp
; /* ptr to current heap block */
637 register struct hblkhdr
* hhdr
= HDR(hbp
);
638 register word sz
= hhdr
-> hb_sz
;
639 register int word_no
;
640 register word
*p
, *plim
;
642 p
= (word
*)(hbp
->hb_body
);
647 plim
= (word
*)((((word
)hbp
) + HBLKSIZE
) - WORDS_TO_BYTES(sz
));
649 /* go through all words in block */
651 if( mark_bit_from_hdr(hhdr
, word_no
)
652 && GC_has_debug_info((ptr_t
)p
)) {
653 ptr_t clobbered
= GC_check_annotated_obj((oh
*)p
);
655 if (clobbered
!= 0) {
657 "GC_check_heap_block: found smashed location at ");
658 GC_print_smashed_obj((ptr_t
)p
, clobbered
);
667 /* This assumes that all accessible objects are marked, and that */
668 /* I hold the allocation lock. Normally called by collector. */
669 void GC_check_heap_proc()
671 # ifndef SMALL_CONFIG
672 if (sizeof(oh
) & (2 * sizeof(word
) - 1) != 0) {
673 ABORT("Alignment problem: object header has inappropriate size\n");
676 GC_apply_to_all_blocks(GC_check_heap_block
, (word
)0);
680 GC_finalization_proc cl_fn
;
685 void * GC_make_closure(GC_finalization_proc fn
, void * data
)
687 GC_PTR
GC_make_closure(fn
, data
)
688 GC_finalization_proc fn
;
692 struct closure
* result
=
693 (struct closure
*) GC_malloc(sizeof (struct closure
));
695 result
-> cl_fn
= fn
;
696 result
-> cl_data
= data
;
697 return((GC_PTR
)result
);
701 void GC_debug_invoke_finalizer(void * obj
, void * data
)
703 void GC_debug_invoke_finalizer(obj
, data
)
708 register struct closure
* cl
= (struct closure
*) data
;
710 (*(cl
-> cl_fn
))((GC_PTR
)((char *)obj
+ sizeof(oh
)), cl
-> cl_data
);
715 void GC_debug_register_finalizer(GC_PTR obj
, GC_finalization_proc fn
,
716 GC_PTR cd
, GC_finalization_proc
*ofn
,
719 void GC_debug_register_finalizer(obj
, fn
, cd
, ofn
, ocd
)
721 GC_finalization_proc fn
;
723 GC_finalization_proc
*ofn
;
727 ptr_t base
= GC_base(obj
);
728 if (0 == base
|| (ptr_t
)obj
- base
!= sizeof(oh
)) {
730 "GC_register_finalizer called with non-base-pointer 0x%lx\n",
733 GC_register_finalizer(base
, GC_debug_invoke_finalizer
,
734 GC_make_closure(fn
,cd
), ofn
, ocd
);
738 void GC_debug_register_finalizer_no_order
739 (GC_PTR obj
, GC_finalization_proc fn
,
740 GC_PTR cd
, GC_finalization_proc
*ofn
,
743 void GC_debug_register_finalizer_no_order
744 (obj
, fn
, cd
, ofn
, ocd
)
746 GC_finalization_proc fn
;
748 GC_finalization_proc
*ofn
;
752 ptr_t base
= GC_base(obj
);
753 if (0 == base
|| (ptr_t
)obj
- base
!= sizeof(oh
)) {
755 "GC_register_finalizer_no_order called with non-base-pointer 0x%lx\n",
758 GC_register_finalizer_no_order(base
, GC_debug_invoke_finalizer
,
759 GC_make_closure(fn
,cd
), ofn
, ocd
);
763 void GC_debug_register_finalizer_ignore_self
764 (GC_PTR obj
, GC_finalization_proc fn
,
765 GC_PTR cd
, GC_finalization_proc
*ofn
,
768 void GC_debug_register_finalizer_ignore_self
769 (obj
, fn
, cd
, ofn
, ocd
)
771 GC_finalization_proc fn
;
773 GC_finalization_proc
*ofn
;
777 ptr_t base
= GC_base(obj
);
778 if (0 == base
|| (ptr_t
)obj
- base
!= sizeof(oh
)) {
780 "GC_register_finalizer_ignore_self called with non-base-pointer 0x%lx\n",
783 GC_register_finalizer_ignore_self(base
, GC_debug_invoke_finalizer
,
784 GC_make_closure(fn
,cd
), ofn
, ocd
);