version 1.5, 2002/07/24 07:46:16 |
version 1.6, 2002/07/24 08:00:08 |
Line 26 GC_API void GC_register_finalizer_no_order |
|
Line 26 GC_API void GC_register_finalizer_no_order |
|
/* Check whether object with base pointer p has debugging info */ |
/* Check whether object with base pointer p has debugging info */ |
/* p is assumed to point to a legitimate object in our part */ |
/* p is assumed to point to a legitimate object in our part */ |
/* of the heap. */ |
/* of the heap. */ |
/* This excludes the check as to whether tha back pointer is */ |
/* This excludes the check as to whether the back pointer is */ |
/* odd, which is added by the GC_HAS_DEBUG_INFO macro. */ |
/* odd, which is added by the GC_HAS_DEBUG_INFO macro. */ |
/* Note that if DBG_HDRS_ALL is set, uncollectable objects */ |
/* Note that if DBG_HDRS_ALL is set, uncollectable objects */ |
/* on free lists may not have debug information set. Thus it's */ |
/* on free lists may not have debug information set. Thus it's */ |
|
|
register word sz = GC_size((ptr_t) ohdr); |
register word sz = GC_size((ptr_t) ohdr); |
|
|
if (HBLKPTR((ptr_t)ohdr) != HBLKPTR((ptr_t)body) |
if (HBLKPTR((ptr_t)ohdr) != HBLKPTR((ptr_t)body) |
|| sz < sizeof (oh)) { |
|| sz < DEBUG_BYTES + EXTRA_BYTES) { |
return(FALSE); |
return(FALSE); |
} |
} |
if (ohdr -> oh_sz == sz) { |
if (ohdr -> oh_sz == sz) { |
|
|
ptr_t GC_store_debug_info(p, sz, string, integer) |
ptr_t GC_store_debug_info(p, sz, string, integer) |
register ptr_t p; /* base pointer */ |
register ptr_t p; /* base pointer */ |
word sz; /* bytes */ |
word sz; /* bytes */ |
char * string; |
GC_CONST char * string; |
word integer; |
word integer; |
{ |
{ |
register word * result = (word *)((oh *)p + 1); |
register word * result = (word *)((oh *)p + 1); |
|
|
# ifdef KEEP_BACK_PTRS |
# ifdef KEEP_BACK_PTRS |
((oh *)p) -> oh_back_ptr = HIDE_BACK_PTR(NOT_MARKED); |
((oh *)p) -> oh_back_ptr = HIDE_BACK_PTR(NOT_MARKED); |
# endif |
# endif |
|
# ifdef MAKE_BACK_GRAPH |
|
((oh *)p) -> oh_bg_ptr = HIDE_BACK_PTR((ptr_t)0); |
|
# endif |
((oh *)p) -> oh_string = string; |
((oh *)p) -> oh_string = string; |
((oh *)p) -> oh_int = integer; |
((oh *)p) -> oh_int = integer; |
# ifndef SHORT_DBG_HDRS |
# ifndef SHORT_DBG_HDRS |
((oh *)p) -> oh_sz = sz; |
((oh *)p) -> oh_sz = sz; |
((oh *)p) -> oh_sf = START_FLAG ^ (word)result; |
((oh *)p) -> oh_sf = START_FLAG ^ (word)result; |
((word *)p)[BYTES_TO_WORDS(GC_size(p))-1] = |
((word *)p)[BYTES_TO_WORDS(GC_size(p))-1] = |
result[ROUNDED_UP_WORDS(sz)] = END_FLAG ^ (word)result; |
result[SIMPLE_ROUNDED_UP_WORDS(sz)] = END_FLAG ^ (word)result; |
# endif |
# endif |
UNLOCK(); |
UNLOCK(); |
return((ptr_t)result); |
return((ptr_t)result); |
|
|
/* But that's expensive. And this way things should only appear */ |
/* But that's expensive. And this way things should only appear */ |
/* inconsistent while we're in the handler. */ |
/* inconsistent while we're in the handler. */ |
# ifdef KEEP_BACK_PTRS |
# ifdef KEEP_BACK_PTRS |
((oh *)p) -> oh_back_ptr = 0; |
((oh *)p) -> oh_back_ptr = HIDE_BACK_PTR(NOT_MARKED); |
# endif |
# endif |
|
# ifdef MAKE_BACK_GRAPH |
|
((oh *)p) -> oh_bg_ptr = HIDE_BACK_PTR((ptr_t)0); |
|
# endif |
((oh *)p) -> oh_string = string; |
((oh *)p) -> oh_string = string; |
((oh *)p) -> oh_int = integer; |
((oh *)p) -> oh_int = integer; |
# ifndef SHORT_DBG_HDRS |
# ifndef SHORT_DBG_HDRS |
((oh *)p) -> oh_sz = sz; |
((oh *)p) -> oh_sz = sz; |
((oh *)p) -> oh_sf = START_FLAG ^ (word)result; |
((oh *)p) -> oh_sf = START_FLAG ^ (word)result; |
((word *)p)[BYTES_TO_WORDS(GC_size(p))-1] = |
((word *)p)[BYTES_TO_WORDS(GC_size(p))-1] = |
result[ROUNDED_UP_WORDS(sz)] = END_FLAG ^ (word)result; |
result[SIMPLE_ROUNDED_UP_WORDS(sz)] = END_FLAG ^ (word)result; |
# endif |
# endif |
return((ptr_t)result); |
return((ptr_t)result); |
} |
} |
Line 305 register oh * ohdr; |
|
Line 311 register oh * ohdr; |
|
if (((word *)ohdr)[BYTES_TO_WORDS(gc_sz)-1] != (END_FLAG ^ (word)body)) { |
if (((word *)ohdr)[BYTES_TO_WORDS(gc_sz)-1] != (END_FLAG ^ (word)body)) { |
return((ptr_t)((word *)ohdr + BYTES_TO_WORDS(gc_sz)-1)); |
return((ptr_t)((word *)ohdr + BYTES_TO_WORDS(gc_sz)-1)); |
} |
} |
if (((word *)body)[ROUNDED_UP_WORDS(ohdr -> oh_sz)] |
if (((word *)body)[SIMPLE_ROUNDED_UP_WORDS(ohdr -> oh_sz)] |
!= (END_FLAG ^ (word)body)) { |
!= (END_FLAG ^ (word)body)) { |
return((ptr_t)((word *)body + ROUNDED_UP_WORDS(ohdr -> oh_sz))); |
return((ptr_t)((word *)body + SIMPLE_ROUNDED_UP_WORDS(ohdr -> oh_sz))); |
} |
} |
return(0); |
return(0); |
} |
} |
|
|
{ |
{ |
register oh * ohdr = (oh *)GC_base(p); |
register oh * ohdr = (oh *)GC_base(p); |
|
|
|
GC_ASSERT(!I_HOLD_LOCK()); |
GC_err_printf1("0x%lx (", ((unsigned long)ohdr + sizeof(oh))); |
GC_err_printf1("0x%lx (", ((unsigned long)ohdr + sizeof(oh))); |
GC_err_puts(ohdr -> oh_string); |
GC_err_puts(ohdr -> oh_string); |
# ifdef SHORT_DBG_HDRS |
# ifdef SHORT_DBG_HDRS |
GC_err_printf1(":%ld, sz=%ld)\n", (unsigned long)(ohdr -> oh_int)); |
GC_err_printf1(":%ld)\n", (unsigned long)(ohdr -> oh_int)); |
# else |
# else |
GC_err_printf2(":%ld, sz=%ld)\n", (unsigned long)(ohdr -> oh_int), |
GC_err_printf2(":%ld, sz=%ld)\n", (unsigned long)(ohdr -> oh_int), |
(unsigned long)(ohdr -> oh_sz)); |
(unsigned long)(ohdr -> oh_sz)); |
|
|
ptr_t p; |
ptr_t p; |
# endif |
# endif |
{ |
{ |
|
GC_ASSERT(!I_HOLD_LOCK()); |
if (GC_HAS_DEBUG_INFO(p)) { |
if (GC_HAS_DEBUG_INFO(p)) { |
GC_print_obj(p); |
GC_print_obj(p); |
} else { |
} else { |
Line 349 ptr_t p, clobbered_addr; |
|
Line 357 ptr_t p, clobbered_addr; |
|
{ |
{ |
register oh * ohdr = (oh *)GC_base(p); |
register oh * ohdr = (oh *)GC_base(p); |
|
|
|
GC_ASSERT(!I_HOLD_LOCK()); |
GC_err_printf2("0x%lx in object at 0x%lx(", (unsigned long)clobbered_addr, |
GC_err_printf2("0x%lx in object at 0x%lx(", (unsigned long)clobbered_addr, |
(unsigned long)p); |
(unsigned long)p); |
if (clobbered_addr <= (ptr_t)(&(ohdr -> oh_sz)) |
if (clobbered_addr <= (ptr_t)(&(ohdr -> oh_sz)) |
Line 370 ptr_t p, clobbered_addr; |
|
Line 379 ptr_t p, clobbered_addr; |
|
|
|
void GC_check_heap_proc GC_PROTO((void)); |
void GC_check_heap_proc GC_PROTO((void)); |
|
|
|
void GC_print_all_smashed_proc GC_PROTO((void)); |
|
|
void GC_do_nothing() {} |
void GC_do_nothing() {} |
|
|
void GC_start_debugging() |
void GC_start_debugging() |
{ |
{ |
# ifndef SHORT_DBG_HDRS |
# ifndef SHORT_DBG_HDRS |
GC_check_heap = GC_check_heap_proc; |
GC_check_heap = GC_check_heap_proc; |
|
GC_print_all_smashed = GC_print_all_smashed_proc; |
# else |
# else |
GC_check_heap = GC_do_nothing; |
GC_check_heap = GC_do_nothing; |
|
GC_print_all_smashed = GC_do_nothing; |
# endif |
# endif |
GC_print_heap_obj = GC_debug_print_heap_obj_proc; |
GC_print_heap_obj = GC_debug_print_heap_obj_proc; |
GC_debugging_started = TRUE; |
GC_debugging_started = TRUE; |
|
|
int i; |
int i; |
# endif |
# endif |
{ |
{ |
GC_PTR result = GC_malloc_uncollectable(lb + DEBUG_BYTES); |
GC_PTR result = GC_malloc_uncollectable(lb + UNCOLLECTABLE_DEBUG_BYTES); |
|
|
if (result == 0) { |
if (result == 0) { |
GC_err_printf1("GC_debug_malloc_uncollectable(%ld) returning NIL (", |
GC_err_printf1("GC_debug_malloc_uncollectable(%ld) returning NIL (", |
|
|
int i; |
int i; |
# endif |
# endif |
{ |
{ |
GC_PTR result = GC_malloc_atomic_uncollectable(lb + DEBUG_BYTES); |
GC_PTR result = |
|
GC_malloc_atomic_uncollectable(lb + UNCOLLECTABLE_DEBUG_BYTES); |
|
|
if (result == 0) { |
if (result == 0) { |
GC_err_printf1( |
GC_err_printf1( |
Line 768 void GC_debug_free_inner(GC_PTR p) |
|
Line 782 void GC_debug_free_inner(GC_PTR p) |
|
} |
} |
|
|
#ifndef SHORT_DBG_HDRS |
#ifndef SHORT_DBG_HDRS |
|
|
|
/* List of smashed objects. We defer printing these, since we can't */ |
|
/* always print them nicely with the allocation lock held. */ |
|
/* We put them here instead of in GC_arrays, since it may be useful to */ |
|
/* be able to look at them with the debugger. */ |
|
#define MAX_SMASHED 20 |
|
ptr_t GC_smashed[MAX_SMASHED]; |
|
unsigned GC_n_smashed = 0; |
|
|
|
# if defined(__STDC__) || defined(__cplusplus) |
|
void GC_add_smashed(ptr_t smashed) |
|
# else |
|
void GC_add_smashed(smashed) |
|
ptr_t smashed; |
|
#endif |
|
{ |
|
GC_smashed[GC_n_smashed] = smashed; |
|
if (GC_n_smashed < MAX_SMASHED - 1) ++GC_n_smashed; |
|
} |
|
|
|
/* Print all objects on the list. Clear the list. */ |
|
void GC_print_all_smashed_proc () |
|
{ |
|
int i; |
|
|
|
GC_ASSERT(!I_HOLD_LOCK()); |
|
if (GC_n_smashed == 0) return; |
|
GC_err_printf0("GC_check_heap_block: found smashed heap objects:\n"); |
|
for (i = 0; i < GC_n_smashed; ++i) { |
|
GC_print_smashed_obj(GC_base(GC_smashed[i]), GC_smashed[i]); |
|
GC_smashed[i] = 0; |
|
} |
|
GC_n_smashed = 0; |
|
} |
|
|
/* Check all marked objects in the given block for validity */ |
/* Check all marked objects in the given block for validity */ |
/*ARGSUSED*/ |
/*ARGSUSED*/ |
# if defined(__STDC__) || defined(__cplusplus) |
# if defined(__STDC__) || defined(__cplusplus) |
Line 796 void GC_debug_free_inner(GC_PTR p) |
|
Line 845 void GC_debug_free_inner(GC_PTR p) |
|
&& GC_HAS_DEBUG_INFO((ptr_t)p)) { |
&& GC_HAS_DEBUG_INFO((ptr_t)p)) { |
ptr_t clobbered = GC_check_annotated_obj((oh *)p); |
ptr_t clobbered = GC_check_annotated_obj((oh *)p); |
|
|
if (clobbered != 0) { |
if (clobbered != 0) GC_add_smashed(clobbered); |
GC_err_printf0( |
|
"GC_check_heap_block: found smashed location at "); |
|
GC_print_smashed_obj((ptr_t)p, clobbered); |
|
} |
|
} |
} |
word_no += sz; |
word_no += sz; |
p += sz; |
p += sz; |
Line 861 struct closure { |
|
Line 906 struct closure { |
|
(*(cl -> cl_fn))((GC_PTR)((char *)obj + sizeof(oh)), cl -> cl_data); |
(*(cl -> cl_fn))((GC_PTR)((char *)obj + sizeof(oh)), cl -> cl_data); |
} |
} |
|
|
|
/* Set ofn and ocd to reflect the values we got back. */ |
|
static void store_old (obj, my_old_fn, my_old_cd, ofn, ocd) |
|
GC_PTR obj; |
|
GC_finalization_proc my_old_fn; |
|
struct closure * my_old_cd; |
|
GC_finalization_proc *ofn; |
|
GC_PTR *ocd; |
|
{ |
|
if (0 != my_old_fn) { |
|
if (my_old_fn != GC_debug_invoke_finalizer) { |
|
GC_err_printf1("Debuggable object at 0x%lx had non-debug finalizer.\n", |
|
obj); |
|
/* This should probably be fatal. */ |
|
} else { |
|
if (ofn) *ofn = my_old_cd -> cl_fn; |
|
if (ocd) *ocd = my_old_cd -> cl_data; |
|
} |
|
} else { |
|
if (ofn) *ofn = 0; |
|
if (ocd) *ocd = 0; |
|
} |
|
} |
|
|
# ifdef __STDC__ |
# ifdef __STDC__ |
void GC_debug_register_finalizer(GC_PTR obj, GC_finalization_proc fn, |
void GC_debug_register_finalizer(GC_PTR obj, GC_finalization_proc fn, |
Line 875 struct closure { |
|
Line 942 struct closure { |
|
GC_PTR *ocd; |
GC_PTR *ocd; |
# endif |
# endif |
{ |
{ |
|
GC_finalization_proc my_old_fn; |
|
GC_PTR my_old_cd; |
ptr_t base = GC_base(obj); |
ptr_t base = GC_base(obj); |
if (0 == base || (ptr_t)obj - base != sizeof(oh)) { |
if (0 == base || (ptr_t)obj - base != sizeof(oh)) { |
GC_err_printf1( |
GC_err_printf1( |
"GC_register_finalizer called with non-base-pointer 0x%lx\n", |
"GC_register_finalizer called with non-base-pointer 0x%lx\n", |
obj); |
obj); |
} |
} |
GC_register_finalizer(base, GC_debug_invoke_finalizer, |
if (0 == fn) { |
GC_make_closure(fn,cd), ofn, ocd); |
GC_register_finalizer(base, 0, 0, &my_old_fn, &my_old_cd); |
|
} else { |
|
GC_register_finalizer(base, GC_debug_invoke_finalizer, |
|
GC_make_closure(fn,cd), &my_old_fn, &my_old_cd); |
|
} |
|
store_old(obj, my_old_fn, (struct closure *)my_old_cd, ofn, ocd); |
} |
} |
|
|
# ifdef __STDC__ |
# ifdef __STDC__ |
Line 900 struct closure { |
|
Line 974 struct closure { |
|
GC_PTR *ocd; |
GC_PTR *ocd; |
# endif |
# endif |
{ |
{ |
|
GC_finalization_proc my_old_fn; |
|
GC_PTR my_old_cd; |
ptr_t base = GC_base(obj); |
ptr_t base = GC_base(obj); |
if (0 == base || (ptr_t)obj - base != sizeof(oh)) { |
if (0 == base || (ptr_t)obj - base != sizeof(oh)) { |
GC_err_printf1( |
GC_err_printf1( |
"GC_register_finalizer_no_order called with non-base-pointer 0x%lx\n", |
"GC_register_finalizer_no_order called with non-base-pointer 0x%lx\n", |
obj); |
obj); |
} |
} |
GC_register_finalizer_no_order(base, GC_debug_invoke_finalizer, |
if (0 == fn) { |
GC_make_closure(fn,cd), ofn, ocd); |
GC_register_finalizer_no_order(base, 0, 0, &my_old_fn, &my_old_cd); |
|
} else { |
|
GC_register_finalizer_no_order(base, GC_debug_invoke_finalizer, |
|
GC_make_closure(fn,cd), &my_old_fn, |
|
&my_old_cd); |
|
} |
|
store_old(obj, my_old_fn, (struct closure *)my_old_cd, ofn, ocd); |
} |
} |
|
|
# ifdef __STDC__ |
# ifdef __STDC__ |
Line 925 struct closure { |
|
Line 1007 struct closure { |
|
GC_PTR *ocd; |
GC_PTR *ocd; |
# endif |
# endif |
{ |
{ |
|
GC_finalization_proc my_old_fn; |
|
GC_PTR my_old_cd; |
ptr_t base = GC_base(obj); |
ptr_t base = GC_base(obj); |
if (0 == base || (ptr_t)obj - base != sizeof(oh)) { |
if (0 == base || (ptr_t)obj - base != sizeof(oh)) { |
GC_err_printf1( |
GC_err_printf1( |
"GC_register_finalizer_ignore_self called with non-base-pointer 0x%lx\n", |
"GC_register_finalizer_ignore_self called with non-base-pointer 0x%lx\n", |
obj); |
obj); |
} |
} |
GC_register_finalizer_ignore_self(base, GC_debug_invoke_finalizer, |
if (0 == fn) { |
GC_make_closure(fn,cd), ofn, ocd); |
GC_register_finalizer_ignore_self(base, 0, 0, &my_old_fn, &my_old_cd); |
|
} else { |
|
GC_register_finalizer_ignore_self(base, GC_debug_invoke_finalizer, |
|
GC_make_closure(fn,cd), &my_old_fn, |
|
&my_old_cd); |
|
} |
|
store_old(obj, my_old_fn, (struct closure *)my_old_cd, ofn, ocd); |
} |
} |
|
|
|
#ifdef GC_ADD_CALLER |
|
# define RA GC_RETURN_ADDR, |
|
#else |
|
# define RA |
|
#endif |
|
|
GC_PTR GC_debug_malloc_replacement(lb) |
GC_PTR GC_debug_malloc_replacement(lb) |
size_t lb; |
size_t lb; |
{ |
{ |
return GC_debug_malloc(lb, "unknown", 0); |
return GC_debug_malloc(lb, RA "unknown", 0); |
} |
} |
|
|
GC_PTR GC_debug_realloc_replacement(p, lb) |
GC_PTR GC_debug_realloc_replacement(p, lb) |
GC_PTR p; |
GC_PTR p; |
size_t lb; |
size_t lb; |
{ |
{ |
return GC_debug_realloc(p, lb, "unknown", 0); |
return GC_debug_realloc(p, lb, RA "unknown", 0); |
} |
} |