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

improve allocation reports, especially in backtrace mode

Browse Source 
Track total bytes allocated for various tags and categories
in backtrace mode, and improve structure reporting to include
byte counts.

Strip away a more ad-hoc counting that was added recently.
This commit is contained in:
Matthew Flatt 2016-11-27 15:42:07 -07:00
parent 31ca626910
commit 4b02c169d7
11 changed files with 235 additions and 167 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
racket/src/racket/gc2/gc2_dump.h
View File

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

174
racket/src/racket/gc2/newgc.c
View File

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

4
racket/src/racket/src/eval.c
View File

@ -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,8 +2503,6 @@ 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

9
racket/src/racket/src/hash.c
View File

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

7
racket/src/racket/src/list.c
View File

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

133
racket/src/racket/src/salloc.c
View File

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

17
racket/src/racket/src/schpriv.h
View File

@ -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 */
/*========================================================================*/

28
racket/src/racket/src/struct.c
View File

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

2
racket/src/racket/src/syntax.c
View File

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

18
racket/src/racket/src/type.c
View File

@ -328,7 +328,25 @@ scheme_init_type ()
set_name(scheme_environment_variables_type, "<environment-variables>");
#ifdef MZ_GC_BACKTRACE
set_name(scheme_rt_runstack, "<runstack>");
set_name(scheme_rt_meta_cont, "<meta-continuation>");
set_name(scheme_rt_weak_array, "<weak-array>");
set_name(scheme_syntax_property_preserve_type, "<syntax-property-preserve-wrapper>");
set_name(scheme_rt_resolve_info, "<compile-resolve-frame>");
set_name(scheme_rt_unresolve_info, "<compile-unresolve-frame>");
set_name(scheme_rt_optimize_info, "<compile-optimize-frame>");
set_name(scheme_rt_ir_lambda_info, "<compile-lambda-info>");
set_name(scheme_deferred_expr_type, "<compile-letrec-check-deferred>");
set_name(scheme_will_be_lambda_type, "<compile-letrec-check-lambda>");
set_name(scheme_rt_indexed_string, "<string-port-data>");
set_name(scheme_rt_srcloc, "<srcloc>");
set_name(scheme_rt_comp_prefix, "<compile-prefix>");
set_name(scheme_rt_native_code, "<native-code>");
set_name(scheme_rt_native_code_plus_case, "<native-code+case>");
set_name(scheme_rt_sfs_info, "<compile-safe-for-space-frame>");
set_name(scheme_rt_letrec_check_frame, "<compile-letrec-check-frame>");
set_name(scheme_rt_module_exports, "<module-export-set>");
set_name(scheme_rt_export_info, "<module-export-info>");
#endif
}

2
racket/src/racket/src/vector.c
View File

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