suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

3m GC bug fixes and improvements, include backtrace support

Browse Source 
svn: r3548
This commit is contained in:
Matthew Flatt 2006-06-29 19:40:22 +00:00
parent 0787328fe8
commit cb8ac0ea05
58 changed files with 879 additions and 445 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
src/configure vendored
View File

@ -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

2
src/mred/mrmain.cxx
View File

@ -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

2
src/mred/wxs/prefix.xci
View File

@ -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

2
src/mred/wxs/wxs_bmap.cxx
View File

@ -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

2
src/mred/wxs/wxs_butn.cxx
View File

@ -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

2
src/mred/wxs/wxs_chce.cxx
View File

@ -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

2
src/mred/wxs/wxs_ckbx.cxx
View File

@ -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

2
src/mred/wxs/wxs_cnvs.cxx
View File

@ -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

2
src/mred/wxs/wxs_dc.cxx
View File

@ -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

2
src/mred/wxs/wxs_evnt.cxx
View File

@ -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

2
src/mred/wxs/wxs_fram.cxx
View File

@ -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

2
src/mred/wxs/wxs_gage.cxx
View File

@ -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

2
src/mred/wxs/wxs_gdi.cxx
View File

@ -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

2
src/mred/wxs/wxs_glob.cxx
View File

@ -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

2
src/mred/wxs/wxs_item.cxx
View File

@ -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

2
src/mred/wxs/wxs_lbox.cxx
View File

@ -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

2
src/mred/wxs/wxs_madm.cxx
View File

@ -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

2
src/mred/wxs/wxs_mede.cxx
View File

@ -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

2
src/mred/wxs/wxs_medi.cxx
View File

@ -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

2
src/mred/wxs/wxs_menu.cxx
View File

@ -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

2
src/mred/wxs/wxs_mio.cxx
View File

@ -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

2
src/mred/wxs/wxs_misc.cxx
View File

@ -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

2
src/mred/wxs/wxs_mpb.cxx
View File

@ -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

2
src/mred/wxs/wxs_obj.cxx
View File

@ -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

2
src/mred/wxs/wxs_panl.cxx
View File

@ -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

2
src/mred/wxs/wxs_rado.cxx
View File

@ -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

2
src/mred/wxs/wxs_slid.cxx
View File

@ -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

2
src/mred/wxs/wxs_snip.cxx
View File

@ -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

2
src/mred/wxs/wxs_styl.cxx
View File

@ -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

2
src/mred/wxs/wxs_tabc.cxx
View File

@ -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

2
src/mred/wxs/wxs_win.cxx
View File

@ -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

5
src/mzscheme/configure.ac
View File

@ -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

3
src/mzscheme/gc2/README
View File

@ -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
---------------

110
src/mzscheme/gc2/backtrace.c Normal file
View File

@ -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;
}

406
src/mzscheme/gc2/compact.c
View File

@ -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);
}

1
src/mzscheme/gc2/fnls.c
View File

@ -5,6 +5,7 @@
GC_set_finalizer
reset_finalizer_tree
finalizers
num_fnls
Requires:
GC_weak_array_tag
is_finalizable_page(p)

2
src/mzscheme/gc2/gc2.h
View File

@ -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

31
src/mzscheme/gc2/gc2_dump.h Normal file
View File

@ -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

473
src/mzscheme/gc2/newgc.c
View File

@ -32,6 +32,7 @@
#include <stdio.h>
#include <string.h>
#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();

2
src/mzscheme/gc2/vm_osx.c
View File

@ -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) {

9
src/mzscheme/gc2/weak.c
View File

@ -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;

2
src/mzscheme/gc2/xform.ss
View File

@ -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

2
src/mzscheme/main.c
View File

@ -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);

66
src/mzscheme/src/salloc.c
View File

@ -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");
}

6
src/mzscheme/src/stxobj.c
View File

@ -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);

122
src/mzscheme/src/stypes.h
View File

@ -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_

2
src/wxmac/include/base/common.h
View File

@ -359,4 +359,6 @@ extern CGrafPtr wxGetGrafPtr(void);
#define wheelEvt 43
#define mouseMenuDown 44
#include "wx_obj.h"
#endif // wxb_commonh

2
src/wxmac/include/base/wx_obj.h
View File

@ -11,8 +11,6 @@
#ifndef wxb_objh
#define wxb_objh
#include "common.h"
#ifdef IN_CPROTO
typedef void *wxObject ;
#else

2
src/wxmac/src/base/wb_obj.cc
View File

@ -14,7 +14,7 @@
#endif
#endif
#include "wx_obj.h"
#include "common.h"
#include "wx_types.h"
int wx_object_count;

1
src/wxmac/src/base/wb_types.cc
View File

@ -14,6 +14,7 @@
#endif
#endif
#include "common.h"
#include "wx_utils.h"
#include "wx_types.h"

1
src/wxmac/src/mac/wxBorderArea.cc
View File

@ -8,6 +8,7 @@
// Copyright: (c) 1993-94, AIAI, University of Edinburgh. All Rights Reserved.
///////////////////////////////////////////////////////////////////////////////
#include "common.h"
#include "wxBorderArea.h"
#include "wxRectBorder.h"

1
src/wxmac/src/mac/wxLabelArea.cc
View File

@ -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"

1
src/wxmac/src/mac/wxMacDC.cc
View File

@ -9,6 +9,7 @@
///////////////////////////////////////////////////////////////////////////////
#include "common.h"
#include "wx_obj.h"
#include "wxMacDC.h"

1
src/wxmac/src/mac/wxScrollArea.cc
View File

@ -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"

1
src/wxmac/src/mac/wx_area.cc
View File

@ -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"

4
src/wxmac/src/mac/wx_dc.cc
View File

@ -8,9 +8,7 @@
// Copyright: (c) 1993-94, AIAI, University of Edinburgh. All Rights Reserved.
///////////////////////////////////////////////////////////////////////////////
#ifndef WX_CARBON
# include <QuickDraw.h>
#endif
#include "common.h"
#include "wx_gdi.h"
#include "wx_dc.h"

1
src/wxmac/src/mac/wximgfil.cc
View File

@ -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"

2
src/wxwindow/src/msw/wx_main.cxx
View File

@ -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);