diff --git a/src/configure b/src/configure index 661e3415cd..2bbca83030 100755 --- a/src/configure +++ b/src/configure @@ -870,7 +870,7 @@ Optional Features: --enable-sgcdebug use Senora GC for debugging --enable-account 3m: use memory-accounting GC (enabled by default) --enable-compact 3m: use compact GC (no accounting) - --enable-backtrace 3m: compact plus backtrace info + --enable-backtrace 3m: support GC backtrace dumps --enable-float include support for single-precision floats --enable-floatinstead compile to use single-precision by default --enable-pthread link MrEd with pthreads (sometimes needed for GL) @@ -9170,8 +9170,7 @@ echo "$as_me:$LINENO: result: $mbsrtowcs" >&5 echo "${ECHO_T}$mbsrtowcs" >&6 if test "${enable_backtrace}" = "yes" ; then - enable_compact=yes - GC2OPTIONS="$GC2OPTIONS -DCOMPACT_BACKTRACE_GC" + GC2OPTIONS="$GC2OPTIONS -DMZ_GC_BACKTRACE" fi if test "${enable_compact}" = "yes" ; then diff --git a/src/mred/mrmain.cxx b/src/mred/mrmain.cxx index 93e6e1d2bc..fb3f1d2924 100644 --- a/src/mred/mrmain.cxx +++ b/src/mred/mrmain.cxx @@ -281,7 +281,7 @@ int main(int argc, char *argv[]) #if defined(MZ_PRECISE_GC) # ifndef wx_msw stack_start = (void *)&__gc_var_stack__; - GC_init_type_tags(_scheme_last_type_, scheme_weak_box_type, scheme_ephemeron_type); + GC_init_type_tags(_scheme_last_type_, scheme_weak_box_type, scheme_ephemeron_type, scheme_rt_weak_array); # endif /* For Windows, WinMain inits the type tags. */ #endif diff --git a/src/mred/wxs/prefix.xci b/src/mred/wxs/prefix.xci index f2c5968df5..b94a5f36cb 100644 --- a/src/mred/wxs/prefix.xci +++ b/src/mred/wxs/prefix.xci @@ -1,6 +1,6 @@ #if defined(_MSC_VER) # include "wx.h" #endif -#if defined(OS_X) && defined(MZ_PRECISE_GC) +#if defined(OS_X) # include "common.h" #endif diff --git a/src/mred/wxs/wxs_bmap.cxx b/src/mred/wxs/wxs_bmap.cxx index 9f97d1925e..44b9c57651 100644 --- a/src/mred/wxs/wxs_bmap.cxx +++ b/src/mred/wxs/wxs_bmap.cxx @@ -5,7 +5,7 @@ #if defined(_MSC_VER) # include "wx.h" #endif -#if defined(OS_X) && defined(MZ_PRECISE_GC) +#if defined(OS_X) # include "common.h" #endif diff --git a/src/mred/wxs/wxs_butn.cxx b/src/mred/wxs/wxs_butn.cxx index a9bd3fc677..abdf59932e 100644 --- a/src/mred/wxs/wxs_butn.cxx +++ b/src/mred/wxs/wxs_butn.cxx @@ -5,7 +5,7 @@ #if defined(_MSC_VER) # include "wx.h" #endif -#if defined(OS_X) && defined(MZ_PRECISE_GC) +#if defined(OS_X) # include "common.h" #endif diff --git a/src/mred/wxs/wxs_chce.cxx b/src/mred/wxs/wxs_chce.cxx index 6c4a965113..27a0093387 100644 --- a/src/mred/wxs/wxs_chce.cxx +++ b/src/mred/wxs/wxs_chce.cxx @@ -5,7 +5,7 @@ #if defined(_MSC_VER) # include "wx.h" #endif -#if defined(OS_X) && defined(MZ_PRECISE_GC) +#if defined(OS_X) # include "common.h" #endif diff --git a/src/mred/wxs/wxs_ckbx.cxx b/src/mred/wxs/wxs_ckbx.cxx index 10beda8b0b..e8ef911495 100644 --- a/src/mred/wxs/wxs_ckbx.cxx +++ b/src/mred/wxs/wxs_ckbx.cxx @@ -5,7 +5,7 @@ #if defined(_MSC_VER) # include "wx.h" #endif -#if defined(OS_X) && defined(MZ_PRECISE_GC) +#if defined(OS_X) # include "common.h" #endif diff --git a/src/mred/wxs/wxs_cnvs.cxx b/src/mred/wxs/wxs_cnvs.cxx index 633c236495..3b740a57ea 100644 --- a/src/mred/wxs/wxs_cnvs.cxx +++ b/src/mred/wxs/wxs_cnvs.cxx @@ -5,7 +5,7 @@ #if defined(_MSC_VER) # include "wx.h" #endif -#if defined(OS_X) && defined(MZ_PRECISE_GC) +#if defined(OS_X) # include "common.h" #endif diff --git a/src/mred/wxs/wxs_dc.cxx b/src/mred/wxs/wxs_dc.cxx index 4800d6a2b3..3d7995de33 100644 --- a/src/mred/wxs/wxs_dc.cxx +++ b/src/mred/wxs/wxs_dc.cxx @@ -5,7 +5,7 @@ #if defined(_MSC_VER) # include "wx.h" #endif -#if defined(OS_X) && defined(MZ_PRECISE_GC) +#if defined(OS_X) # include "common.h" #endif diff --git a/src/mred/wxs/wxs_evnt.cxx b/src/mred/wxs/wxs_evnt.cxx index 227246337e..491b1a1ca8 100644 --- a/src/mred/wxs/wxs_evnt.cxx +++ b/src/mred/wxs/wxs_evnt.cxx @@ -5,7 +5,7 @@ #if defined(_MSC_VER) # include "wx.h" #endif -#if defined(OS_X) && defined(MZ_PRECISE_GC) +#if defined(OS_X) # include "common.h" #endif diff --git a/src/mred/wxs/wxs_fram.cxx b/src/mred/wxs/wxs_fram.cxx index 3564d7f6d3..e3656be0e9 100644 --- a/src/mred/wxs/wxs_fram.cxx +++ b/src/mred/wxs/wxs_fram.cxx @@ -5,7 +5,7 @@ #if defined(_MSC_VER) # include "wx.h" #endif -#if defined(OS_X) && defined(MZ_PRECISE_GC) +#if defined(OS_X) # include "common.h" #endif diff --git a/src/mred/wxs/wxs_gage.cxx b/src/mred/wxs/wxs_gage.cxx index ad04d22047..3e7deae880 100644 --- a/src/mred/wxs/wxs_gage.cxx +++ b/src/mred/wxs/wxs_gage.cxx @@ -5,7 +5,7 @@ #if defined(_MSC_VER) # include "wx.h" #endif -#if defined(OS_X) && defined(MZ_PRECISE_GC) +#if defined(OS_X) # include "common.h" #endif diff --git a/src/mred/wxs/wxs_gdi.cxx b/src/mred/wxs/wxs_gdi.cxx index 2f529d012c..ee08e3efa9 100644 --- a/src/mred/wxs/wxs_gdi.cxx +++ b/src/mred/wxs/wxs_gdi.cxx @@ -5,7 +5,7 @@ #if defined(_MSC_VER) # include "wx.h" #endif -#if defined(OS_X) && defined(MZ_PRECISE_GC) +#if defined(OS_X) # include "common.h" #endif diff --git a/src/mred/wxs/wxs_glob.cxx b/src/mred/wxs/wxs_glob.cxx index afafe67600..247cefdb77 100644 --- a/src/mred/wxs/wxs_glob.cxx +++ b/src/mred/wxs/wxs_glob.cxx @@ -5,7 +5,7 @@ #if defined(_MSC_VER) # include "wx.h" #endif -#if defined(OS_X) && defined(MZ_PRECISE_GC) +#if defined(OS_X) # include "common.h" #endif diff --git a/src/mred/wxs/wxs_item.cxx b/src/mred/wxs/wxs_item.cxx index 6458395e48..29f2606d04 100644 --- a/src/mred/wxs/wxs_item.cxx +++ b/src/mred/wxs/wxs_item.cxx @@ -5,7 +5,7 @@ #if defined(_MSC_VER) # include "wx.h" #endif -#if defined(OS_X) && defined(MZ_PRECISE_GC) +#if defined(OS_X) # include "common.h" #endif diff --git a/src/mred/wxs/wxs_lbox.cxx b/src/mred/wxs/wxs_lbox.cxx index 2b22a1d1a0..cbd1b868b7 100644 --- a/src/mred/wxs/wxs_lbox.cxx +++ b/src/mred/wxs/wxs_lbox.cxx @@ -5,7 +5,7 @@ #if defined(_MSC_VER) # include "wx.h" #endif -#if defined(OS_X) && defined(MZ_PRECISE_GC) +#if defined(OS_X) # include "common.h" #endif diff --git a/src/mred/wxs/wxs_madm.cxx b/src/mred/wxs/wxs_madm.cxx index 637907532d..cac370fbe3 100644 --- a/src/mred/wxs/wxs_madm.cxx +++ b/src/mred/wxs/wxs_madm.cxx @@ -5,7 +5,7 @@ #if defined(_MSC_VER) # include "wx.h" #endif -#if defined(OS_X) && defined(MZ_PRECISE_GC) +#if defined(OS_X) # include "common.h" #endif diff --git a/src/mred/wxs/wxs_mede.cxx b/src/mred/wxs/wxs_mede.cxx index c8893f3b78..2bd9116454 100644 --- a/src/mred/wxs/wxs_mede.cxx +++ b/src/mred/wxs/wxs_mede.cxx @@ -5,7 +5,7 @@ #if defined(_MSC_VER) # include "wx.h" #endif -#if defined(OS_X) && defined(MZ_PRECISE_GC) +#if defined(OS_X) # include "common.h" #endif diff --git a/src/mred/wxs/wxs_medi.cxx b/src/mred/wxs/wxs_medi.cxx index e5d718910f..4c2d3cc407 100644 --- a/src/mred/wxs/wxs_medi.cxx +++ b/src/mred/wxs/wxs_medi.cxx @@ -5,7 +5,7 @@ #if defined(_MSC_VER) # include "wx.h" #endif -#if defined(OS_X) && defined(MZ_PRECISE_GC) +#if defined(OS_X) # include "common.h" #endif diff --git a/src/mred/wxs/wxs_menu.cxx b/src/mred/wxs/wxs_menu.cxx index ac194eef58..4ffcb4e681 100644 --- a/src/mred/wxs/wxs_menu.cxx +++ b/src/mred/wxs/wxs_menu.cxx @@ -5,7 +5,7 @@ #if defined(_MSC_VER) # include "wx.h" #endif -#if defined(OS_X) && defined(MZ_PRECISE_GC) +#if defined(OS_X) # include "common.h" #endif diff --git a/src/mred/wxs/wxs_mio.cxx b/src/mred/wxs/wxs_mio.cxx index c7d0d90de8..2655de7082 100644 --- a/src/mred/wxs/wxs_mio.cxx +++ b/src/mred/wxs/wxs_mio.cxx @@ -5,7 +5,7 @@ #if defined(_MSC_VER) # include "wx.h" #endif -#if defined(OS_X) && defined(MZ_PRECISE_GC) +#if defined(OS_X) # include "common.h" #endif diff --git a/src/mred/wxs/wxs_misc.cxx b/src/mred/wxs/wxs_misc.cxx index 72e80e30e4..32f3537b95 100644 --- a/src/mred/wxs/wxs_misc.cxx +++ b/src/mred/wxs/wxs_misc.cxx @@ -5,7 +5,7 @@ #if defined(_MSC_VER) # include "wx.h" #endif -#if defined(OS_X) && defined(MZ_PRECISE_GC) +#if defined(OS_X) # include "common.h" #endif diff --git a/src/mred/wxs/wxs_mpb.cxx b/src/mred/wxs/wxs_mpb.cxx index 9b438afd5e..aed1f4a7ae 100644 --- a/src/mred/wxs/wxs_mpb.cxx +++ b/src/mred/wxs/wxs_mpb.cxx @@ -5,7 +5,7 @@ #if defined(_MSC_VER) # include "wx.h" #endif -#if defined(OS_X) && defined(MZ_PRECISE_GC) +#if defined(OS_X) # include "common.h" #endif diff --git a/src/mred/wxs/wxs_obj.cxx b/src/mred/wxs/wxs_obj.cxx index 3719be6c07..944088c2ef 100644 --- a/src/mred/wxs/wxs_obj.cxx +++ b/src/mred/wxs/wxs_obj.cxx @@ -5,7 +5,7 @@ #if defined(_MSC_VER) # include "wx.h" #endif -#if defined(OS_X) && defined(MZ_PRECISE_GC) +#if defined(OS_X) # include "common.h" #endif diff --git a/src/mred/wxs/wxs_panl.cxx b/src/mred/wxs/wxs_panl.cxx index b2d3d1fbdf..2c21db2d48 100644 --- a/src/mred/wxs/wxs_panl.cxx +++ b/src/mred/wxs/wxs_panl.cxx @@ -5,7 +5,7 @@ #if defined(_MSC_VER) # include "wx.h" #endif -#if defined(OS_X) && defined(MZ_PRECISE_GC) +#if defined(OS_X) # include "common.h" #endif diff --git a/src/mred/wxs/wxs_rado.cxx b/src/mred/wxs/wxs_rado.cxx index f0a98c748e..e34d16d1bf 100644 --- a/src/mred/wxs/wxs_rado.cxx +++ b/src/mred/wxs/wxs_rado.cxx @@ -5,7 +5,7 @@ #if defined(_MSC_VER) # include "wx.h" #endif -#if defined(OS_X) && defined(MZ_PRECISE_GC) +#if defined(OS_X) # include "common.h" #endif diff --git a/src/mred/wxs/wxs_slid.cxx b/src/mred/wxs/wxs_slid.cxx index 027d5d0b05..7d25a4d7c2 100644 --- a/src/mred/wxs/wxs_slid.cxx +++ b/src/mred/wxs/wxs_slid.cxx @@ -5,7 +5,7 @@ #if defined(_MSC_VER) # include "wx.h" #endif -#if defined(OS_X) && defined(MZ_PRECISE_GC) +#if defined(OS_X) # include "common.h" #endif diff --git a/src/mred/wxs/wxs_snip.cxx b/src/mred/wxs/wxs_snip.cxx index 4de6e2c2e3..8b370e6122 100644 --- a/src/mred/wxs/wxs_snip.cxx +++ b/src/mred/wxs/wxs_snip.cxx @@ -5,7 +5,7 @@ #if defined(_MSC_VER) # include "wx.h" #endif -#if defined(OS_X) && defined(MZ_PRECISE_GC) +#if defined(OS_X) # include "common.h" #endif diff --git a/src/mred/wxs/wxs_styl.cxx b/src/mred/wxs/wxs_styl.cxx index af6ebb38ec..3d8e9a8ce1 100644 --- a/src/mred/wxs/wxs_styl.cxx +++ b/src/mred/wxs/wxs_styl.cxx @@ -5,7 +5,7 @@ #if defined(_MSC_VER) # include "wx.h" #endif -#if defined(OS_X) && defined(MZ_PRECISE_GC) +#if defined(OS_X) # include "common.h" #endif diff --git a/src/mred/wxs/wxs_tabc.cxx b/src/mred/wxs/wxs_tabc.cxx index a9e6512c94..515161b2ab 100644 --- a/src/mred/wxs/wxs_tabc.cxx +++ b/src/mred/wxs/wxs_tabc.cxx @@ -5,7 +5,7 @@ #if defined(_MSC_VER) # include "wx.h" #endif -#if defined(OS_X) && defined(MZ_PRECISE_GC) +#if defined(OS_X) # include "common.h" #endif diff --git a/src/mred/wxs/wxs_win.cxx b/src/mred/wxs/wxs_win.cxx index cbda327f67..900b456e8d 100644 --- a/src/mred/wxs/wxs_win.cxx +++ b/src/mred/wxs/wxs_win.cxx @@ -5,7 +5,7 @@ #if defined(_MSC_VER) # include "wx.h" #endif -#if defined(OS_X) && defined(MZ_PRECISE_GC) +#if defined(OS_X) # include "common.h" #endif diff --git a/src/mzscheme/configure.ac b/src/mzscheme/configure.ac index 6c158998ad..0d6fab2cea 100644 --- a/src/mzscheme/configure.ac +++ b/src/mzscheme/configure.ac @@ -44,7 +44,7 @@ AC_ARG_ENABLE(sgc, [ --enable-sgc use Senora GC instead of the Boehm AC_ARG_ENABLE(sgcdebug, [ --enable-sgcdebug use Senora GC for debugging]) AC_ARG_ENABLE(account, [ --enable-account 3m: use memory-accounting GC (enabled by default)], , enable_account=yes) AC_ARG_ENABLE(compact, [ --enable-compact 3m: use compact GC (no accounting)]) -AC_ARG_ENABLE(backtrace, [ --enable-backtrace 3m: compact plus backtrace info]) +AC_ARG_ENABLE(backtrace, [ --enable-backtrace 3m: support GC backtrace dumps]) AC_ARG_ENABLE(float, [ --enable-float include support for single-precision floats]) AC_ARG_ENABLE(floatinstead, [ --enable-floatinstead compile to use single-precision by default]) @@ -666,8 +666,7 @@ fi AC_MSG_RESULT($mbsrtowcs) if test "${enable_backtrace}" = "yes" ; then - enable_compact=yes - GC2OPTIONS="$GC2OPTIONS -DCOMPACT_BACKTRACE_GC" + GC2OPTIONS="$GC2OPTIONS -DMZ_GC_BACKTRACE" fi if test "${enable_compact}" = "yes" ; then diff --git a/src/mzscheme/gc2/README b/src/mzscheme/gc2/README index 22b76b70d2..54e6e9daeb 100644 --- a/src/mzscheme/gc2/README +++ b/src/mzscheme/gc2/README @@ -1,6 +1,7 @@ This README provides and overview of the precise GC interface used by -MzScheme. The header file gc2.h provides additional documentation. +MzScheme. The header files gc2.h and gc2_dump.h provide additional +documentation. GC Architecture --------------- diff --git a/src/mzscheme/gc2/backtrace.c b/src/mzscheme/gc2/backtrace.c new file mode 100644 index 0000000000..b410787027 --- /dev/null +++ b/src/mzscheme/gc2/backtrace.c @@ -0,0 +1,110 @@ +/* + Provides: + reset_object_traces + register_traced_object + print_traced_objects + print_out_pointer + Requires: + avoid_collection + trace_page_t + find_page + trace_page_type + TRACE_PAGE_TAGGED + TRACE_PAGE_ARRAY + TRACE_PAGE_TAGGED_ARRAY + TRACE_PAGE_ATOMIC + TRACE_PAGE_XTAGGED + TRACE_PAGE_MALLOCFREE + TRACE_PAGE_BAD + trace_page_is_big + trace_backpointer +*/ + + +# define MAX_FOUND_OBJECTS 5000 +static int found_object_count; +static void *found_objects[MAX_FOUND_OBJECTS]; + +static void reset_object_traces() +{ + found_object_count = 0; +} + +static void register_traced_object(void *p) +{ + if (found_object_count < MAX_FOUND_OBJECTS) { + found_objects[found_object_count++] = p; + } +} + +static void *print_out_pointer(const char *prefix, void *p, + GC_get_type_name_proc get_type_name, + GC_get_xtagged_name_proc get_xtagged_name, + GC_print_tagged_value_proc print_tagged_value) +{ + trace_page_t *page; + const char *what; + + page = find_page(p); + if (!page || (trace_page_type(page) == TRACE_PAGE_BAD)) { + GCPRINT(GCOUTF, "%s??? %p\n", prefix, p); + return NULL; + } + + if (trace_page_type(page) == TRACE_PAGE_TAGGED) { + Type_Tag tag; + tag = *(Type_Tag *)p; + if ((tag >= 0) && get_type_name && get_type_name(tag)) { + print_tagged_value(prefix, p, 0, 0, 1000, "\n"); + } else { + GCPRINT(GCOUTF, "%s<#%d> %p\n", prefix, tag, p); + } + what = NULL; + } else if (trace_page_type(page) == TRACE_PAGE_ARRAY) { + what = "ARRAY"; + } else if (trace_page_type(page) == TRACE_PAGE_TAGGED_ARRAY) { + what = "TARRAY"; + } else if (trace_page_type(page) == TRACE_PAGE_ATOMIC) { + what = "ATOMIC"; + } else if (trace_page_type(page) == TRACE_PAGE_XTAGGED) { + if (get_xtagged_name) + what = get_xtagged_name(p); + else + what = "XTAGGED"; + } else if (trace_page_type(page) == TRACE_PAGE_MALLOCFREE) { + what = "MALLOCED"; + } else { + what = "?!?"; + } + + if (what) { + GCPRINT(GCOUTF, "%s%s%s %p\n", + prefix, what, + (trace_page_is_big(page) ? "b" : ""), + p); + } + + return trace_backpointer(page, p); +} + +static void print_traced_objects(int path_length_limit, + GC_get_type_name_proc get_type_name, + GC_get_xtagged_name_proc get_xtagged_name, + GC_print_tagged_value_proc print_tagged_value) +{ + int i; + avoid_collection++; + GCPRINT(GCOUTF, "Begin Trace\n"); + for (i = 0; i < found_object_count; i++) { + void *p; + int limit = path_length_limit; + p = found_objects[i]; + p = print_out_pointer("==* ", p, get_type_name, get_xtagged_name, print_tagged_value); + while (p && limit) { + p = print_out_pointer(" <- ", p, get_type_name, get_xtagged_name, print_tagged_value); + limit--; + } + } + GCPRINT(GCOUTF, "End Trace\n"); + --avoid_collection; +} diff --git a/src/mzscheme/gc2/compact.c b/src/mzscheme/gc2/compact.c index ea193991c3..330f05c4df 100644 --- a/src/mzscheme/gc2/compact.c +++ b/src/mzscheme/gc2/compact.c @@ -82,6 +82,7 @@ typedef short Type_Tag; #include "gc2.h" +#include "gc2_dump.h" #define BYTEPTR(x) ((char *)x) @@ -98,7 +99,7 @@ typedef short Type_Tag; #define KEEP_BACKPOINTERS 0 #define DEFINE_MALLOC_FREE 0 -#ifdef COMPACT_BACKTRACE_GC +#ifdef MZ_GC_BACKTRACE # undef KEEP_BACKPOINTERS # define KEEP_BACKPOINTERS 1 #endif @@ -160,8 +161,8 @@ void GC_set_variable_stack(void **p) { GC_variable_stack = p; } /********************* Type tags *********************/ Type_Tag weak_box_tag = 42; /* set by client */ Type_Tag ephemeron_tag = 42; /* set by client */ +Type_Tag weak_array_tag = 42; /* set by client */ -#define gc_weak_array_tag 256 #define gc_on_free_list_tag 257 #define _num_tags_ 260 @@ -465,10 +466,11 @@ void GC_set_stack_base(void *base) stack_base = (unsigned long)base; } -void GC_init_type_tags(int count, int weakbox, int ephemeron) +void GC_init_type_tags(int count, int weakbox, int ephemeron, int weakarray) { weak_box_tag = weakbox; ephemeron_tag = ephemeron; + weak_array_tag = weakarray; } void GC_register_traversers(Type_Tag tag, Size_Proc size, Mark_Proc mark, Fixup_Proc fixup, @@ -2858,7 +2860,7 @@ static void check_ptr(void **a) || (!size_table[tag] && (tag != weak_box_tag) && (tag != ephemeron_tag) - && (tag != gc_weak_array_tag) + && (tag != weak_array_tag) && (tag != gc_on_free_list_tag))) { GCPRINT(GCOUTF, "bad tag: %d at %lx, references from %lx\n", tag, (long)p, (long)a); GCFLUSHOUT(); @@ -2955,7 +2957,7 @@ static void init(void) if (!initialized) { GC_register_traversers(weak_box_tag, size_weak_box, mark_weak_box, fixup_weak_box, 1, 0); GC_register_traversers(ephemeron_tag, size_ephemeron, mark_ephemeron, fixup_ephemeron, 1, 0); - GC_register_traversers(gc_weak_array_tag, size_weak_array, mark_weak_array, fixup_weak_array, 0, 0); + GC_register_traversers(weak_array_tag, size_weak_array, mark_weak_array, fixup_weak_array, 0, 0); #if USE_FREELIST GC_register_traversers(gc_on_free_list_tag, size_on_free_list, size_on_free_list, size_on_free_list, 0, 0); #endif @@ -4328,18 +4330,41 @@ static void check_not_freed(MPage *page, const void *p) static long dump_info_array[BIGBLOCK_MIN_SIZE]; #if KEEP_BACKPOINTERS -# define MAX_FOUND_OBJECTS 5000 -int GC_show_trace = 0; -int GC_show_finals = 0; -int GC_trace_for_tag = 57; -int GC_path_length_limit = 1000; -static int found_object_count; -static void *found_objects[MAX_FOUND_OBJECTS]; -void (*GC_for_each_found)(void *p) = NULL; -char *(*GC_get_xtagged_name)(void *p) = NULL; + +static void *trace_backpointer(MPage *page, void *p) +{ + + if (page->flags & MFLAG_BIGBLOCK) + return (void *)page->backpointer_page; + else { + int offset; + offset = ((char *)p - (char *)page->block_start) >> LOG_WORD_SIZE; + if (page->type != MTYPE_TAGGED) + offset -= 1; + if (offset > 0) + return page->backpointer_page[offset]; + else + return NULL; /* This shouldn't happen */ + } +} + +# define trace_page_t MPage +# define trace_page_type(page) (page)->type +# define TRACE_PAGE_TAGGED MTYPE_TAGGED +# define TRACE_PAGE_ARRAY MTYPE_ARRAY +# define TRACE_PAGE_TAGGED_ARRAY MTYPE_TAGGED_ARRAY +# define TRACE_PAGE_ATOMIC MTYPE_ATOMIC +# define TRACE_PAGE_XTAGGED MTYPE_XTAGGED +# define TRACE_PAGE_MALLOCFREE MTYPE_MALLOCFREE +# define TRACE_PAGE_BAD 0 +# define trace_page_is_big(page) ((page)->flags & MFLAG_BIGBLOCK) + +# include "backtrace.c" + #endif -static long scan_tagged_mpage(void **p, MPage *page) +static long scan_tagged_mpage(void **p, MPage *page, short trace_for_tag, + GC_for_each_found_proc for_each_found) { void **top, **bottom = p; @@ -4373,15 +4398,13 @@ static long scan_tagged_mpage(void **p, MPage *page) dump_info_array[tag]++; dump_info_array[tag + _num_tags_] += size; + if (tag == trace_for_tag) { #if KEEP_BACKPOINTERS - if (tag == GC_trace_for_tag) { - if (found_object_count < MAX_FOUND_OBJECTS) { - found_objects[found_object_count++] = p; - } - if (GC_for_each_found) - GC_for_each_found(p); - } + register_traced_object(p); #endif + if (for_each_found) + for_each_found(p); + } p += size; #if ALIGN_DOUBLES @@ -4415,13 +4438,7 @@ static long scan_untagged_mpage(void **p, MPage *page) return MPAGE_WORDS; } -/* HACK! */ -extern char *scheme_get_type_name(Type_Tag t); - #if KEEP_BACKPOINTERS -extern void scheme_print_tagged_value(const char *prefix, - void *v, int xtagged, unsigned long diff, int max_w, - const char *suffix); int GC_is_tagged(void *p) { @@ -4521,178 +4538,129 @@ void *GC_next_tagged_start(void *p) } } -void *print_out_pointer(const char *prefix, void *p) -{ - MPage *page; - const char *what; - - page = find_page(p); - if (!page || !page->type) { - GCPRINT(GCOUTF, "%s??? %p\n", prefix, p); - return NULL; - } - - if (page->type == MTYPE_TAGGED) { - Type_Tag tag; - tag = *(Type_Tag *)p; - if ((tag >= 0) && (tag < _num_tags_) && scheme_get_type_name(tag)) { - scheme_print_tagged_value(prefix, p, 0, 0, 1000, "\n"); - } else { - GCPRINT(GCOUTF, "%s<#%d> %p\n", prefix, tag, p); - } - what = NULL; - } else if (page->type == MTYPE_ARRAY) { - what = "ARRAY"; - } else if (page->type == MTYPE_TAGGED_ARRAY) { - what = "TARRAY"; - } else if (page->type == MTYPE_ATOMIC) { - what = "ATOMIC"; - } else if (page->type == MTYPE_XTAGGED) { - if (GC_get_xtagged_name) - what = GC_get_xtagged_name(p); - else - what = "XTAGGED"; - } else if (page->type == MTYPE_MALLOCFREE) { - what = "MALLOCED"; - } else { - what = "?!?"; - } - - if (what) { - GCPRINT(GCOUTF, "%s%s%s %p\n", - prefix, what, - ((page->flags & MFLAG_BIGBLOCK) ? "b" : ""), - p); - } - - if (page->flags & MFLAG_BIGBLOCK) - p = (void *)page->backpointer_page; - else { - int offset; - offset = ((char *)p - (char *)page->block_start) >> LOG_WORD_SIZE; - if (what) - offset -= 1; - if (offset > 0) - p = page->backpointer_page[offset]; - else - p = NULL; /* This shouldn't happen */ - } - - return p; -} #endif -void GC_dump(void) +void GC_dump_with_traces(int flags, + GC_get_type_name_proc get_type_name, + GC_get_xtagged_name_proc get_xtagged_name, + GC_for_each_found_proc for_each_found, + short trace_for_tag, + GC_print_tagged_value_proc print_tagged_value, + int path_length_limit) { int i; long waste = 0; + if (!(flags & GC_DUMP_SHOW_TRACE)) + trace_for_tag = -1; #if KEEP_BACKPOINTERS - found_object_count = 0; - if (GC_for_each_found) + reset_object_traces(); +#endif + if (for_each_found) avoid_collection++; -#endif - GCPRINT(GCOUTF, "t=tagged a=atomic v=array x=xtagged g=tagarray\n"); - GCPRINT(GCOUTF, "mpagesize=%ld opagesize=%ld\n", (long)MPAGE_SIZE, (long)OPAGE_SIZE); - GCPRINT(GCOUTF, "["); - for (i = 0; i < MAPS_SIZE; i++) { - if (i && !(i & 63)) - GCPRINT(GCOUTF, "\n "); + if (flags & GC_DUMP_SHOW_DETAILS) { + GCPRINT(GCOUTF, "t=tagged a=atomic v=array x=xtagged g=tagarray\n"); + GCPRINT(GCOUTF, "mpagesize=%ld opagesize=%ld\n", (long)MPAGE_SIZE, (long)OPAGE_SIZE); + GCPRINT(GCOUTF, "["); + for (i = 0; i < MAPS_SIZE; i++) { + if (i && !(i & 63)) + GCPRINT(GCOUTF, "\n "); - if (mpage_maps[i]) - GCPRINT(GCOUTF, "*"); - else - GCPRINT(GCOUTF, "-"); - } - GCPRINT(GCOUTF, "]\n"); - for (i = 0; i < MAPS_SIZE; i++) { - MPage *maps = mpage_maps[i]; - if (maps) { - int j; - GCPRINT(GCOUTF, "%.2x:\n ", i); - for (j = 0; j < MAP_SIZE; j++) { - if (j && !(j & 63)) - GCPRINT(GCOUTF, "\n "); + if (mpage_maps[i]) + GCPRINT(GCOUTF, "*"); + else + GCPRINT(GCOUTF, "-"); + } + GCPRINT(GCOUTF, "]\n"); + for (i = 0; i < MAPS_SIZE; i++) { + MPage *maps = mpage_maps[i]; + if (maps) { + int j; + GCPRINT(GCOUTF, "%.2x:\n ", i); + for (j = 0; j < MAP_SIZE; j++) { + if (j && !(j & 63)) + GCPRINT(GCOUTF, "\n "); - if (maps[j].type + if (maps[j].type #if DEFINE_MALLOC_FREE - && (maps[j].type != MTYPE_MALLOCFREE) + && (maps[j].type != MTYPE_MALLOCFREE) #endif - ) { - int c; + ) { + int c; - if (maps[j].flags & MFLAG_CONTINUED) - c = '.'; - else { - if (maps[j].type <= MTYPE_TAGGED) - c = 't'; - else if (maps[j].type == MTYPE_TAGGED_ARRAY) - c = 'g'; - else if (maps[j].type == MTYPE_ATOMIC) - c = 'a'; - else if (maps[j].type == MTYPE_XTAGGED) - c = 'x'; - else - c = 'v'; + if (maps[j].flags & MFLAG_CONTINUED) + c = '.'; + else { + if (maps[j].type <= MTYPE_TAGGED) + c = 't'; + else if (maps[j].type == MTYPE_TAGGED_ARRAY) + c = 'g'; + else if (maps[j].type == MTYPE_ATOMIC) + c = 'a'; + else if (maps[j].type == MTYPE_XTAGGED) + c = 'x'; + else + c = 'v'; - if (maps[j].flags & MFLAG_BIGBLOCK) - c = c - ('a' - 'A'); - } + if (maps[j].flags & MFLAG_BIGBLOCK) + c = c - ('a' - 'A'); + } - GCPRINT(GCOUTF, "%c", c); - } else { - GCPRINT(GCOUTF, "-"); + GCPRINT(GCOUTF, "%c", c); + } else { + GCPRINT(GCOUTF, "-"); + } } + GCPRINT(GCOUTF, "\n"); + } + } + + { + MPage *page; + + GCPRINT(GCOUTF, "Block info: [type][modified?][age][refs-age]\n"); + for (page = first, i = 0; page; page = page->next, i++) { + int c; + + if (page->flags & MFLAG_CONTINUED) + c = '.'; + else { + if (page->type <= MTYPE_TAGGED) + c = 't'; + else if (page->type == MTYPE_TAGGED_ARRAY) + c = 'g'; + else if (page->type == MTYPE_ATOMIC) + c = 'a'; + else if (page->type == MTYPE_XTAGGED) + c = 'x'; + else + c = 'v'; + + if (page->flags & MFLAG_BIGBLOCK) + c = c - ('a' - 'A'); + } + + GCPRINT(GCOUTF, " %c%c%c%c", + c, + ((page->flags & MFLAG_MODIFIED) + ? 'M' + : '_'), + ((page->age < 10) + ? (page->age + '0') + : (page->age + 'a' - 10)), + ((page->type == MTYPE_ATOMIC) + ? '-' + : ((page->refs_age < 10) + ? (page->refs_age + '0') + : (page->refs_age + 'a' - 10)))); + if ((i % 10) == 9) + GCPRINT(GCOUTF, "\n"); } GCPRINT(GCOUTF, "\n"); } } - { - MPage *page; - - GCPRINT(GCOUTF, "Block info: [type][modified?][age][refs-age]\n"); - for (page = first, i = 0; page; page = page->next, i++) { - int c; - - if (page->flags & MFLAG_CONTINUED) - c = '.'; - else { - if (page->type <= MTYPE_TAGGED) - c = 't'; - else if (page->type == MTYPE_TAGGED_ARRAY) - c = 'g'; - else if (page->type == MTYPE_ATOMIC) - c = 'a'; - else if (page->type == MTYPE_XTAGGED) - c = 'x'; - else - c = 'v'; - - if (page->flags & MFLAG_BIGBLOCK) - c = c - ('a' - 'A'); - } - - GCPRINT(GCOUTF, " %c%c%c%c", - c, - ((page->flags & MFLAG_MODIFIED) - ? 'M' - : '_'), - ((page->age < 10) - ? (page->age + '0') - : (page->age + 'a' - 10)), - ((page->type == MTYPE_ATOMIC) - ? '-' - : ((page->refs_age < 10) - ? (page->refs_age + '0') - : (page->refs_age + 'a' - 10)))); - if ((i % 10) == 9) - GCPRINT(GCOUTF, "\n"); - } - GCPRINT(GCOUTF, "\n"); - } - { int j; @@ -4723,39 +4691,41 @@ void GC_dump(void) if (j >= NUM_TAGGED_SETS) used = scan_untagged_mpage(page->block_start, page); /* gets size counts */ else - used = scan_tagged_mpage(page->block_start, page); /* gets tag counts */ + used = scan_tagged_mpage(page->block_start, page, + trace_for_tag, for_each_found); /* gets tag counts */ total += used; waste += (MPAGE_WORDS - used); } -#if KEEP_BACKPOINTERS if ((page->flags & MFLAG_BIGBLOCK) && (page->type == kind) - && (((GC_trace_for_tag >= (BIGBLOCK_MIN_SIZE >> LOG_WORD_SIZE)) - && (page->u.size > GC_trace_for_tag)) - || (page->u.size == -GC_trace_for_tag))) { - if (found_object_count < MAX_FOUND_OBJECTS) - found_objects[found_object_count++] = page->block_start; - if (GC_for_each_found) - GC_for_each_found(page->block_start); - } + && (((trace_for_tag >= (BIGBLOCK_MIN_SIZE >> LOG_WORD_SIZE)) + && (page->u.size > trace_for_tag)) + || (page->u.size == -trace_for_tag))) { +#if KEEP_BACKPOINTERS + register_traced_object(page->block_start); #endif + if (for_each_found) + for_each_found(page->block_start); + } } if (j >= NUM_TAGGED_SETS) { int k = 0; - GCPRINT(GCOUTF, "%s counts: ", name); - for (i = 0; i < (BIGBLOCK_MIN_SIZE >> LOG_WORD_SIZE); i++) { - if (dump_info_array[i]) { - k++; - if (k == 10) { - GCPRINT(GCOUTF, "\n "); - k = 0; + if (flags & GC_DUMP_SHOW_DETAILS) { + GCPRINT(GCOUTF, "%s counts: ", name); + for (i = 0; i < (BIGBLOCK_MIN_SIZE >> LOG_WORD_SIZE); i++) { + if (dump_info_array[i]) { + k++; + if (k == 10) { + GCPRINT(GCOUTF, "\n "); + k = 0; + } + GCPRINT(GCOUTF, " [%d:%ld]", i << LOG_WORD_SIZE, dump_info_array[i]); } - GCPRINT(GCOUTF, " [%d:%ld]", i << LOG_WORD_SIZE, dump_info_array[i]); } + GCPRINT(GCOUTF, "\n"); } - GCPRINT(GCOUTF, "\n"); } else { GCPRINT(GCOUTF, "Tag counts and sizes:\n"); GCPRINT(GCOUTF, "Begin MzScheme3m\n"); @@ -4763,10 +4733,14 @@ void GC_dump(void) if (dump_info_array[i]) { char *tn, buf[256]; switch(i) { - case gc_weak_array_tag: tn = "weak-array"; break; case gc_on_free_list_tag: tn = "freelist-elem"; break; default: - tn = scheme_get_type_name((Type_Tag)i); + if (i == weak_array_tag) + tn = "weak-array"; + else if (get_type_name) + tn = get_type_name((Type_Tag)i); + else + tn = NULL; if (!tn) { sprintf(buf, "unknown,%d", i); tn = buf; @@ -4779,7 +4753,7 @@ void GC_dump(void) GCPRINT(GCOUTF, "End MzScheme3m\n"); } - { + if (flags & GC_DUMP_SHOW_DETAILS) { int did_big = 0; for (page = first; page; page = page->next) { if ((page->type == kind) && (page->flags & MFLAG_BIGBLOCK) && !(page->flags & MFLAG_CONTINUED)) { @@ -4826,34 +4800,26 @@ void GC_dump(void) (100.0 * ((double)page_reservations - memory_in_use)) / memory_in_use); #if KEEP_BACKPOINTERS - if (GC_show_trace) { - avoid_collection++; - GCPRINT(GCOUTF, "Begin Trace\n"); - for (i = 0; i < found_object_count; i++) { - void *p; - int limit = GC_path_length_limit; - p = found_objects[i]; - p = print_out_pointer("==* ", p); - while (p && limit) { - p = print_out_pointer(" <- ", p); - limit--; - } - } - GCPRINT(GCOUTF, "End Trace\n"); - GC_trace_for_tag = 57; - --avoid_collection; + if (flags & GC_DUMP_SHOW_TRACE) { + print_traced_objects(path_length_limit, get_type_name, get_xtagged_name, print_tagged_value); } - if (GC_show_finals) { + if (flags & GC_DUMP_SHOW_FINALS) { Fnl *f; avoid_collection++; GCPRINT(GCOUTF, "Begin Finalizations\n"); for (f = finalizers; f; f = f->next) { - print_out_pointer("==@ ", f->p); + print_out_pointer("==@ ", f->p, get_type_name, get_xtagged_name, print_tagged_value); } GCPRINT(GCOUTF, "End Finalizations\n"); --avoid_collection; } - if (GC_for_each_found) - avoid_collection++; #endif + if (for_each_found) + --avoid_collection; } + +void GC_dump(void) +{ + GC_dump_with_traces(0, NULL, NULL, NULL, 0, NULL, 0); +} + diff --git a/src/mzscheme/gc2/fnls.c b/src/mzscheme/gc2/fnls.c index 78794ec27f..8fc1e86a2e 100644 --- a/src/mzscheme/gc2/fnls.c +++ b/src/mzscheme/gc2/fnls.c @@ -5,6 +5,7 @@ GC_set_finalizer reset_finalizer_tree finalizers + num_fnls Requires: GC_weak_array_tag is_finalizable_page(p) diff --git a/src/mzscheme/gc2/gc2.h b/src/mzscheme/gc2/gc2.h index 460bab0531..a6b5f69c0f 100644 --- a/src/mzscheme/gc2/gc2.h +++ b/src/mzscheme/gc2/gc2.h @@ -64,7 +64,7 @@ GC2_EXTERN void GC_add_roots(void *start, void *end); Called by MzScheme to install roots. The memory between `start' (inclusive) and `end' (exclusive) contains pointers. */ -GC2_EXTERN void GC_init_type_tags(int count, int weakbox, int ephemeron); +GC2_EXTERN void GC_init_type_tags(int count, int weakbox, int ephemeron, int weakarray); /* Called by MzScheme to indicate the number of different type tags it uses, starting from 0. `count' is always less than 256. The weakbox diff --git a/src/mzscheme/gc2/gc2_dump.h b/src/mzscheme/gc2/gc2_dump.h new file mode 100644 index 0000000000..14bf343187 --- /dev/null +++ b/src/mzscheme/gc2/gc2_dump.h @@ -0,0 +1,31 @@ + +/* Extra headers for the GC2 tracing interface */ + +#ifndef __mzscheme_gc_2_dump__ +#define __mzscheme_gc_2_dump__ + +typedef char *(*GC_get_type_name_proc)(short t); +typedef char *(*GC_get_xtagged_name_proc)(void *p); +typedef void (*GC_for_each_found_proc)(void *p); + +typedef void (*GC_print_tagged_value_proc)(const char *prefix, + void *v, int xtagged, unsigned long diff, int max_w, + const char *suffix); + +GC2_EXTERN void GC_dump_with_traces(int flags, + GC_get_type_name_proc get_type_name, + GC_get_xtagged_name_proc get_xtagged_name, + GC_for_each_found_proc for_each_found, + short trace_for_tag, + GC_print_tagged_value_proc print_tagged_value, + int path_length_limit); + +# define GC_DUMP_SHOW_DETAILS 0x1 +# define GC_DUMP_SHOW_TRACE 0x2 +# define GC_DUMP_SHOW_FINALS 0x4 + +GC2_EXTERN int GC_is_tagged(void *p); +GC2_EXTERN int GC_is_tagged_start(void *p); +GC2_EXTERN void *GC_next_tagged_start(void *p); + +#endif diff --git a/src/mzscheme/gc2/newgc.c b/src/mzscheme/gc2/newgc.c index a0985ea20e..8eafe0778f 100644 --- a/src/mzscheme/gc2/newgc.c +++ b/src/mzscheme/gc2/newgc.c @@ -32,6 +32,7 @@ #include #include #include "gc2.h" +#include "gc2_dump.h" #include "../src/schpriv.h" #ifdef _WIN32 @@ -91,9 +92,6 @@ /* the size of a page we use for the internal mark stack */ #define STACK_PART_SIZE (1 * 1024 * 1024) -/* the maximum number of pages to compact at any one time */ -#define MAX_PAGES_TO_COMPACT 25 - /* These are computed from the previous settings. You shouldn't mess with them */ #define PTR(x) ((void*)(x)) @@ -108,7 +106,7 @@ #define WORD_SIZE (1 << LOG_WORD_SIZE) #define WORD_BITS (8 * WORD_SIZE) #define APAGE_SIZE (1 << LOG_APAGE_SIZE) -#define GENERATIONS 2 +#define GENERATIONS 1 /* the externals */ void (*GC_collect_start_callback)(void); @@ -238,7 +236,7 @@ struct mpage { /* BYTES: */ unsigned char marked_on; /* + 1 */ unsigned char has_new; /* + 1 */ unsigned short live_size; /* + 2 */ - struct mpage *mirror; /* + 4 */ + void **backtrace; /* + 4 */ /* = 28 bytes */ /* = 28 / 4 = 7 words */ }; @@ -331,6 +329,8 @@ static int gc_full = 0; /* a flag saying if this is a full/major collection */ static Mark_Proc mark_table[NUMBER_OF_TAGS]; /* the table of mark procs */ static Fixup_Proc fixup_table[NUMBER_OF_TAGS]; /* the talbe of repair procs */ static unsigned long memory_in_use = 0; /* the amount of memory in use */ +static struct mpage *release_page = NULL; +static int avoid_collection; /* These procedures modify or use the page map. The page map provides us very fast mappings from pointers to the page the reside on, if any. The page @@ -372,6 +372,13 @@ inline static struct mpage *find_page(void *p) } +static size_t round_to_apage_size(size_t sizeb) +{ + sizeb += APAGE_SIZE - 1; + sizeb -= sizeb & (APAGE_SIZE - 1); + return sizeb; +} + /* the core allocation functions */ static void *allocate_big(size_t sizeb, int type) { @@ -386,11 +393,15 @@ static void *allocate_big(size_t sizeb, int type) sizeb = gcWORDS_TO_BYTES(sizew); if((gen0_current_size + sizeb) >= gen0_max_size) { - garbage_collect(0); + if (!avoid_collection) + garbage_collect(0); } gen0_current_size += sizeb; - bpage = malloc_pages(sizeb, APAGE_SIZE); + /* We not only need APAGE_SIZE alignment, we + need everything consisently mapped within an APAGE_SIZE + segment. So round up. */ + bpage = malloc_pages(round_to_apage_size(sizeb), APAGE_SIZE); bpage->size = sizeb; bpage->big_page = 1; bpage->page_type = type; @@ -423,7 +434,21 @@ inline static void *allocate(size_t sizeb, int type) newsize = gen0_alloc_page->size + sizeb; if(newsize > GEN0_PAGE_SIZE) { - if(gen0_alloc_page->next) gen0_alloc_page = gen0_alloc_page->next; else + if(gen0_alloc_page->next) + gen0_alloc_page = gen0_alloc_page->next; + else if (avoid_collection) { + struct mpage *work; + + work = malloc_pages(GEN0_PAGE_SIZE, APAGE_SIZE); + work->size = GEN0_PAGE_SIZE; + work->big_page = 1; + gen0_alloc_page->prev = work; + work->next = gen0_alloc_page; + gen0_alloc_page = work; + pagemap_add(work); + work->size = HEADER_SIZEB; + work->big_page = 0; + } else garbage_collect(0); goto alloc_retry; } else { @@ -643,6 +668,85 @@ static void dump_heap(void) #define GCWARN(args) { GCPRINT args; GCFLUSHOUT(); } #define GCERR(args) { GCPRINT args; GCFLUSHOUT(); abort(); } +/*****************************************************************************/ +/* Backtrace */ +/*****************************************************************************/ + +#if MZ_GC_BACKTRACE + +static void backtrace_new_page(struct mpage *page) +{ + /* This is a little wastefull for big pages, because we'll + only use the first few words: */ + page->backtrace = (void **)malloc_pages(APAGE_SIZE, APAGE_SIZE); +} + +static void free_backtrace(struct mpage *page) +{ + free_pages(page->backtrace, APAGE_SIZE); +} + +static void *bt_source; +static int bt_type; + +static void set_backtrace_source(void *source, int type) +{ + bt_source = source; + bt_type = type; +} + +static void record_backtrace(struct mpage *page, void *ptr) +/* ptr is after objhead */ +{ + unsigned long delta; + + delta = PPTR(ptr) - PPTR(page); + page->backtrace[delta - 1] = bt_source; + ((long *)page->backtrace)[delta] = bt_type; +} + +static void copy_backtrace_source(struct mpage *to_page, void *to_ptr, + struct mpage *from_page, void *from_ptr) +/* ptrs are at objhead */ +{ + unsigned long to_delta, from_delta; + + to_delta = PPTR(to_ptr) - PPTR(to_page); + from_delta = PPTR(from_ptr) - PPTR(from_page); + + to_page->backtrace[to_delta] = from_page->backtrace[from_delta]; + to_page->backtrace[to_delta+1] = from_page->backtrace[from_delta+1]; +} + +static void *get_backtrace(struct mpage *page, void *ptr) +/* ptr is after objhead */ +{ + unsigned long delta; + + if (page->big_page) + ptr = PTR(NUM(page) + HEADER_SIZEB); + + delta = PPTR(ptr) - PPTR(page); + return page->backtrace[delta - 1]; +} + + +# define BT_STACK (PAGE_TYPES + 0) +# define BT_ROOT (PAGE_TYPES + 1) +# define BT_FINALIZER (PAGE_TYPES + 2) +# define BT_WEAKLINK (PAGE_TYPES + 3) +# define BT_IMMOBILE (PAGE_TYPES + 4) + +#else +# define backtrace_new_page(page) /* */ +# define free_backtrace(page) /* */ +# define set_backtrace_source(ptr, type) /* */ +# define record_backtrace(page, ptr) /* */ +# define copy_backtrace_source(to_page, to_ptr, from_page, from_ptr) /* */ +#endif + +#define two_arg_no_op(a, b) /* */ + /*****************************************************************************/ /* Routines dealing with various runtime execution stacks */ /* */ @@ -677,7 +781,6 @@ unsigned long GC_get_stack_base() long size, count; \ void ***p, **a; \ \ - if(park[0]) operation(park[0]); if(park[1]) operation(park[1]); \ while(var_stack) { \ var_stack = (void **)((char *)var_stack + delta); \ if(var_stack == limit) return; \ @@ -709,8 +812,6 @@ void GC_mark_variable_stack(void **var_stack, long delta, void *limit) long size, count; void ***p, **a; - if(park[0]) gcMARK(park[0]); - if(park[1]) gcMARK(park[1]); while (var_stack) { var_stack = (void **)((char *)var_stack + delta); if (var_stack == limit) @@ -729,11 +830,13 @@ void GC_mark_variable_stack(void **var_stack, long delta, void *limit) size -= 2; a = (void **)((char *)a + delta); while (count--) { + set_backtrace_source(a, BT_STACK); gcMARK(*a); a++; } } else { a = (void **)((char *)a + delta); + set_backtrace_source(a, BT_STACK); gcMARK(*a); } p++; @@ -749,8 +852,6 @@ void GC_fixup_variable_stack(void **var_stack, long delta, void *limit) long size, count; void ***p, **a; - if(park[0]) gcFIXUP(park[0]); - if(park[1]) gcFIXUP(park[1]); while (var_stack) { var_stack = (void **)((char *)var_stack + delta); if (var_stack == limit) @@ -791,26 +892,29 @@ void GC_fixup_variable_stack(void **var_stack, long delta, void *limit) #include "roots.c" -#define traverse_roots(gcMUCK) { \ +#define traverse_roots(gcMUCK, set_bt_src) { \ unsigned long j; \ if(roots) { \ sort_and_merge_roots(); \ for(j = 0; j < roots_count; j += 2) { \ void **start = (void**)roots[j]; \ void **end = (void**)roots[j+1]; \ - while(start < end) gcMUCK(*start++); \ + while(start < end) { \ + set_bt_src(start, BT_ROOT); \ + gcMUCK(*start++); \ + } \ } \ } \ } inline static void mark_roots() { - traverse_roots(gcMARK); + traverse_roots(gcMARK, set_backtrace_source); } inline static void repair_roots() { - traverse_roots(gcFIXUP); + traverse_roots(gcFIXUP, two_arg_no_op); } /*****************************************************************************/ @@ -848,20 +952,22 @@ void GC_free_immobile_box(void **b) GCWARN((GCOUTF, "Attempted free of non-existent immobile box %p\n", b)); } -#define traverse_immobiles(gcMUCK) { \ +#define traverse_immobiles(gcMUCK, set_bt_src) { \ struct immobile_box *ib; \ - for(ib = immobile_boxes; ib; ib = ib->next) \ + for(ib = immobile_boxes; ib; ib = ib->next) { \ + set_bt_src(ib, BT_IMMOBILE); \ gcMUCK(ib->p); \ + } \ } inline static void mark_immobiles(void) { - traverse_immobiles(gcMARK); + traverse_immobiles(gcMARK, set_backtrace_source); } inline static void repair_immobiles(void) { - traverse_immobiles(gcFIXUP); + traverse_immobiles(gcFIXUP, two_arg_no_op); } /*****************************************************************************/ @@ -882,12 +988,16 @@ inline static void mark_finalizer_structs(void) struct finalizer *fnl; for(fnl = GC_resolve(finalizers); fnl; fnl = GC_resolve(fnl->next)) { + set_backtrace_source(fnl, BT_FINALIZER); gcMARK(fnl->data); + set_backtrace_source(&finalizers, BT_ROOT); gcMARK(fnl); } for(fnl = run_queue; fnl; fnl = fnl->next) { + set_backtrace_source(fnl, BT_FINALIZER); gcMARK(fnl->data); gcMARK(fnl->p); + set_backtrace_source(&run_queue, BT_ROOT); gcMARK(fnl); } } @@ -923,12 +1033,14 @@ inline static void check_finalizers(int level) GCDEBUG((DEBUGOUTF, "CFNL: Level %i finalizer %p on %p queued for finalization.\n", work->eager_level, work, work->p)); + set_backtrace_source(work, BT_FINALIZER); gcMARK(work->p); if(prev) prev->next = next; if(!prev) finalizers = next; if(last_in_queue) last_in_queue = last_in_queue->next = work; if(!last_in_queue) run_queue = last_in_queue = work; work->next = NULL; + --num_fnls; work = next; } else { @@ -950,6 +1062,7 @@ inline static void do_ordered_level3(void) GCDEBUG((DEBUGOUTF, "LVL3: %p is not marked. Marking payload (%p)\n", temp, temp->p)); + set_backtrace_source(temp, BT_FINALIZER); if(temp->tagged) mark_table[*(unsigned short*)temp->p](temp->p); if(!temp->tagged) GC_mark_xtagged(temp->p); } @@ -979,8 +1092,10 @@ inline static void mark_weak_finalizer_structs(void) struct weak_finalizer *work; GCDEBUG((DEBUGOUTF, "MARKING WEAK FINALIZERS.\n")); - for(work = weak_finalizers; work; work = work->next) + for(work = weak_finalizers; work; work = work->next) { + set_backtrace_source(&weak_finalizers, BT_ROOT); gcMARK(work); + } } inline static void repair_weak_finalizer_structs(void) @@ -1018,7 +1133,10 @@ inline static void reset_weak_finalizers(void) struct weak_finalizer *wfnl; for(wfnl = GC_resolve(weak_finalizers); wfnl; wfnl = GC_resolve(wfnl->next)) { - if(marked(wfnl->p)) gcMARK(wfnl->saved); + if(marked(wfnl->p)) { + set_backtrace_source(wfnl, BT_WEAKLINK); + gcMARK(wfnl->saved); + } *(void**)(NUM(GC_resolve(wfnl->p)) + wfnl->offset) = wfnl->saved; wfnl->saved = NULL; } @@ -1028,7 +1146,7 @@ inline static void reset_weak_finalizers(void) /* weak boxes and arrays */ /*****************************************************************************/ -static const unsigned short gc_weak_array_tag = 256; +static unsigned short weak_array_tag; static unsigned short weak_box_tag; static unsigned short ephemeron_tag; @@ -1478,6 +1596,7 @@ static void propagate_accounting_marks(void) while(pop_ptr(&p) && !kill_propagation_loop) { page = find_page(p); + set_backtrace_source(p, page->page_type); GCDEBUG((DEBUGOUTF, "btc_account: popped off page %p, ptr %p\n", page, p)); if(page->big_page) mark_acc_big_page(page); @@ -1662,12 +1781,13 @@ void designate_modified(void *p) #include "sighand.c" -void GC_init_type_tags(int count, int weakbox, int ephemeron) +void GC_init_type_tags(int count, int weakbox, int ephemeron, int weakarray) { static int initialized = 0; weak_box_tag = weakbox; ephemeron_tag = ephemeron; + weak_array_tag = weakarray; if(!initialized) { initialized = 1; @@ -1681,9 +1801,10 @@ void GC_init_type_tags(int count, int weakbox, int ephemeron) fixup_weak_box, 0, 0); GC_register_traversers(ephemeron_tag, size_ephemeron, mark_ephemeron, fixup_ephemeron, 0, 0); - GC_register_traversers(gc_weak_array_tag, size_weak_array, mark_weak_array, + GC_register_traversers(weak_array_tag, size_weak_array, mark_weak_array, fixup_weak_array, 0, 0); initialize_signal_handler(); + GC_add_roots(&park, (char *)&park + sizeof(park) + 1); } } @@ -1754,6 +1875,8 @@ void GC_mark(const void *const_p) gen0_big_pages = page->next; if(page->next) page->next->prev = page->prev; + backtrace_new_page(page); + page->next = pages[PAGE_BIG]; page->prev = NULL; if(page->next) page->next->prev = page; @@ -1764,6 +1887,7 @@ void GC_mark(const void *const_p) } page->marked_on = 1; + record_backtrace(page, PTR(NUM(page) + HEADER_SIZEB)); GCDEBUG((DEBUGOUTF, "Marking %p on big page %p\n", p, page)); /* Finally, we want to add this to our mark queue, so we can propagate its pointers */ @@ -1788,6 +1912,7 @@ void GC_mark(const void *const_p) page->marked_on = 1; page->previous_size = HEADER_SIZEB; page->live_size += ohead->size; + record_backtrace(page, p); push_ptr(p); } else GCDEBUG((DEBUGOUTF, "Not marking %p (it's old; %p / %i)\n", p, page, page->previous_size)); @@ -1810,8 +1935,8 @@ void GC_mark(const void *const_p) size = gcWORDS_TO_BYTES(ohead->size); /* search for a page with the space to spare */ - while(work && ((work->size + size) >= APAGE_SIZE)) - work = work->next; + if (work && ((work->size + size) >= APAGE_SIZE)) + work = NULL; /* now either fetch where we're going to put this object or make a new page if we couldn't find a page with space to spare */ @@ -1826,11 +1951,11 @@ void GC_mark(const void *const_p) work->page_type = type; work->size = work->previous_size = HEADER_SIZEB; work->marked_on = 1; + backtrace_new_page(work); work->next = pages[type]; work->prev = NULL; - if(work->next) { + if(work->next) work->next->prev = work; - } pagemap_add(work); pages[type] = work; newplace = PTR(NUM(work) + HEADER_SIZEB); @@ -1852,6 +1977,9 @@ void GC_mark(const void *const_p) /* drop the new location of the object into the forwarding space and into the mark queue */ newplace = PTR(NUM(newplace) + WORD_SIZE); + /* record why we marked this one (if enabled) */ + record_backtrace(work, newplace); + /* set forwarding pointer */ GCDEBUG((DEBUGOUTF,"Marking %p (moved to %p on page %p)\n", p, newplace, work)); *(void**)p = newplace; @@ -1873,6 +2001,8 @@ inline static void internal_mark(void *p) void **start = PPTR(NUM(page) + HEADER_SIZEB + WORD_SIZE); void **end = PPTR(NUM(page) + page->size); + set_backtrace_source(start, page->page_type); + switch(page->page_type) { case PAGE_TAGGED: mark_table[*(unsigned short*)start](start); break; case PAGE_ATOMIC: break; @@ -1888,6 +2018,8 @@ inline static void internal_mark(void *p) } else { struct objhead *info = (struct objhead *)(NUM(p) - WORD_SIZE); + set_backtrace_source(p, info->type); + switch(info->type) { case PAGE_TAGGED: mark_table[*(unsigned short*)p](p); break; case PAGE_ATOMIC: break; @@ -1960,7 +2092,7 @@ void GC_fixup(void *pp) } /*****************************************************************************/ -/* garbage collection */ +/* memory stats and traces */ /*****************************************************************************/ /* These collect information about memory usage, for use in GC_dump. */ @@ -1968,23 +2100,117 @@ static unsigned long peak_memory_use = 0; static unsigned long num_minor_collects = 0; static unsigned long num_major_collects = 0; +#ifdef MZ_GC_BACKTRACE +# define trace_page_t struct mpage +# define trace_page_type(page) (page)->page_type +# define TRACE_PAGE_TAGGED PAGE_TAGGED +# define TRACE_PAGE_ARRAY PAGE_ARRAY +# define TRACE_PAGE_TAGGED_ARRAY PAGE_TARRAY +# define TRACE_PAGE_ATOMIC PAGE_ATOMIC +# define TRACE_PAGE_XTAGGED PAGE_XTAGGED +# define TRACE_PAGE_MALLOCFREE PAGE_TYPES +# define TRACE_PAGE_BAD PAGE_TYPES +# define trace_page_is_big(page) (page)->big_page +# define trace_backpointer get_backtrace +# include "backtrace.c" +#else +# define reset_object_traces() /* */ +# define register_traced_object(p) /* */ +# define print_traced_objects(x, y, q, z) /* */ +#endif + +#define MAX_DUMP_TAG 256 + static char *type_name[PAGE_TYPES] = { "tagged", "atomic", "array", "tagged array", "xtagged", "big" }; -void GC_dump(void) + +void GC_dump_with_traces(int flags, + GC_get_type_name_proc get_type_name, + GC_get_xtagged_name_proc get_xtagged_name, + GC_for_each_found_proc for_each_found, + short trace_for_tag, + GC_print_tagged_value_proc print_tagged_value, + int path_length_limit) { struct mpage *page; int i; + static unsigned long counts[MAX_DUMP_TAG], sizes[MAX_DUMP_TAG]; + + reset_object_traces(); + if (for_each_found) + avoid_collection++; + + /* Traverse tagged pages to count objects: */ + for (i = 0; i < MAX_DUMP_TAG; i++) { + counts[i] = sizes[i] = 0; + } + for (page = pages[PAGE_TAGGED]; page; page = page->next) { + void **start = PPTR(NUM(page) + HEADER_SIZEB); + void **end = PPTR(NUM(page) + page->size); + + while(start < end) { + struct objhead *info = (struct objhead *)start; + if(!info->dead) { + unsigned short tag = *(unsigned short *)(start + 1); + if (tag < MAX_DUMP_TAG) { + counts[tag]++; + sizes[tag] += info->size; + } + if (tag == trace_for_tag) { + register_traced_object(start + 1); + if (for_each_found) + for_each_found(start + 1); + } + } + start += info->size; + } + } + for (page = pages[PAGE_BIG]; page; page = page->next) { + if (page->page_type == PAGE_TAGGED) { + void **start = PPTR(NUM(page) + HEADER_SIZEB); + unsigned short tag = *(unsigned short *)(start + 1); + if (tag < MAX_DUMP_TAG) { + counts[tag]++; + sizes[tag] += page->size; + } + if ((tag == trace_for_tag) + || (tag == -trace_for_tag)) { + register_traced_object(start + 1); + if (for_each_found) + for_each_found(start + 1); + } + } + } + + GCPRINT(GCOUTF, "Begin MzScheme3m\n"); + for (i = 0; i < MAX_DUMP_TAG; i++) { + if (counts[i]) { + char *tn, buf[256]; + if (get_type_name) + tn = get_type_name((Type_Tag)i); + else + tn = NULL; + if (!tn) { + sprintf(buf, "unknown,%d", i); + tn = buf; + } + GCPRINT(GCOUTF, " %20.20s: %10ld %10ld\n", tn, counts[i], gcWORDS_TO_BYTES(sizes[i])); + } + } + GCPRINT(GCOUTF, "End MzScheme3m\n"); GCWARN((GCOUTF, "Generation 0: %li of %li bytes used\n", gen0_current_size, gen0_max_size)); for(i = 0; i < PAGE_TYPES; i++) { - unsigned long total_use = 0; + unsigned long total_use = 0, count = 0; - for(page = pages[i]; page; page = page->next) + for(page = pages[i]; page; page = page->next) { total_use += page->size; - GCWARN((GCOUTF, "Generation 1 [%s]: %li bytes used\n", - type_name[i], total_use)); + count++; + } + GCWARN((GCOUTF, "Generation 1 [%s]: %li bytes used in %li pages\n", + type_name[i], total_use, count)); } GCWARN((GCOUTF,"\n")); @@ -1992,8 +2218,47 @@ void GC_dump(void) GCWARN((GCOUTF,"Peak memory use after a collection: %li\n",peak_memory_use)); GCWARN((GCOUTF,"# of major collections: %li\n", num_major_collects)); GCWARN((GCOUTF,"# of minor collections: %li\n", num_minor_collects)); + GCWARN((GCOUTF,"# of installed finalizers: %i\n", num_fnls)); + GCWARN((GCOUTF,"# of traced ephemerons: %i\n", num_last_seen_ephemerons)); + + if (flags & GC_DUMP_SHOW_TRACE) { + print_traced_objects(path_length_limit, get_type_name, get_xtagged_name, print_tagged_value); + } + + if (for_each_found) + --avoid_collection; } +void GC_dump(void) +{ + GC_dump_with_traces(0, NULL, NULL, NULL, 0, NULL, 0); +} + +#ifdef MZ_GC_BACKTRACE + +int GC_is_tagged(void *p) +{ + struct mpage *page; + page = find_page(p); + return page && (page->page_type == PAGE_TAGGED); +} + +int GC_is_tagged_start(void *p) +{ + return 0; +} + +void *GC_next_tagged_start(void *p) +{ + return NULL; +} + +#endif + +/*****************************************************************************/ +/* garbage collection */ +/*****************************************************************************/ + static void prepare_pages_for_collection(void) { struct mpage *work; @@ -2075,15 +2340,44 @@ static void mark_backpointers(void) } } -#define should_compact_page(lsize,tsize) ((lsize << 2) < tsize) +struct mpage *allocate_compact_target(struct mpage *work) +{ + struct mpage *npage; + + npage = malloc_dirty_pages(APAGE_SIZE, APAGE_SIZE); + npage->previous_size = npage->size = HEADER_SIZEB; + npage->generation = 1; + npage->back_pointers = 0; + npage->big_page = 0; + npage->page_type = work->page_type; + npage->marked_on = 1; + backtrace_new_page(npage); + /* Link in this new replacement page */ + npage->prev = work; + npage->next = work->next; + work->next = npage; + if (npage->next) + npage->next->prev = npage; + + return npage; +} + +/* Compact when 1/4 of the space between objects is unused: */ +#define should_compact_page(lsize,tsize) (lsize < (tsize - HEADER_SIZEB - (APAGE_SIZE >> 2))) inline static void do_heap_compact(void) { - int compactable_pages_left = MAX_PAGES_TO_COMPACT; int i; for(i = 0; i < PAGE_BIG; i++) { - struct mpage *work = pages[i], *prev = NULL; + struct mpage *work = pages[i], *prev, *npage; + + /* Start from the end: */ + if (work) { + while (work->next) + work = work->next; + } + npage = work; while(work) { if(work->marked_on && !work->has_new) { @@ -2091,66 +2385,70 @@ inline static void do_heap_compact(void) if(should_compact_page(gcWORDS_TO_BYTES(work->live_size),work->size)) { void **start = PPTR(NUM(work) + HEADER_SIZEB); void **end = PPTR(NUM(work) + work->size); - struct mpage *npage = malloc_dirty_pages(APAGE_SIZE, APAGE_SIZE); void **newplace; + unsigned long avail; GCDEBUG((DEBUGOUTF, "Compacting page %p: new version at %p\n", work, npage)); - /* Set up the basic page parameters */ - /* FIXME: ANY OTHER MAINTANENCE */ - npage->previous_size = npage->size = HEADER_SIZEB; - npage->generation = 1; - npage->back_pointers = 0; - npage->big_page = 0; - npage->page_type = work->page_type; - npage->marked_on = 1; - npage->mirror = work; - /* Link in this new replacement page */ - if(prev) prev->next = work->next; else pages[i] = work->next; - if(work->next) work->next->prev = prev; - npage->prev = NULL; - npage->next = pages[i]; - if(npage->next) npage->next->prev = npage; - pages[i] = npage; - if(!prev) prev = npage; - /* set up the traversal pointers */ - newplace = PPTR(NUM(npage) + HEADER_SIZEB); - start = PPTR(NUM(work) + HEADER_SIZEB); - end = PPTR(NUM(work) + work->size); + + if (npage == work) { + /* Need to insert a page: */ + npage = allocate_compact_target(work); + } + avail = gcBYTES_TO_WORDS(APAGE_SIZE - npage->size); + newplace = PPTR(NUM(npage) + npage->size); while(start < end) { - struct objhead *info = (struct objhead *)start; - + struct objhead *info; + + info = (struct objhead *)start; + if(info->mark) { + while (avail <= info->size) { + npage->size = NUM(newplace) - NUM(npage); + do { + npage = npage->prev; + } while (!npage->marked_on || npage->has_new); + if (npage == work) + npage = allocate_compact_target(work); + avail = gcBYTES_TO_WORDS(APAGE_SIZE - npage->size); + newplace = PPTR(NUM(npage) + npage->size); + } + GCDEBUG((DEBUGOUTF,"Moving size %i object from %p to %p\n", gcWORDS_TO_BYTES(info->size), start+1, newplace+1)); memcpy(newplace, start, gcWORDS_TO_BYTES(info->size)); info->moved = 1; *(PPTR(NUM(start) + WORD_SIZE)) = PTR(NUM(newplace) + WORD_SIZE); + copy_backtrace_source(npage, newplace, work, start); newplace += info->size; + avail -= info->size; } - start += info->size; + start += info->size; } + npage->size = NUM(newplace) - NUM(npage); + + prev = work->prev; + + if(prev) prev->next = work->next; else pages[i] = work->next; + if(work->next) work->next->prev = prev; + + work->next = release_page; + release_page = work; /* add the old page to the page map so fixups can find forwards */ - pagemap_add(npage->mirror); - /* set the size */ - npage->size = NUM(newplace) - NUM(npage); - compactable_pages_left--; - if(!compactable_pages_left) - return; - work = work->next; + pagemap_add(work); + + work = prev; } else { - prev = work; - work = work->next; + work = work->prev; } } else { /* Much as I'd like to free pages here, so that we can just have the relevant pages cached, that causes problems. Specifically, if a - weak whatever has a pointer into this pace, we *cannot* reuse it + weak whatever has a pointer into this page, we *cannot* reuse it yet, as we need that information to fix those bits later. */ - prev = work; - work = work->next; + work = work->prev; } } } @@ -2278,7 +2576,7 @@ static void clean_up_heap(void) for(work = gen0_big_pages; work; work = prev) { prev = work->next; pagemap_remove(work); - free_pages(work, work->size); + free_pages(work, round_to_apage_size(work->size)); } for(i = 0; i < PAGE_TYPES; i++) { @@ -2293,15 +2591,11 @@ static void clean_up_heap(void) if(prev) prev->next = next; else pages[i] = next; if(work->next) work->next->prev = prev; pagemap_remove(work); - free_pages(work, work->big_page ? work->size : APAGE_SIZE); + free_backtrace(work); + free_pages(work, work->big_page ? round_to_apage_size(work->size) : APAGE_SIZE); work = next; } else { pagemap_add(work); - if(work->mirror) { - pagemap_remove(work->mirror); - free_pages(work->mirror, APAGE_SIZE); - work->mirror = NULL; - } work->back_pointers = work->marked_on = 0; prev = work; work = work->next; @@ -2318,6 +2612,15 @@ static void clean_up_heap(void) for(work = pages[i]; work; work = work->next) memory_in_use += work->size; } + + /* Free pages vacated by compaction: */ + while (release_page) { + prev = release_page->next; + pagemap_remove(release_page); + free_backtrace(release_page); + free_pages(release_page, APAGE_SIZE); + release_page = prev; + } } static void protect_old_pages(void) @@ -2360,7 +2663,7 @@ static void garbage_collect(int force_full) half the available memory */ in_unsafe_allocation_mode = 1; unsafe_allocation_abort = gc_overmem_abort; - + /* inform the system (if it wants us to) that we're starting collection */ if(GC_collect_start_callback) GC_collect_start_callback(); @@ -2379,7 +2682,7 @@ static void garbage_collect(int force_full) /* now propagate/repair the marks we got from these roots, and do the finalizer passes */ - mark_ready_ephemerons(); propagate_marks(); + propagate_marks(); mark_ready_ephemerons(); propagate_marks(); check_finalizers(1); mark_ready_ephemerons(); propagate_marks(); check_finalizers(2); mark_ready_ephemerons(); propagate_marks(); if(gc_full) zero_weak_finalizers(); diff --git a/src/mzscheme/gc2/vm_osx.c b/src/mzscheme/gc2/vm_osx.c index f0c5efd623..44a995f24c 100644 --- a/src/mzscheme/gc2/vm_osx.c +++ b/src/mzscheme/gc2/vm_osx.c @@ -221,7 +221,7 @@ kern_return_t catch_exception_raise(mach_port_t port, exception_data_t exception_data, mach_msg_type_number_t data_count) { -#if GENERATIONS +#if GENERATIONS /* kernel return value is in exception_data[0], faulting address in exception_data[1] */ if(exception_data[0] == KERN_PROTECTION_FAILURE) { diff --git a/src/mzscheme/gc2/weak.c b/src/mzscheme/gc2/weak.c index 0a654ca0a1..76a0098ec1 100644 --- a/src/mzscheme/gc2/weak.c +++ b/src/mzscheme/gc2/weak.c @@ -10,8 +10,9 @@ GC_malloc_ephemeron size_ephemeron, mark_ephemeron, fixup_ephemeron init_ephemerons mark_ready_ephemerons zero_remaining_ephemerons + num_last_seen_ephemerons Requires: - gc_weak_array_tag + weak_array_tag weak_box_tag ephemeron_tag is_marked(p) @@ -107,7 +108,7 @@ void *GC_malloc_weak_array(size_t size_in_bytes, void *replace_val) replace_val = park[0]; park[0] = NULL; - w->type = gc_weak_array_tag; + w->type = weak_array_tag; w->replace_val = replace_val; w->count = (size_in_bytes >> LOG_WORD_SIZE); @@ -246,6 +247,8 @@ typedef struct GC_Ephemeron { static GC_Ephemeron *ephemerons; +static int num_last_seen_ephemerons = 0; + static int size_ephemeron(void *p) { return gcBYTES_TO_WORDS(sizeof(GC_Ephemeron)); @@ -297,6 +300,7 @@ void *GC_malloc_ephemeron(void *k, void *v) void init_ephemerons() { ephemerons = NULL; + num_last_seen_ephemerons = 0; } static void mark_ready_ephemerons() @@ -307,6 +311,7 @@ static void mark_ready_ephemerons() next = eph->next; if (is_marked(eph->key)) { gcMARK(eph->val); + num_last_seen_ephemerons++; } else { eph->next = waiting; waiting = eph; diff --git a/src/mzscheme/gc2/xform.ss b/src/mzscheme/gc2/xform.ss index 3b0888e420..6fb1b86b76 100644 --- a/src/mzscheme/gc2/xform.ss +++ b/src/mzscheme/gc2/xform.ss @@ -57,7 +57,7 @@ (current-library-collection-paths (list (build-path (current-directory) "xform-collects"))) (error-print-width 100) - + (dynamic-require '(lib "xform-mod.ss" "xform") #f)) ;; Otherwise, we assume that it's ok to use the collects diff --git a/src/mzscheme/main.c b/src/mzscheme/main.c index 7c46ef8fe5..3050539597 100644 --- a/src/mzscheme/main.c +++ b/src/mzscheme/main.c @@ -267,7 +267,7 @@ static int main_after_dlls(int argc, MAIN_char **MAIN_argv) #if defined(MZ_PRECISE_GC) stack_start = (void *)&__gc_var_stack__; - GC_init_type_tags(_scheme_last_type_, scheme_weak_box_type, scheme_ephemeron_type); + GC_init_type_tags(_scheme_last_type_, scheme_weak_box_type, scheme_ephemeron_type, scheme_rt_weak_array); #endif scheme_set_stack_base(stack_start, 1); diff --git a/src/mzscheme/src/salloc.c b/src/mzscheme/src/salloc.c index fbfc8552ee..9a3108dfcf 100644 --- a/src/mzscheme/src/salloc.c +++ b/src/mzscheme/src/salloc.c @@ -425,6 +425,8 @@ typedef struct { #ifdef MZ_PRECISE_GC +#include "../gc2/gc2_dump.h" + START_XFORM_SKIP; #define MARKS_FOR_SALLOC_C @@ -920,7 +922,7 @@ static void count_managed(Scheme_Custodian *m, int *c, int *a, int *u, int *t, #endif #if defined(MZ_PRECISE_GC) -# ifdef COMPACT_BACKTRACE_GC +# ifdef MZ_GC_BACKTRACE # define MZ_PRECISE_GC_TRACE 1 # else # define MZ_PRECISE_GC_TRACE 0 @@ -930,12 +932,7 @@ static void count_managed(Scheme_Custodian *m, int *c, int *a, int *u, int *t, #endif #if MZ_PRECISE_GC_TRACE -extern int GC_show_trace; -extern int GC_show_finals; -extern int GC_trace_for_tag; -extern int GC_path_length_limit; -extern void (*GC_for_each_found)(void *p); - +char *(*GC_get_xtagged_name)(void *p) = NULL; static Scheme_Object *cons_accum_result; static void cons_onto_list(void *p) { @@ -947,9 +944,6 @@ static void cons_onto_list(void *p) # ifdef MZ_PRECISE_GC START_XFORM_SKIP; -extern int GC_is_tagged(void *p); -extern int GC_is_tagged_start(void *p); -extern void *GC_next_tagged_start(void *p); # ifdef DOS_FILE_SYSTEM extern void gc_fprintf(int ignored, const char *c, ...); # define object_console_printf gc_fprintf @@ -976,7 +970,7 @@ static int check_home(Scheme_Object *o) #endif } -void scheme_print_tagged_value(const char *prefix, +static void print_tagged_value(const char *prefix, void *v, int xtagged, unsigned long diff, int max_w, const char *suffix) { @@ -1134,6 +1128,19 @@ Scheme_Object *scheme_dump_gc_stats(int c, Scheme_Object *p[]) #ifdef USE_TAGGED_ALLOCATION void *initial_trace_root = NULL; int (*inital_root_skip)(void *, size_t) = NULL; +#endif +#if MZ_PRECISE_GC_TRACE + int trace_for_tag = 0; + int flags = 0; + int path_length_limit = 1000; + GC_for_each_found_proc for_each_found = NULL; +#else +# define flags 0 +# define trace_for_tag 0 +# define path_length_limit 1000 +# define for_each_found NULL +# define GC_get_xtagged_name NULL +# define print_tagged_value NULL #endif scheme_start_atomic(); @@ -1342,10 +1349,6 @@ Scheme_Object *scheme_dump_gc_stats(int c, Scheme_Object *p[]) #else # if MZ_PRECISE_GC_TRACE - GC_trace_for_tag = -1; - GC_show_trace = 0; - GC_show_finals = 0; - GC_for_each_found = NULL; cons_accum_result = scheme_void; if (c && SCHEME_SYMBOLP(p[0])) { Scheme_Object *sym; @@ -1361,14 +1364,14 @@ Scheme_Object *scheme_dump_gc_stats(int c, Scheme_Object *p[]) void *tn; tn = scheme_get_type_name(i); if (tn && !strcmp(tn, s)) { - GC_trace_for_tag = i; - GC_show_trace = 1; + trace_for_tag = i; + flags |= GC_DUMP_SHOW_TRACE; break; } } if (!strcmp("fnl", s)) - GC_show_finals = 1; + flags |= GC_DUMP_SHOW_FINALS; if (!strcmp("peek", s) && (c == 3)) { long n; @@ -1399,21 +1402,30 @@ Scheme_Object *scheme_dump_gc_stats(int c, Scheme_Object *p[]) return scheme_make_integer_value((long)p[1]); } } else if (SCHEME_INTP(p[0])) { - GC_trace_for_tag = SCHEME_INT_VAL(p[0]); - GC_show_trace = 1; + trace_for_tag = SCHEME_INT_VAL(p[0]); + flags |= GC_DUMP_SHOW_TRACE; } if ((c > 1) && SCHEME_INTP(p[1])) - GC_path_length_limit = SCHEME_INT_VAL(p[1]); + path_length_limit = SCHEME_INT_VAL(p[1]); else if ((c > 1) && SCHEME_SYMBOLP(p[1]) && !strcmp("cons", SCHEME_SYM_VAL(p[1]))) { - GC_for_each_found = cons_onto_list; + for_each_found = cons_onto_list; cons_accum_result = scheme_null; - GC_show_trace = 0; - } else - GC_path_length_limit = 1000; + flags -= (flags & GC_DUMP_SHOW_TRACE); + } scheme_console_printf("Begin Dump\n"); #endif +# ifdef MZ_PRECISE_GC + GC_dump_with_traces(flags, + scheme_get_type_name, + GC_get_xtagged_name, + for_each_found, + trace_for_tag, + print_tagged_value, + path_length_limit); +# else GC_dump(); +# endif #endif if (scheme_external_dump_info) @@ -1455,9 +1467,9 @@ Scheme_Object *scheme_dump_gc_stats(int c, Scheme_Object *p[]) || (home == tagged_atomic) || (home == tagged_uncollectable) || (home == tagged_eternal))) { - scheme_print_tagged_value("\n ->", v, 0, diff, max_w, ""); + print_tagged_value("\n ->", v, 0, diff, max_w, ""); } else - scheme_print_tagged_value("\n ->", v, 1, diff, max_w, ""); + print_tagged_value("\n ->", v, 1, diff, max_w, ""); } scheme_console_printf("\n"); } diff --git a/src/mzscheme/src/stxobj.c b/src/mzscheme/src/stxobj.c index 651219f422..f8a757caef 100644 --- a/src/mzscheme/src/stxobj.c +++ b/src/mzscheme/src/stxobj.c @@ -253,7 +253,7 @@ typedef struct { int pos; } Wrap_Pos; -static void WRAP_POS_SET_FIRST(Wrap_Pos *w) +XFORM_NONGCING static void WRAP_POS_SET_FIRST(Wrap_Pos *w) { if (!SCHEME_NULLP(w->l)) { Scheme_Object *a; @@ -269,7 +269,7 @@ static void WRAP_POS_SET_FIRST(Wrap_Pos *w) } } -static +XFORM_NONGCING static #ifndef NO_INLINE_KEYWORD MSC_IZE(inline) #endif @@ -309,7 +309,7 @@ void DO_WRAP_POS_INC(Wrap_Pos *w) /* Walking backwards through one chunk: */ -static void DO_WRAP_POS_REVINIT(Wrap_Pos *w, Scheme_Object *k) +XFORM_NONGCING static void DO_WRAP_POS_REVINIT(Wrap_Pos *w, Scheme_Object *k) { Scheme_Object *a; a = SCHEME_CAR(k); diff --git a/src/mzscheme/src/stypes.h b/src/mzscheme/src/stypes.h index 4d9a77f5e7..4aab1e112b 100644 --- a/src/mzscheme/src/stypes.h +++ b/src/mzscheme/src/stypes.h @@ -156,66 +156,68 @@ enum { #ifdef MZTAG_REQUIRED _scheme_last_normal_type_, /* 137 */ - scheme_rt_comp_env, /* 138 */ - scheme_rt_constant_binding, /* 139 */ - scheme_rt_resolve_info, /* 140 */ - scheme_rt_optimize_info, /* 141 */ - scheme_rt_compile_info, /* 142 */ - scheme_rt_cont_mark, /* 143 */ - scheme_rt_saved_stack, /* 144 */ - scheme_rt_reply_item, /* 145 */ - scheme_rt_closure_info, /* 146 */ - scheme_rt_overflow, /* 147 */ - scheme_rt_dyn_wind_cell, /* 148 */ - scheme_rt_dyn_wind_info, /* 149 */ - scheme_rt_dyn_wind, /* 150 */ - scheme_rt_dup_check, /* 151 */ - scheme_rt_thread_memory, /* 152 */ - scheme_rt_input_file, /* 153 */ - scheme_rt_input_fd, /* 154 */ - scheme_rt_oskit_console_input, /* 155 */ - scheme_rt_tested_input_file, /* 156 */ - scheme_rt_tested_output_file, /* 157 */ - scheme_rt_indexed_string, /* 158 */ - scheme_rt_output_file, /* 159 */ - scheme_rt_load_handler_data, /* 160 */ - scheme_rt_pipe, /* 161 */ - scheme_rt_beos_process, /* 162 */ - scheme_rt_system_child, /* 163 */ - scheme_rt_tcp, /* 164 */ - scheme_rt_write_data, /* 165 */ - scheme_rt_tcp_select_info, /* 166 */ - scheme_rt_namespace_option, /* 167 */ - scheme_rt_param_data, /* 168 */ - scheme_rt_will, /* 169 */ - scheme_rt_will_registration, /* 170 */ - scheme_rt_struct_proc_info, /* 171 */ - scheme_rt_linker_name, /* 172 */ - scheme_rt_param_map, /* 173 */ - scheme_rt_finalization, /* 174 */ - scheme_rt_finalizations, /* 175 */ - scheme_rt_cpp_object, /* 176 */ - scheme_rt_cpp_array_object, /* 177 */ - scheme_rt_stack_object, /* 178 */ - scheme_rt_preallocated_object, /* 179 */ - scheme_thread_hop_type, /* 180 */ - scheme_rt_srcloc, /* 181 */ - scheme_rt_evt, /* 182 */ - scheme_rt_syncing, /* 183 */ - scheme_rt_comp_prefix, /* 184 */ - scheme_rt_user_input, /* 185 */ - scheme_rt_user_output, /* 186 */ - scheme_rt_compact_port, /* 187 */ - scheme_rt_read_special_dw, /* 188 */ - scheme_rt_regwork, /* 189 */ - scheme_rt_buf_holder, /* 190 */ - scheme_rt_parameterization, /* 191 */ - scheme_rt_print_params, /* 192 */ - scheme_rt_read_params, /* 193 */ - scheme_rt_native_code, /* 194 */ - scheme_rt_native_code_plus_case, /* 195 */ - scheme_rt_jitter_data, /* 196 */ - scheme_rt_module_exports, /* 197 */ + scheme_rt_weak_array, /* 138 */ + + scheme_rt_comp_env, /* 139 */ + scheme_rt_constant_binding, /* 140 */ + scheme_rt_resolve_info, /* 141 */ + scheme_rt_optimize_info, /* 142 */ + scheme_rt_compile_info, /* 143 */ + scheme_rt_cont_mark, /* 144 */ + scheme_rt_saved_stack, /* 145 */ + scheme_rt_reply_item, /* 146 */ + scheme_rt_closure_info, /* 147 */ + scheme_rt_overflow, /* 148 */ + scheme_rt_dyn_wind_cell, /* 149 */ + scheme_rt_dyn_wind_info, /* 150 */ + scheme_rt_dyn_wind, /* 151 */ + scheme_rt_dup_check, /* 152 */ + scheme_rt_thread_memory, /* 153 */ + scheme_rt_input_file, /* 154 */ + scheme_rt_input_fd, /* 155 */ + scheme_rt_oskit_console_input, /* 156 */ + scheme_rt_tested_input_file, /* 157 */ + scheme_rt_tested_output_file, /* 158 */ + scheme_rt_indexed_string, /* 159 */ + scheme_rt_output_file, /* 160 */ + scheme_rt_load_handler_data, /* 161 */ + scheme_rt_pipe, /* 162 */ + scheme_rt_beos_process, /* 163 */ + scheme_rt_system_child, /* 164 */ + scheme_rt_tcp, /* 165 */ + scheme_rt_write_data, /* 166 */ + scheme_rt_tcp_select_info, /* 167 */ + scheme_rt_namespace_option, /* 168 */ + scheme_rt_param_data, /* 169 */ + scheme_rt_will, /* 170 */ + scheme_rt_will_registration, /* 171 */ + scheme_rt_struct_proc_info, /* 172 */ + scheme_rt_linker_name, /* 173 */ + scheme_rt_param_map, /* 174 */ + scheme_rt_finalization, /* 175 */ + scheme_rt_finalizations, /* 176 */ + scheme_rt_cpp_object, /* 177 */ + scheme_rt_cpp_array_object, /* 178 */ + scheme_rt_stack_object, /* 179 */ + scheme_rt_preallocated_object, /* 180 */ + scheme_thread_hop_type, /* 181 */ + scheme_rt_srcloc, /* 182 */ + scheme_rt_evt, /* 183 */ + scheme_rt_syncing, /* 184 */ + scheme_rt_comp_prefix, /* 185 */ + scheme_rt_user_input, /* 186 */ + scheme_rt_user_output, /* 187 */ + scheme_rt_compact_port, /* 188 */ + scheme_rt_read_special_dw, /* 189 */ + scheme_rt_regwork, /* 190 */ + scheme_rt_buf_holder, /* 191 */ + scheme_rt_parameterization, /* 192 */ + scheme_rt_print_params, /* 193 */ + scheme_rt_read_params, /* 194 */ + scheme_rt_native_code, /* 195 */ + scheme_rt_native_code_plus_case, /* 196 */ + scheme_rt_jitter_data, /* 197 */ + scheme_rt_module_exports, /* 198 */ #endif _scheme_last_type_ diff --git a/src/wxmac/include/base/common.h b/src/wxmac/include/base/common.h index 2490756926..37bd32929f 100644 --- a/src/wxmac/include/base/common.h +++ b/src/wxmac/include/base/common.h @@ -359,4 +359,6 @@ extern CGrafPtr wxGetGrafPtr(void); #define wheelEvt 43 #define mouseMenuDown 44 +#include "wx_obj.h" + #endif // wxb_commonh diff --git a/src/wxmac/include/base/wx_obj.h b/src/wxmac/include/base/wx_obj.h index b2979f8865..28815d9ea7 100644 --- a/src/wxmac/include/base/wx_obj.h +++ b/src/wxmac/include/base/wx_obj.h @@ -11,8 +11,6 @@ #ifndef wxb_objh #define wxb_objh -#include "common.h" - #ifdef IN_CPROTO typedef void *wxObject ; #else diff --git a/src/wxmac/src/base/wb_obj.cc b/src/wxmac/src/base/wb_obj.cc index d8b67b93f3..183baa6c7f 100644 --- a/src/wxmac/src/base/wb_obj.cc +++ b/src/wxmac/src/base/wb_obj.cc @@ -14,7 +14,7 @@ #endif #endif -#include "wx_obj.h" +#include "common.h" #include "wx_types.h" int wx_object_count; diff --git a/src/wxmac/src/base/wb_types.cc b/src/wxmac/src/base/wb_types.cc index a46085794e..82e77fcb07 100644 --- a/src/wxmac/src/base/wb_types.cc +++ b/src/wxmac/src/base/wb_types.cc @@ -14,6 +14,7 @@ #endif #endif +#include "common.h" #include "wx_utils.h" #include "wx_types.h" diff --git a/src/wxmac/src/mac/wxBorderArea.cc b/src/wxmac/src/mac/wxBorderArea.cc index 05d1ba6109..42d1699d21 100644 --- a/src/wxmac/src/mac/wxBorderArea.cc +++ b/src/wxmac/src/mac/wxBorderArea.cc @@ -8,6 +8,7 @@ // Copyright: (c) 1993-94, AIAI, University of Edinburgh. All Rights Reserved. /////////////////////////////////////////////////////////////////////////////// +#include "common.h" #include "wxBorderArea.h" #include "wxRectBorder.h" diff --git a/src/wxmac/src/mac/wxLabelArea.cc b/src/wxmac/src/mac/wxLabelArea.cc index 6fa810c84b..f8831d6521 100644 --- a/src/wxmac/src/mac/wxLabelArea.cc +++ b/src/wxmac/src/mac/wxLabelArea.cc @@ -8,6 +8,7 @@ // Copyright: (c) 1993-94, AIAI, University of Edinburgh. All Rights Reserved. /////////////////////////////////////////////////////////////////////////////// +#include "common.h" #include "wxLabelArea.h" #include "wx_messg.h" #include "wx_gdi.h" diff --git a/src/wxmac/src/mac/wxMacDC.cc b/src/wxmac/src/mac/wxMacDC.cc index 76a7aed6ef..b3af74a244 100644 --- a/src/wxmac/src/mac/wxMacDC.cc +++ b/src/wxmac/src/mac/wxMacDC.cc @@ -9,6 +9,7 @@ /////////////////////////////////////////////////////////////////////////////// +#include "common.h" #include "wx_obj.h" #include "wxMacDC.h" diff --git a/src/wxmac/src/mac/wxScrollArea.cc b/src/wxmac/src/mac/wxScrollArea.cc index 371cbbdc56..d9923526a0 100644 --- a/src/wxmac/src/mac/wxScrollArea.cc +++ b/src/wxmac/src/mac/wxScrollArea.cc @@ -8,6 +8,7 @@ // Copyright: (c) 1993-94, AIAI, University of Edinburgh. All Rights Reserved. /////////////////////////////////////////////////////////////////////////////// +#include "common.h" #include "wxScrollArea.h" #include "wx_sbar.h" #include "wx_utils.h" diff --git a/src/wxmac/src/mac/wx_area.cc b/src/wxmac/src/mac/wx_area.cc index 1e0e27f9a4..5d5beb197b 100644 --- a/src/wxmac/src/mac/wx_area.cc +++ b/src/wxmac/src/mac/wx_area.cc @@ -8,6 +8,7 @@ // Copyright: (c) 1993-94, AIAI, University of Edinburgh. All Rights Reserved. /////////////////////////////////////////////////////////////////////////////// +#include "common.h" #include "wx_area.h" #include "wx_win.h" #include "wx_frame.h" diff --git a/src/wxmac/src/mac/wx_dc.cc b/src/wxmac/src/mac/wx_dc.cc index 63806c40df..fb667f4198 100644 --- a/src/wxmac/src/mac/wx_dc.cc +++ b/src/wxmac/src/mac/wx_dc.cc @@ -8,9 +8,7 @@ // Copyright: (c) 1993-94, AIAI, University of Edinburgh. All Rights Reserved. /////////////////////////////////////////////////////////////////////////////// -#ifndef WX_CARBON -# include -#endif +#include "common.h" #include "wx_gdi.h" #include "wx_dc.h" diff --git a/src/wxmac/src/mac/wximgfil.cc b/src/wxmac/src/mac/wximgfil.cc index 00d6569251..fc6ceb8315 100644 --- a/src/wxmac/src/mac/wximgfil.cc +++ b/src/wxmac/src/mac/wximgfil.cc @@ -10,6 +10,7 @@ // not responsible for what this might do to your macintosh, use at your own risk // sorry I do not have time to add more comments, but hope this is of some use +#include "common.h" #include "wx_gdi.h" #include "wx_canvs.h" #include "wx_dc.h" diff --git a/src/wxwindow/src/msw/wx_main.cxx b/src/wxwindow/src/msw/wx_main.cxx index da251d1d27..f7d490fb7c 100644 --- a/src/wxwindow/src/msw/wx_main.cxx +++ b/src/wxwindow/src/msw/wx_main.cxx @@ -196,7 +196,7 @@ int wxWinMain(int wm_is_mred, #if defined(MZ_PRECISE_GC) mzscheme_stack_start = (void *)&__gc_var_stack__; - GC_init_type_tags(_scheme_last_type_, scheme_weak_box_type, scheme_ephemeron_type); + GC_init_type_tags(_scheme_last_type_, scheme_weak_box_type, scheme_ephemeron_type, scheme_rt_weak_array); #endif scheme_set_stack_base(mzscheme_stack_start, 1);