From b5205239509310fdafeb1eb851ce3c7e7df101fb Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 1 Nov 2012 14:40:08 -0600 Subject: [PATCH] change GC to specialize pairs a little more This change doesn't speed up anything, so far. GC performance of pairs (or anything) is determined almost completely by its size in bytes, and this change doesn't affect the size of pairs. At the same time, the change mostly replaces the obsolete "xtagged" support, and I might have a better idea that builds on this change, so I'm keeping it for now. --- src/racket/gc2/README | 9 ++- src/racket/gc2/backtrace.c | 18 ++--- src/racket/gc2/fnls.c | 13 +--- src/racket/gc2/gc2.h | 13 ---- src/racket/gc2/gc2_dump.h | 5 +- src/racket/gc2/newgc.c | 131 +++++++++++++++++++------------------ src/racket/src/jitalloc.c | 8 ++- src/racket/src/list.c | 13 +++- src/racket/src/salloc.c | 17 ++--- 9 files changed, 104 insertions(+), 123 deletions(-) diff --git a/src/racket/gc2/README b/src/racket/gc2/README index 44ffbb6a14..26e29964d6 100644 --- a/src/racket/gc2/README +++ b/src/racket/gc2/README @@ -103,9 +103,7 @@ Racket allocates the following kinds of memory objects: objects, the mark and fixup operations might be applied to all of them.) - * Xtagged - The object is somehow tagged, but not with a leading - `short'. Racket provides a single mark and fixup operation (no - size operation) for all xtagged objects. + * Pair - specialization of Tagged to pairs. * Interior Array - Like array objects, but pointers to the object can reference its interior, rather than just the start of the object, @@ -210,8 +208,9 @@ This function installs a finalizer to be queued for invocation when `p' would otherwise be collected. All ready finalizers should be called at the end of a collection. (A finalization can trigger calls back to the collector, but such a collection will not run more -finalizers.) The `p' argument must point to the beginning of a tagged -(if `tagged' is 1) or xtagged (if `tagged' is 0) object. +finalizers.) The `p' argument must normally point to the beginning of +a tagged (including atomic or pair) object; that is, `tagged' is +currently required to be non-zero. The `level' argument refers to an ordering of finalizers. It can be 1, 2, or 3. During a collection, level 1 finalizers are queued first, diff --git a/src/racket/gc2/backtrace.c b/src/racket/gc2/backtrace.c index 14a0b872bb..7edaa15fde 100644 --- a/src/racket/gc2/backtrace.c +++ b/src/racket/gc2/backtrace.c @@ -13,7 +13,7 @@ TRACE_PAGE_ARRAY TRACE_PAGE_TAGGED_ARRAY TRACE_PAGE_ATOMIC - TRACE_PAGE_XTAGGED + TRACE_PAGE_PAIR TRACE_PAGE_MALLOCFREE TRACE_PAGE_BAD trace_page_is_big @@ -39,7 +39,6 @@ static void register_traced_object(void *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; @@ -52,11 +51,12 @@ static void *print_out_pointer(const char *prefix, void *p, } p = trace_pointer_start(page, p); - if (trace_page_type(page) == TRACE_PAGE_TAGGED) { + if ((trace_page_type(page) == TRACE_PAGE_TAGGED) + || (trace_page_type(page) == TRACE_PAGE_PAIR)) { 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"); + print_tagged_value(prefix, p, 0, 1000, "\n"); } else { GCPRINT(GCOUTF, "%s<#%d> %p\n", prefix, tag, p); } @@ -67,11 +67,6 @@ static void *print_out_pointer(const char *prefix, void *p, 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 { @@ -90,7 +85,6 @@ static void *print_out_pointer(const char *prefix, void *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, j, k, dp = 0, counter, each; @@ -105,7 +99,7 @@ static void print_traced_objects(int path_length_limit, 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); + p = print_out_pointer("==* ", p, get_type_name, print_tagged_value); j = 0; counter = 0; each = 1; while (p && limit) { @@ -127,7 +121,7 @@ static void print_traced_objects(int path_length_limit, counter = 0; } } - p = print_out_pointer(" <- ", p, get_type_name, get_xtagged_name, print_tagged_value); + p = print_out_pointer(" <- ", p, get_type_name, print_tagged_value); limit--; } } diff --git a/src/racket/gc2/fnls.c b/src/racket/gc2/fnls.c index 0c07abc99e..8dc8102480 100644 --- a/src/racket/gc2/fnls.c +++ b/src/racket/gc2/fnls.c @@ -92,21 +92,12 @@ void GC_set_finalizer(void *p, int tagged, int level, void (*f)(void *p, void *d m = find_page(p); if (tagged) { - if (m->type != MTYPE_TAGGED) { + if ((m->type != MTYPE_TAGGED) + || (m->type != MTYPE_PAIR)) { GCPRINT(GCOUTF, "Not tagged: %lx (%d)\n", (intptr_t)p, m->type); CRASH(4); } - } else { - if (m->type != MTYPE_XTAGGED) { - GCPRINT(GCOUTF, "Not xtagged: %lx (%d)\n", - (intptr_t)p, m->type); - CRASH(5); - } - if (m->flags & MFLAG_BIGBLOCK) - fnl->size = m->u.size; - else - fnl->size = ((intptr_t *)p)[-1]; } } #endif diff --git a/src/racket/gc2/gc2.h b/src/racket/gc2/gc2.h index 64ff37fa1e..4139bb6b1f 100644 --- a/src/racket/gc2/gc2.h +++ b/src/racket/gc2/gc2.h @@ -203,19 +203,6 @@ GC2_EXTERN void *GC_malloc_pair(void *car, void *cdr); The main potential advantage is that `car' and `cdr' don't have to be retained by the callee in the case of a GC. */ -GC2_EXTERN void *GC_malloc_one_xtagged(size_t); -/* - Alloc an item, initially zeroed. Rather than having a specific tag, - all objects allocated this way are marked/fixedup via the function - in GC_mark_xtagged and GC_fixup_xtagged. Racket sets - GC_{mark,fixup}_xtagged. */ - -GC2_EXTERN void (*GC_mark_xtagged)(void *obj); -GC2_EXTERN void (*GC_fixup_xtagged)(void *obj); -/* - Mark and fixup functions for memory allocated with - GC_malloc_one_xtagged(). */ - GC2_EXTERN void *GC_malloc_array_tagged(size_t); /* Alloc an array of tagged items. Racket sets the tag in the first diff --git a/src/racket/gc2/gc2_dump.h b/src/racket/gc2/gc2_dump.h index d5f92bc846..a6260055f8 100644 --- a/src/racket/gc2/gc2_dump.h +++ b/src/racket/gc2/gc2_dump.h @@ -5,17 +5,15 @@ #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_for_each_struct_proc)(void *p); typedef void (*GC_print_tagged_value_proc)(const char *prefix, - void *v, int xtagged, uintptr_t diff, int max_w, + void *v, uintptr_t 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 min_trace_for_tag, short max_trace_for_tag, GC_print_tagged_value_proc print_tagged_value, @@ -27,7 +25,6 @@ GC2_EXTERN void GC_dump_variable_stack(void **var_stack, void *limit, void *stack_mem, GC_get_type_name_proc get_type_name, - GC_get_xtagged_name_proc get_xtagged_name, GC_print_tagged_value_proc print_tagged_value); # define GC_DUMP_SHOW_DETAILS 0x1 diff --git a/src/racket/gc2/newgc.c b/src/racket/gc2/newgc.c index d11f2c884c..f2778db83c 100644 --- a/src/racket/gc2/newgc.c +++ b/src/racket/gc2/newgc.c @@ -93,7 +93,7 @@ enum { PAGE_ATOMIC = 1, PAGE_ARRAY = 2, PAGE_TARRAY = 3, - PAGE_XTAGGED = 4, + PAGE_PAIR = 4, PAGE_BIG = 5, /* the number of page types. */ PAGE_TYPES = 6, @@ -128,7 +128,7 @@ static const char *type_name[PAGE_TYPES] = { "atomic", "array", "tagged array", - "xtagged", + "pair", "big" }; @@ -276,8 +276,6 @@ MAYBE_UNUSED static void GCVERBOSEprintf(NewGC *gc, const char *fmt, ...) { /* the externals */ void (*GC_out_of_memory)(void); void (*GC_report_out_of_memory)(void); -void (*GC_mark_xtagged)(void *obj); -void (*GC_fixup_xtagged)(void *obj); GC_collect_start_callback_Proc GC_set_collect_start_callback(GC_collect_start_callback_Proc func) { NewGC *gc = GC_get_GC(); @@ -632,8 +630,8 @@ static void dump_page_map(NewGC *gc, const char *when) case PAGE_TARRAY: kind = 'y'; break; - case PAGE_XTAGGED: - kind = 'x'; + case PAGE_PAIR: + kind = 'p'; break; default: kind = '?'; @@ -1377,7 +1375,7 @@ void *GC_malloc_pair(void *car, void *cdr) NewGC *gc = GC_get_GC(); gc->park[0] = car; gc->park[1] = cdr; - pair = GC_malloc_one_tagged(sizeof(Scheme_Simple_Object)); + pair = allocate(sizeof(Scheme_Simple_Object), PAGE_PAIR); car = gc->park[0]; cdr = gc->park[1]; gc->park[0] = NULL; @@ -1393,7 +1391,7 @@ void *GC_malloc_pair(void *car, void *cdr) memset(info, 0, sizeof(objhead)); /* init objhead */ - /* info->type = type; */ /* We know that the type field is already 0 */ + info->type = PAGE_PAIR; info->size = BYTES_MULTIPLE_OF_WORD_TO_WORDS(allocate_size); /* ALIGN_BYTES_SIZE bumbed us up to the next word boundary */ pair = OBJHEAD_TO_OBJPTR(info); @@ -1405,7 +1403,7 @@ void *GC_malloc_pair(void *car, void *cdr) { Scheme_Simple_Object *obj = (Scheme_Simple_Object *) pair; obj->iso.so.type = scheme_pair_type; - obj->iso.so.keyex = 0; /* init first word of SchemeObject to 0 */ + obj->iso.so.keyex = 0; /* init first word of Scheme_Object to 0 */ obj->u.pair_val.car = car; obj->u.pair_val.cdr = cdr; } @@ -1416,7 +1414,6 @@ void *GC_malloc_pair(void *car, void *cdr) /* the allocation mechanism we present to the outside world */ void *GC_malloc(size_t s) { return allocate(s, PAGE_ARRAY); } void *GC_malloc_one_tagged(size_t s) { return allocate(s, PAGE_TAGGED); } -void *GC_malloc_one_xtagged(size_t s) { return allocate(s, PAGE_XTAGGED); } void *GC_malloc_array_tagged(size_t s) { return allocate(s, PAGE_TARRAY); } void *GC_malloc_atomic(size_t s) { return allocate(s, PAGE_ATOMIC); } void *GC_malloc_atomic_uncollectable(size_t s) { return ofm_malloc_zero(s); } @@ -1432,7 +1429,7 @@ intptr_t GC_compute_alloc_size(intptr_t sizeb) return COMPUTE_ALLOC_SIZE_FOR_OBJECT_SIZE(sizeb); } -intptr_t GC_initial_word(int request_size) +static intptr_t initial_word(int request_size, int type) { intptr_t w = 0; objhead info; @@ -1440,6 +1437,7 @@ intptr_t GC_initial_word(int request_size) const size_t allocate_size = COMPUTE_ALLOC_SIZE_FOR_OBJECT_SIZE(request_size); memset(&info, 0, sizeof(objhead)); + info.type = type; info.size = BYTES_MULTIPLE_OF_WORD_TO_WORDS(allocate_size); /* ALIGN_BYTES_SIZE bumped us up to the next word boundary */ memcpy(&w, &info, sizeof(objhead)); @@ -1447,21 +1445,19 @@ intptr_t GC_initial_word(int request_size) return w; } +intptr_t GC_initial_word(int request_size) +{ + return initial_word(request_size, PAGE_TAGGED); +} + +intptr_t GC_pair_initial_word(int request_size) +{ + return initial_word(request_size, PAGE_PAIR); +} + intptr_t GC_array_initial_word(int request_size) { - intptr_t w = 0; - objhead info; - - const size_t allocate_size = COMPUTE_ALLOC_SIZE_FOR_OBJECT_SIZE(request_size); - - memset(&info, 0, sizeof(objhead)); - info.type = PAGE_ARRAY; - - info.size = BYTES_MULTIPLE_OF_WORD_TO_WORDS(allocate_size); /* ALIGN_BYTES_SIZE bumped us up to the next word boundary */ - - memcpy(&w, &info, sizeof(objhead)); - - return w; + return initial_word(request_size, PAGE_ARRAY); } intptr_t GC_alloc_alignment() @@ -3277,8 +3273,13 @@ static inline void propagate_marks_worker(NewGC *gc, Mark2_Proc *mark_table, voi } break; } - case PAGE_XTAGGED: - GC_mark_xtagged(start); break; + case PAGE_PAIR: + { + Scheme_Object *p = (Scheme_Object *)start; + GC_mark2(SCHEME_CAR(p), gc); + GC_mark2(SCHEME_CDR(p), gc); + } + break; } } @@ -3400,7 +3401,7 @@ static void *trace_pointer_start(mpage *page, void *p) { # 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_PAIR PAGE_PAIR # define TRACE_PAGE_MALLOCFREE PAGE_TYPES # define TRACE_PAGE_BAD PAGE_TYPES # define trace_page_is_big(page) (page)->size_class @@ -3409,14 +3410,13 @@ static void *trace_pointer_start(mpage *page, void *p) { #else # define reset_object_traces() /* */ # define register_traced_object(p) /* */ -# define print_traced_objects(x, y, q, z) /* */ +# define print_traced_objects(x, q, z) /* */ #endif #define MAX_DUMP_TAG 256 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 min_trace_for_tag, short max_trace_for_tag, GC_print_tagged_value_proc print_tagged_value, @@ -3437,30 +3437,32 @@ void GC_dump_with_traces(int flags, for (i = 0; i < MAX_DUMP_TAG; i++) { counts[i] = sizes[i] = 0; } - for (page = gc->gen1_pages[PAGE_TAGGED]; page; page = page->next) { - void **start = PAGE_START_VSS(page); - void **end = PAGE_END_VSS(page); + for (i = 0; i < 2; i++) { + for (page = gc->gen1_pages[!i ? PAGE_TAGGED : PAGE_PAIR]; page; page = page->next) { + void **start = PAGE_START_VSS(page); + void **end = PAGE_END_VSS(page); - while(start < end) { - objhead *info = (objhead *)start; - if(!info->dead) { - void *obj_start = OBJHEAD_TO_OBJPTR(start); - unsigned short tag = *(unsigned short *)obj_start; - ASSERT_TAG(tag); - if (tag < MAX_DUMP_TAG) { - counts[tag]++; - sizes[tag] += info->size; - } - if ((tag == scheme_proc_struct_type) || (tag == scheme_structure_type)) { - if (for_each_struct) for_each_struct(obj_start); - } - if ((tag >= min_trace_for_tag) && (tag <= max_trace_for_tag)) { - register_traced_object(obj_start); - if (for_each_found) - for_each_found(obj_start); + while(start < end) { + objhead *info = (objhead *)start; + if(!info->dead) { + void *obj_start = OBJHEAD_TO_OBJPTR(start); + unsigned short tag = *(unsigned short *)obj_start; + ASSERT_TAG(tag); + if (tag < MAX_DUMP_TAG) { + counts[tag]++; + sizes[tag] += info->size; + } + if ((tag == scheme_proc_struct_type) || (tag == scheme_structure_type)) { + if (for_each_struct) for_each_struct(obj_start); + } + if ((tag >= min_trace_for_tag) && (tag <= max_trace_for_tag)) { + register_traced_object(obj_start); + if (for_each_found) + for_each_found(obj_start); + } } + start += info->size; } - start += info->size; } } for (page = gc->gen1_pages[PAGE_BIG]; page; page = page->next) { @@ -3586,7 +3588,7 @@ void GC_dump_with_traces(int flags, GCWARN((GCOUTF,"# of immobile boxes: %i\n", num_immobiles)); if (flags & GC_DUMP_SHOW_TRACE) { - print_traced_objects(path_length_limit, get_type_name, get_xtagged_name, print_tagged_value); + print_traced_objects(path_length_limit, get_type_name, print_tagged_value); } if (for_each_found) @@ -3595,7 +3597,7 @@ void GC_dump_with_traces(int flags, void GC_dump(void) { - GC_dump_with_traces(0, NULL, NULL, NULL, 0, -1, NULL, 0, NULL); + GC_dump_with_traces(0, NULL, NULL, 0, -1, NULL, 0, NULL); } #ifdef MZ_GC_BACKTRACE @@ -3611,7 +3613,8 @@ int GC_is_tagged(void *p) page = pagemap_find_page(MASTERGC->page_maps, p); } #endif - return page && (page->page_type == PAGE_TAGGED); + return page && ((page->page_type == PAGE_TAGGED) + || (page->page_type == PAGE_PAIR)); } int GC_is_tagged_start(void *p) @@ -3974,8 +3977,12 @@ static void repair_heap(NewGC *gc) case PAGE_ARRAY: while(start < end) gcFIXUP2(*(start++), gc); break; - case PAGE_XTAGGED: - GC_fixup_xtagged(start); + case PAGE_PAIR: + { + Scheme_Object *p = (Scheme_Object *)start; + gcFIXUP2(SCHEME_CAR(p), gc); + gcFIXUP2(SCHEME_CDR(p), gc); + } break; case PAGE_TARRAY: { unsigned short tag = *(unsigned short *)start; @@ -4074,11 +4081,13 @@ static void repair_heap(NewGC *gc) } } break; - case PAGE_XTAGGED: + case PAGE_PAIR: while(start < end) { objhead *info = (objhead *)start; if(info->mark) { - GC_fixup_xtagged(OBJHEAD_TO_OBJPTR(start)); + Scheme_Object *p = (Scheme_Object *)OBJHEAD_TO_OBJPTR(start); + gcFIXUP2(SCHEME_CAR(p), gc); + gcFIXUP2(SCHEME_CDR(p), gc); info->mark = 0; } else { info->dead = 1; @@ -4086,8 +4095,9 @@ static void repair_heap(NewGC *gc) killing_debug(gc, page, info); #endif } - start += info->size; + start += PAIR_SIZE_IN_BYTES >> LOG_WORD_SIZE; } + break; } } } else GCDEBUG((DEBUGOUTF,"Not Cleaning page %p\n", page)); @@ -4759,13 +4769,12 @@ intptr_t GC_propagate_hierarchy_memory_use() #if MZ_GC_BACKTRACE static GC_get_type_name_proc stack_get_type_name; -static GC_get_xtagged_name_proc stack_get_xtagged_name; static GC_print_tagged_value_proc stack_print_tagged_value; static void dump_stack_pos(void *a) { GCPRINT(GCOUTF, " @%p: ", a); - print_out_pointer("", *(void **)a, stack_get_type_name, stack_get_xtagged_name, stack_print_tagged_value); + print_out_pointer("", *(void **)a, stack_get_type_name, stack_print_tagged_value); } # define GC_X_variable_stack GC_do_dump_variable_stack @@ -4781,11 +4790,9 @@ void GC_dump_variable_stack(void **var_stack, void *limit, void *stack_mem, GC_get_type_name_proc get_type_name, - GC_get_xtagged_name_proc get_xtagged_name, GC_print_tagged_value_proc print_tagged_value) { stack_get_type_name = get_type_name; - stack_get_xtagged_name = get_xtagged_name; stack_print_tagged_value = print_tagged_value; GC_do_dump_variable_stack(var_stack, delta, limit, stack_mem, GC_get_GC()); } diff --git a/src/racket/src/jitalloc.c b/src/racket/src/jitalloc.c index 29590f6c20..c3dda0ddc1 100644 --- a/src/racket/src/jitalloc.c +++ b/src/racket/src/jitalloc.c @@ -35,6 +35,7 @@ #ifdef CAN_INLINE_ALLOC THREAD_LOCAL_DECL(extern uintptr_t GC_gen0_alloc_page_ptr); intptr_t GC_initial_word(int sizeb); +intptr_t GC_pair_initial_word(int sizeb); intptr_t GC_array_initial_word(int sizeb); intptr_t GC_compute_alloc_size(intptr_t sizeb); @@ -153,7 +154,12 @@ int scheme_inline_alloc(mz_jit_state *jitter, int amt, Scheme_Type ty, int immut /* GC header: */ if (ty >= 0) { - a_word = GC_initial_word(amt); + if ((ty == scheme_pair_type) + || (ty == scheme_mutable_pair_type) + || (ty == scheme_raw_pair_type)) + a_word = GC_pair_initial_word(amt); + else + a_word = GC_initial_word(amt); jit_movi_l(JIT_R2, a_word); jit_str_l(JIT_V1, JIT_R2); diff --git a/src/racket/src/list.c b/src/racket/src/list.c index f0ce69936d..ffc4edc0e7 100644 --- a/src/racket/src/list.c +++ b/src/racket/src/list.c @@ -821,10 +821,14 @@ Scheme_Object *scheme_make_pair(Scheme_Object *car, Scheme_Object *cdr) Scheme_Object *scheme_make_mutable_pair(Scheme_Object *car, Scheme_Object *cdr) { Scheme_Object *cons; +#ifdef MZ_PRECISE_GC + cons = GC_malloc_pair(car, cdr); +#else cons = scheme_alloc_object(); - cons->type = scheme_mutable_pair_type; SCHEME_CAR(cons) = car; SCHEME_CDR(cons) = cdr; +#endif + cons->type = scheme_mutable_pair_type; return cons; } @@ -836,10 +840,15 @@ Scheme_Object *scheme_make_raw_pair(Scheme_Object *car, Scheme_Object *cdr) tools expect pairs to always contain tagged values. A raw pair contains arbitrary pointers. */ +#ifdef MZ_PRECISE_GC + cons = GC_malloc_pair(car, cdr); +#else cons = scheme_alloc_object(); - cons->type = scheme_raw_pair_type; SCHEME_CAR(cons) = car; SCHEME_CDR(cons) = cdr; +#endif + + cons->type = scheme_raw_pair_type; return cons; } diff --git a/src/racket/src/salloc.c b/src/racket/src/salloc.c index 7b26cae3c7..b2ba46f2e5 100644 --- a/src/racket/src/salloc.c +++ b/src/racket/src/salloc.c @@ -1882,7 +1882,6 @@ static void count_managed(Scheme_Custodian *m, int *c, int *a, int *u, int *t, #endif #if MZ_PRECISE_GC_TRACE -char *(*GC_get_xtagged_name)(void *p) = NULL; static Scheme_Object *cons_accum_result; static void cons_onto_list(void *p) { @@ -1928,7 +1927,7 @@ static int check_home(Scheme_Object *o) } static void print_tagged_value(const char *prefix, - void *v, int xtagged, uintptr_t diff, int max_w, + void *v, uintptr_t diff, int max_w, const char *suffix) { char buffer[256]; @@ -1940,7 +1939,7 @@ static void print_tagged_value(const char *prefix, scheme_check_print_is_obj = check_home; - if (!xtagged) { + { if (SCHEME_TYPE(v) > _scheme_compiled_values_types_) { sprintf(hashstr, "{%" PRIdPTR "}", scheme_hash_key(v)); hash_code = hashstr; @@ -2112,13 +2111,8 @@ static void print_tagged_value(const char *prefix, } sep = "="; - } else if (scheme_external_dump_type) { - type = scheme_external_dump_type(v); - if (*type) - sep = ":"; - } else - type = ""; - + } + if (diff) sprintf(diffstr, "%lx", diff); @@ -2160,7 +2154,6 @@ Scheme_Object *scheme_dump_gc_stats(int c, Scheme_Object *p[]) # define path_length_limit 10000 # define for_each_found NULL # define for_each_struct NULL -# define GC_get_xtagged_name NULL # define print_tagged_value NULL # endif #endif @@ -2508,7 +2501,6 @@ Scheme_Object *scheme_dump_gc_stats(int c, Scheme_Object *p[]) } GC_dump_variable_stack(var_stack, delta, limit, NULL, scheme_get_type_name_or_null, - GC_get_xtagged_name, print_tagged_value); } else { scheme_console_printf(" done\n"); @@ -2532,7 +2524,6 @@ Scheme_Object *scheme_dump_gc_stats(int c, Scheme_Object *p[]) # ifdef MZ_PRECISE_GC GC_dump_with_traces(flags, scheme_get_type_name_or_null, - GC_get_xtagged_name, for_each_found, trace_for_tag, trace_for_tag, print_tagged_value,