diff --git a/racket/src/racket/gc2/gc2_dump.h b/racket/src/racket/gc2/gc2_dump.h index e5278f03f0..16df257f07 100644 --- a/racket/src/racket/gc2/gc2_dump.h +++ b/racket/src/racket/gc2/gc2_dump.h @@ -6,7 +6,7 @@ typedef char *(*GC_get_type_name_proc)(short t); typedef void (*GC_for_each_found_proc)(void *p); -typedef void (*GC_for_each_struct_proc)(void *p); +typedef void (*GC_for_each_struct_proc)(void *p, int sz); typedef void (*GC_print_tagged_value_proc)(const char *prefix, void *v, uintptr_t diff, int max_w, @@ -38,4 +38,8 @@ 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); +typedef void (*GC_allocated_object_callback_proc)(void *, intptr_t size, int tagged, int atomic); + +GC2_EXTERN void GC_set_allocated_object_callback(GC_allocated_object_callback_proc proc); + #endif diff --git a/racket/src/racket/gc2/newgc.c b/racket/src/racket/gc2/newgc.c index 84883218c6..6828ddc80f 100644 --- a/racket/src/racket/gc2/newgc.c +++ b/racket/src/racket/gc2/newgc.c @@ -2021,6 +2021,73 @@ inline static void clean_gen_half(NewGC *gc) gc->gen_half.curr_alloc_page = NULL; } + + +#if MZ_GC_BACKTRACE +static GC_allocated_object_callback_proc GC_allocated_object_callback; +static void count_object(void *p, intptr_t size, int tagged, int atomic); + +GC2_EXTERN void GC_set_allocated_object_callback(GC_allocated_object_callback_proc cb) +{ + GC_allocated_object_callback = cb; +} + +static void report_gen0_objects(NewGC *gc) { + if (!postmaster_and_master_gc(gc)) { + mpage *p; + int ty, i; + + gen0_sync_page_size_from_globals(gc); + + for (p = gc->gen0.pages; p; p = p->next) { + void **start = p->addr; + void **end = (void**)((char *)start + p->size); + while (start < end) { + objhead *info = (objhead *)start; + count_object(OBJHEAD_TO_OBJPTR(info), + gcWORDS_TO_BYTES(info->size), + ((info->type == PAGE_TAGGED) + || (info->type == PAGE_PAIR)), + (info->type == PAGE_ATOMIC)); + start += info->size; + } + } + + for (p = gc->gen0.big_pages; p; p = p->next) { + count_object(BIG_PAGE_TO_OBJECT(p), + p->size, + p->page_type == PAGE_TAGGED, + p->page_type == PAGE_ATOMIC); + } + + for (ty = 0; ty < MED_PAGE_TYPES; ty++) { + for (i = 0; i < NUM_MED_PAGE_SIZES; i++) { + for (p = gc->med_pages[ty][i]; p; p = p->next) { + if (p->generation == AGE_GEN_0) { + void **start = PPTR(NUM(p->addr) + PREFIX_SIZE); + void **end = PPTR(NUM(p->addr) + APAGE_SIZE - p->obj_size); + + while (start < end) { + objhead *info = (objhead *)start; + if (!info->dead) { + count_object(OBJHEAD_TO_OBJPTR(info), + gcWORDS_TO_BYTES(info->size), + ((info->type == PAGE_TAGGED) + || (info->type == PAGE_PAIR)), + ty == MED_PAGE_ATOMIC_INDEX); + } + start += info->size; + } + } + } + } + } + } +} +#else +static void report_gen0_objects(NewGC *gc) { /* no-op */ } +#endif + /*****************************************************************************/ /* Message allocator (intended for places) */ /* */ @@ -5440,6 +5507,8 @@ static void garbage_collect(NewGC *gc, int force_full, int no_full, TIME_INIT(); + report_gen0_objects(gc); + /* inform the system (if it wants us to) that we're starting collection */ if(gc->GC_collect_start_callback) gc->GC_collect_start_callback(); @@ -5940,7 +6009,38 @@ const char *trace_source_kind(int kind) # define print_traced_objects(x, q, z, w) /* */ #endif -#define MAX_DUMP_TAG 256 +#define MAX_DUMP_TAG 512 + +#ifdef MZ_GC_BACKTRACE +static uintptr_t alloc_counts[MAX_DUMP_TAG], alloc_sizes[MAX_DUMP_TAG]; +static uintptr_t tagged_sizes; +static uintptr_t non_atomic_sizes; +static uintptr_t atomic_sizes; + +static void count_object(void *p, intptr_t size, int tagged, int atomic) +{ + if (tagged) { + short t = *(short *)p; + if ((t >= 0) && (t < MAX_DUMP_TAG)) { + alloc_counts[t]++; + alloc_sizes[t] += size; + } + tagged_sizes += size; + } else if (atomic) + atomic_sizes += size; + else + non_atomic_sizes += size; + + if (GC_allocated_object_callback) + GC_allocated_object_callback(p, size, tagged, atomic); +} + +#define SUMMARY_SUFFIX "/BT" +#define BT_ALLOC_COUNTS alloc_counts +#else +#define SUMMARY_SUFFIX "" +#define BT_ALLOC_COUNTS counts +#endif void GC_dump_with_traces(int flags, GC_get_type_name_proc get_type_name, @@ -5981,7 +6081,8 @@ void GC_dump_with_traces(int flags, sizes[tag] += info->size; } if ((tag == scheme_proc_struct_type) || (tag == scheme_structure_type)) { - if (for_each_struct) for_each_struct(obj_start); + if (for_each_struct) + for_each_struct(obj_start, gcWORDS_TO_BYTES(info->size)); } if ((tag >= min_trace_for_tag) && (tag <= max_trace_for_tag)) { register_traced_object(obj_start); @@ -6004,7 +6105,8 @@ void GC_dump_with_traces(int flags, sizes[tag] += gcBYTES_TO_WORDS(page->size); } if ((tag == scheme_proc_struct_type) || (tag == scheme_structure_type)) { - if (for_each_struct) for_each_struct(obj_start); + if (for_each_struct) + for_each_struct(obj_start, page->size); } if (((tag >= min_trace_for_tag) && (tag <= max_trace_for_tag)) || ((-tag >= min_trace_for_tag) && (-tag <= max_trace_for_tag))) { @@ -6032,7 +6134,8 @@ void GC_dump_with_traces(int flags, sizes[tag] += info->size; } if ((tag == scheme_proc_struct_type) || (tag == scheme_structure_type)) { - if (for_each_struct) for_each_struct(obj_start); + if (for_each_struct) + for_each_struct(obj_start, gcWORDS_TO_BYTES(info->size)); } if ((tag >= min_trace_for_tag) && (tag <= max_trace_for_tag)) { register_traced_object(obj_start); @@ -6052,9 +6155,12 @@ void GC_dump_with_traces(int flags, num_immobiles++; if (!(flags & GC_DUMP_SUPPRESS_SUMMARY)) { - GCPRINT(GCOUTF, "Begin Racket3m\n"); + GCPRINT(GCOUTF, "Begin Racket3m" SUMMARY_SUFFIX "\n"); +#ifdef MZ_GC_BACKTRACE + GCPRINT(GCOUTF, " tag live count live size past count past size\n"); +#endif for (i = 0; i < MAX_DUMP_TAG; i++) { - if (counts[i]) { + if (counts[i] || BT_ALLOC_COUNTS[i]) { char *tn, buf[256]; if (get_type_name) tn = get_type_name((Type_Tag)i); @@ -6064,11 +6170,34 @@ void GC_dump_with_traces(int flags, sprintf(buf, "unknown,%d", i); tn = buf; } - GCPRINT(GCOUTF, " %20.20s: %10" PRIdPTR " %10" PRIdPTR "\n", - tn, counts[i], gcWORDS_TO_BYTES(sizes[i])); + GCPRINT(GCOUTF, " %20.20s: %10" PRIdPTR " %10" PRIdPTR +#ifdef MZ_GC_BACKTRACE + " %10" PRIdPTR " %10" PRIdPTR +#endif + "\n", + tn, counts[i], gcWORDS_TO_BYTES(sizes[i]) +#ifdef MZ_GC_BACKTRACE + , alloc_counts[i], alloc_sizes[i] +#endif + ); } } - GCPRINT(GCOUTF, "End Racket3m\n"); +#ifdef MZ_GC_BACKTRACE + { + intptr_t tc = 0, ts = 0, tac = 0, tas = 0; + for (i = 0; i < MAX_DUMP_TAG; i++) { + tc += counts[i]; + ts += gcWORDS_TO_BYTES(sizes[i]); + tac += alloc_counts[i]; + tas += alloc_sizes[i]; + } + GCPRINT(GCOUTF, " %20.20s: %10" PRIdPTR " %10" PRIdPTR + " %10" PRIdPTR " %10" PRIdPTR + "\n", + "TOTAL", tc, ts, tac, tas); + } +#endif + GCPRINT(GCOUTF, "End Racket3m" SUMMARY_SUFFIX "\n"); GCWARN((GCOUTF, "Generation 0: %" PRIdPTR " of %" PRIdPTR " bytes used\n", (uintptr_t) gen0_size_in_use(gc), gc->gen0.max_size)); @@ -6076,14 +6205,28 @@ void GC_dump_with_traces(int flags, (uintptr_t) gen_half_size_in_use(gc))); for(i = 0; i < PAGE_TYPES; i++) { - uintptr_t total_use = 0, count = 0; + uintptr_t total_use = 0, count = 0, allocated = 0; for(page = gc->gen1_pages[i]; page; page = page->next) { total_use += page->size; count++; + + if (i < PAGE_BIG) { + void **start = PAGE_START_VSS(page); + void **end = PAGE_END_VSS(page); + + while(start < end) { + objhead *info = (objhead *)start; + if(!info->dead) { + allocated += gcWORDS_TO_BYTES(info->size); + } + start += info->size; + } + } else + allocated += page->size; } - GCWARN((GCOUTF, "Generation 1 [%s]: %" PRIdPTR " bytes used in %" PRIdPTR " pages\n", - type_name[i], total_use, count)); + GCWARN((GCOUTF, "Generation 1 [%s]: %" PRIdPTR " bytes used of %" PRIdPTR " in %" PRIdPTR " pages\n", + type_name[i], allocated, total_use, count)); } for (ty = 0; ty < MED_PAGE_TYPES; ty++) { @@ -6120,6 +6263,13 @@ void GC_dump_with_traces(int flags, gc->used_pages * APAGE_SIZE, mmu_memory_allocated(gc->mmu) - (gc->used_pages * APAGE_SIZE))); GCWARN((GCOUTF,"Phantom bytes: %" PRIdPTR "\n", (gc->phantom_count + gc->gen0_phantom_count))); + + GCWARN((GCOUTF,"Past allocated memory: %10" PRIdPTR "\n", gc->total_memory_allocated)); + #ifdef MZ_GC_BACKTRACE + GCWARN((GCOUTF,"Past allocated tagged: %10" PRIdPTR "\n", tagged_sizes)); + GCWARN((GCOUTF,"Past allocated array: %10" PRIdPTR "\n", non_atomic_sizes)); + GCWARN((GCOUTF,"Past allocated atomic: %10" PRIdPTR "\n", atomic_sizes)); +#endif GCWARN((GCOUTF,"# of major collections: %" PRIdPTR "\n", gc->num_major_collects)); GCWARN((GCOUTF,"# of minor collections: %" PRIdPTR "\n", gc->num_minor_collects)); GCWARN((GCOUTF,"# of installed finalizers: %i\n", gc->num_fnls)); diff --git a/racket/src/racket/src/eval.c b/racket/src/racket/src/eval.c index c704dd809d..c9c8345dff 100644 --- a/racket/src/racket/src/eval.c +++ b/racket/src/racket/src/eval.c @@ -2252,8 +2252,6 @@ scheme_case_lambda_execute(Scheme_Object *expr) int i, cnt; Scheme_Thread *p = scheme_current_thread; - DEBUG_COUNT_ALLOCATION(expr); - seqin = (Scheme_Case_Lambda *)expr; #ifdef MZ_USE_JIT @@ -2505,10 +2503,8 @@ scheme_make_closure(Scheme_Thread *p, Scheme_Object *code, int close) GC_CAN_IGNORE mzshort *map; int i; - DEBUG_COUNT_ALLOCATION(code); - data = (Scheme_Lambda *)code; - + #ifdef MZ_USE_JIT if (data->u.native_code /* If the union points to a another Scheme_Lambda*, then it's not actually diff --git a/racket/src/racket/src/hash.c b/racket/src/racket/src/hash.c index 833c2e7d1f..d2300e82dc 100644 --- a/racket/src/racket/src/hash.c +++ b/racket/src/racket/src/hash.c @@ -246,8 +246,6 @@ Scheme_Hash_Table *scheme_make_hash_table(int type) { Scheme_Hash_Table *table; - DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_hash_table_type)); - table = MALLOC_ONE_TAGGED(Scheme_Hash_Table); table->size = 0; @@ -642,8 +640,6 @@ Scheme_Hash_Table *scheme_clone_hash_table(Scheme_Hash_Table *ht) Scheme_Hash_Table *table; Scheme_Object **ba; - DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_hash_table_type)); - table = MALLOC_ONE_TAGGED(Scheme_Hash_Table); memcpy(table, ht, sizeof(Scheme_Hash_Table)); MZ_OPT_HASH_KEY(&(table->iso)) = 0; @@ -727,8 +723,6 @@ scheme_make_bucket_table (intptr_t size, int type) Scheme_Bucket_Table *table; size_t asize; - DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_bucket_table_type)); - table = MALLOC_ONE_TAGGED(Scheme_Bucket_Table); table->size = 4; @@ -1125,8 +1119,6 @@ Scheme_Bucket_Table *scheme_clone_bucket_table(Scheme_Bucket_Table *bt) Scheme_Bucket_Table *table; size_t asize; - DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_bucket_table_type)); - table = MALLOC_ONE_TAGGED(Scheme_Bucket_Table); table->so.type = scheme_bucket_table_type; table->size = bt->size; @@ -2570,7 +2562,6 @@ XFORM_NONGCING static Scheme_Hash_Tree *hamt_assoc(Scheme_Hash_Tree *ht, uintptr static Scheme_Hash_Tree *hamt_alloc(int kind, int popcount) /* be sure to set `bitmap` field before a GC becomes possible */ { - DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_hash_tree_type)); return (Scheme_Hash_Tree *)scheme_malloc_small_tagged(HASH_TREE_RECORD_SIZE(kind, popcount)); } diff --git a/racket/src/racket/src/list.c b/racket/src/racket/src/list.c index 5631071137..f631903523 100644 --- a/racket/src/racket/src/list.c +++ b/racket/src/racket/src/list.c @@ -1050,11 +1050,9 @@ scheme_init_unsafe_hash (Scheme_Env *env) Scheme_Object *scheme_make_pair(Scheme_Object *car, Scheme_Object *cdr) { #ifdef MZ_PRECISE_GC - DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_pair_type)); return GC_malloc_pair(car, cdr); #else Scheme_Object *cons; - DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_pair_type)); cons = scheme_alloc_object(); cons->type = scheme_pair_type; SCHEME_CAR(cons) = car; @@ -1795,8 +1793,6 @@ Scheme_Object *scheme_box(Scheme_Object *v) { Scheme_Object *obj; - DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_box_type)); - obj = scheme_alloc_small_object(); obj->type = scheme_box_type; SCHEME_BOX_VAL(obj) = v; @@ -3650,13 +3646,10 @@ static Scheme_Object *eqv_hash_code(int argc, Scheme_Object *argv[]) Scheme_Object *scheme_make_weak_box(Scheme_Object *v) { #ifdef MZ_PRECISE_GC - DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_weak_box_type)); return (Scheme_Object *)GC_malloc_weak_box(v, NULL, 0, 0); #else Scheme_Small_Object *obj; - DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_weak_box_type)); - obj = MALLOC_ONE_TAGGED_WEAK(Scheme_Small_Object); obj->iso.so.type = scheme_weak_box_type; diff --git a/racket/src/racket/src/salloc.c b/racket/src/racket/src/salloc.c index 9ca2938dd1..3698042346 100644 --- a/racket/src/racket/src/salloc.c +++ b/racket/src/racket/src/salloc.c @@ -95,6 +95,10 @@ extern MZGC_DLLIMPORT void GC_register_late_disappearing_link(void **link, void extern MZGC_DLLIMPORT void GC_register_indirect_disappearing_link(void **link, void *obj); #endif +#ifdef MZ_GC_BACKTRACE +static void init_allocation_callback(void); +#endif + SHARED_OK static int use_registered_statics; /************************************************************************/ @@ -143,6 +147,9 @@ void scheme_set_stack_base(void *base, int no_auto_statics) XFORM_SKIP_PROC use_registered_statics = no_auto_statics; #if defined(MZ_PRECISE_GC) GC_report_out_of_memory = scheme_out_of_memory_abort; +# ifdef MZ_GC_BACKTRACE + init_allocation_callback(); +# endif #endif } @@ -1962,6 +1969,24 @@ static int record_traced_and_print_new(void *p) return record_traced(p); } + +static void record_allocated_object(void *p, intptr_t size, int tagged, int atomic) +{ + if (tagged) { + Scheme_Type t = *(Scheme_Type *)p; + if (SAME_TYPE(t, scheme_structure_type) + || SAME_TYPE(t, scheme_proc_struct_type)) { + Scheme_Structure *s = (Scheme_Structure *)p; + s->stype->total_instance_count++; + s->stype->total_instance_sizes += size; + } + } +} + +static void init_allocation_callback() { + GC_set_allocated_object_callback(record_allocated_object); +} + #endif #if MZ_PRECISE_GC @@ -1973,9 +1998,10 @@ static void increment_found_counter(void *p) #endif #if MZ_PRECISE_GC_TRACE -static void count_struct_instance(void *p) { +static void count_struct_instance(void *p, int sz) { Scheme_Structure *s = (Scheme_Structure *)p; - s->stype->instance_count++; + s->stype->current_instance_count++; + s->stype->current_instance_sizes += sz; } #endif @@ -2660,9 +2686,15 @@ Scheme_Object *scheme_dump_gc_stats(int c, Scheme_Object *p[]) scheme_console_printf("Begin Struct\n"); while (SCHEME_PAIRP(cons_accum_result)) { Scheme_Struct_Type *stype = (Scheme_Struct_Type *)SCHEME_CAR(cons_accum_result); - if (stype->instance_count) { - scheme_console_printf(" %32.32s: %10" PRIdPTR "\n", SCHEME_SYM_VAL(stype->name), stype->instance_count); - stype->instance_count = 0; + if (stype->total_instance_count) { + scheme_console_printf(" %32.32s: %10" PRIdPTR " %10" PRIdPTR " %10" PRIdPTR " %10" PRIdPTR "\n", + SCHEME_SYM_VAL(stype->name), + stype->current_instance_count, + stype->current_instance_sizes, + stype->total_instance_count, + stype->total_instance_sizes); + stype->current_instance_count = 0; + stype->current_instance_sizes = 0; } cons_accum_result = SCHEME_CDR(cons_accum_result); } @@ -2771,8 +2803,6 @@ Scheme_Object *scheme_dump_gc_stats(int c, Scheme_Object *p[]) return result; } - - #ifdef MEMORY_COUNTING_ON intptr_t scheme_count_closure(Scheme_Object **o, mzshort len, Scheme_Hash_Table *ht) @@ -3288,92 +3318,3 @@ intptr_t scheme_count_envbox(Scheme_Object *root, Scheme_Hash_Table *ht) } #endif - -/**********************************************************************/ - -#if RECORD_ALLOCATION_COUNTS - -/* Allocation profiling --- prints allocated counts (not necessarily - still live) after every `NUM_ALLOCS_BEFORE_REPORT` structure and - closure allocations. Adjust that constant to match a test program. - Also, run with `racket -j` so that structure allocation is not - inlined, and don't use places. */ - -#define NUM_ALLOCS_BEFORE_REPORT 100000 - -static Scheme_Hash_Table *allocs; -static int alloc_count; -static int reporting; - -#include "../gc2/my_qsort.c" -typedef struct alloc_count_result { int pos; int count; } alloc_count_result; - -static int smaller_alloc_count(const void *a, const void *b) { - return ((alloc_count_result*)a)->count - ((alloc_count_result*)b)->count; -} - -void scheme_record_allocation(Scheme_Object *tag) -{ - Scheme_Object *c; - - if (reporting) - return; - - alloc_count++; - - if (!allocs) { - REGISTER_SO(allocs); - reporting++; - allocs = scheme_make_hash_table(SCHEME_hash_ptr); - --reporting; - } - - c = scheme_hash_get(allocs, tag); - if (!c) c = scheme_make_integer(0); - scheme_hash_set(allocs, tag, scheme_make_integer(SCHEME_INT_VAL(c)+1)); - - if (alloc_count == NUM_ALLOCS_BEFORE_REPORT) { - alloc_count_result *a; - int count = allocs->count; - int k = 0; - int i; - char *s; - - reporting++; - - a = MALLOC_N_ATOMIC(alloc_count_result, count); - printf("\n"); - for (i = allocs->size; i--; ) { - if (allocs->vals[i]) { - a[k].pos = i; - a[k].count = SCHEME_INT_VAL(allocs->vals[i]); - k++; - } - } - my_qsort(a, allocs->count, sizeof(alloc_count_result), smaller_alloc_count); - - for (i = 0; i < count; i++) { - tag = allocs->keys[a[i].pos]; - - if (SCHEME_INTP(tag)) { - s = scheme_get_type_name(SCHEME_INT_VAL(tag)); - } else { - if (SAME_TYPE(SCHEME_TYPE(tag), scheme_lambda_type) - && ((Scheme_Lambda *)tag)->name) - tag = ((Scheme_Lambda*)tag)->name; - else if (SAME_TYPE(SCHEME_TYPE(tag), scheme_case_lambda_sequence_type) - && ((Scheme_Case_Lambda *)tag)->name) - tag = ((Scheme_Case_Lambda*)tag)->name; - - s = scheme_write_to_string(tag, NULL); - } - - printf("%d %s\n", a[i].count, s); - } - - alloc_count = 0; - --reporting; - } -} - -#endif diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h index 62d39bde2e..03df4ee9d6 100644 --- a/racket/src/racket/src/schpriv.h +++ b/racket/src/racket/src/schpriv.h @@ -1060,7 +1060,10 @@ typedef struct Scheme_Struct_Type { Scheme_Object *guard; #if defined(MZ_GC_BACKTRACE) && defined(MZ_PRECISE_GC) - intptr_t instance_count; + intptr_t current_instance_count; + intptr_t current_instance_sizes; + intptr_t total_instance_count; + intptr_t total_instance_sizes; #endif struct Scheme_Struct_Type *parent_types[mzFLEX_ARRAY_DECL]; @@ -4424,18 +4427,6 @@ void scheme_count_generic(Scheme_Object *o, intptr_t *s, intptr_t *e, Scheme_Has #endif #endif -/* See "salloc.c": */ -#ifndef RECORD_ALLOCATION_COUNTS -# define RECORD_ALLOCATION_COUNTS 0 -#endif - -#if RECORD_ALLOCATION_COUNTS -extern void scheme_record_allocation(Scheme_Object *key); -# define DEBUG_COUNT_ALLOCATION(x) scheme_record_allocation(x); -#else -# define DEBUG_COUNT_ALLOCATION(x) /* empty */ -#endif - /*========================================================================*/ /* miscellaneous */ /*========================================================================*/ diff --git a/racket/src/racket/src/struct.c b/racket/src/racket/src/struct.c index dacd5c08b8..c593650d8f 100644 --- a/racket/src/racket/src/struct.c +++ b/racket/src/racket/src/struct.c @@ -2544,6 +2544,8 @@ static Scheme_Object **apply_guards(Scheme_Struct_Type *stype, int argc, Scheme_ return args; } +#define STRUCT_BYTES(c) (sizeof(Scheme_Structure) + (((c) - mzFLEX_DELTA) * sizeof(Scheme_Object *))) + Scheme_Object * scheme_make_struct_instance(Scheme_Object *_stype, int argc, Scheme_Object **args) { @@ -2554,12 +2556,9 @@ scheme_make_struct_instance(Scheme_Object *_stype, int argc, Scheme_Object **arg stype = (Scheme_Struct_Type *)_stype; - DEBUG_COUNT_ALLOCATION((Scheme_Object *)stype); - c = stype->num_slots; inst = (Scheme_Structure *) - scheme_malloc_tagged(sizeof(Scheme_Structure) - + ((c - mzFLEX_DELTA) * sizeof(Scheme_Object *))); + scheme_malloc_tagged(STRUCT_BYTES(c)); inst->so.type = (stype->proc_attr ? scheme_proc_struct_type : scheme_structure_type); inst->stype = stype; @@ -2604,12 +2603,9 @@ Scheme_Object *scheme_make_blank_prefab_struct_instance(Scheme_Struct_Type *styp Scheme_Structure *inst; int c; - DEBUG_COUNT_ALLOCATION((Scheme_Object *)stype); - c = stype->num_slots; inst = (Scheme_Structure *) - scheme_malloc_tagged(sizeof(Scheme_Structure) - + ((c - mzFLEX_DELTA) * sizeof(Scheme_Object *))); + scheme_malloc_tagged(STRUCT_BYTES(c)); inst->so.type = scheme_structure_type; inst->stype = stype; @@ -2623,8 +2619,7 @@ Scheme_Object *scheme_make_serialized_struct_instance(Scheme_Object *prefab_key, Scheme_Serialized_Structure *inst; inst = (Scheme_Serialized_Structure *) - scheme_malloc_tagged(sizeof(Scheme_Serialized_Structure) - + ((num_slots - mzFLEX_DELTA) * sizeof(Scheme_Object *))); + scheme_malloc_tagged(STRUCT_BYTES(num_slots)); inst->so.type = scheme_serialized_structure_type; inst->num_slots = num_slots; @@ -2640,12 +2635,9 @@ Scheme_Object *scheme_make_prefab_struct_instance(Scheme_Struct_Type *stype, Scheme_Structure *inst; int i, c; - DEBUG_COUNT_ALLOCATION((Scheme_Object *)stype); - c = stype->num_slots; inst = (Scheme_Structure *) - scheme_malloc_tagged(sizeof(Scheme_Structure) - + ((c - mzFLEX_DELTA) * sizeof(Scheme_Object *))); + scheme_malloc_tagged(STRUCT_BYTES(c)); inst->so.type = scheme_structure_type; inst->stype = stype; @@ -2670,8 +2662,7 @@ Scheme_Object *scheme_clone_prefab_struct_instance(Scheme_Structure *s) chaperone = NULL; c = s->stype->num_slots; - sz = (sizeof(Scheme_Structure) - + ((c - mzFLEX_DELTA) * sizeof(Scheme_Object *))); + sz = STRUCT_BYTES(c); inst = (Scheme_Structure *)scheme_malloc_tagged(sz); memcpy(inst, s, sz); @@ -2699,12 +2690,9 @@ make_simple_struct_instance(int argc, Scheme_Object **args, Scheme_Object *prim) Scheme_Struct_Type *stype = (Scheme_Struct_Type *)SCHEME_PRIM_CLOSURE_ELS(prim)[0]; int i, c; - DEBUG_COUNT_ALLOCATION((Scheme_Object *)stype); - c = stype->num_slots; inst = (Scheme_Structure *) - scheme_malloc_tagged(sizeof(Scheme_Structure) - + ((c - mzFLEX_DELTA) * sizeof(Scheme_Object *))); + scheme_malloc_tagged(STRUCT_BYTES(c)); inst->so.type = scheme_structure_type; inst->stype = stype; diff --git a/racket/src/racket/src/syntax.c b/racket/src/racket/src/syntax.c index 172a6c2e6d..758f2ae41b 100644 --- a/racket/src/racket/src/syntax.c +++ b/racket/src/racket/src/syntax.c @@ -465,8 +465,6 @@ Scheme_Object *scheme_make_stx(Scheme_Object *val, { Scheme_Stx *stx; - DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_stx_type)); - stx = MALLOC_ONE_TAGGED(Scheme_Stx); stx->iso.so.type = scheme_stx_type; STX_KEY(stx) = HAS_SUBSTX(val) ? STX_SUBSTX_FLAG : 0; diff --git a/racket/src/racket/src/type.c b/racket/src/racket/src/type.c index 57409066af..299118b2b8 100644 --- a/racket/src/racket/src/type.c +++ b/racket/src/racket/src/type.c @@ -328,7 +328,25 @@ scheme_init_type () set_name(scheme_environment_variables_type, ""); #ifdef MZ_GC_BACKTRACE + set_name(scheme_rt_runstack, ""); set_name(scheme_rt_meta_cont, ""); + set_name(scheme_rt_weak_array, ""); + set_name(scheme_syntax_property_preserve_type, ""); + set_name(scheme_rt_resolve_info, ""); + set_name(scheme_rt_unresolve_info, ""); + set_name(scheme_rt_optimize_info, ""); + set_name(scheme_rt_ir_lambda_info, ""); + set_name(scheme_deferred_expr_type, ""); + set_name(scheme_will_be_lambda_type, ""); + set_name(scheme_rt_indexed_string, ""); + set_name(scheme_rt_srcloc, ""); + set_name(scheme_rt_comp_prefix, ""); + set_name(scheme_rt_native_code, ""); + set_name(scheme_rt_native_code_plus_case, ""); + set_name(scheme_rt_sfs_info, ""); + set_name(scheme_rt_letrec_check_frame, ""); + set_name(scheme_rt_module_exports, ""); + set_name(scheme_rt_export_info, ""); #endif } diff --git a/racket/src/racket/src/vector.c b/racket/src/racket/src/vector.c index 4fcd015ec5..8c64867250 100644 --- a/racket/src/racket/src/vector.c +++ b/racket/src/racket/src/vector.c @@ -287,8 +287,6 @@ scheme_make_vector (intptr_t size, Scheme_Object *fill) scheme_wrong_contract("make-vector", "exact-nonnegative-integer?", -1, 0, &vec); } - DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_vector_type)); - if (size < 1024) { vec = (Scheme_Object *)scheme_malloc_tagged(VECTOR_BYTES(size)); } else {