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

internal support for measuring allocation counts

Browse Source
This commit is contained in:
Matthew Flatt 2016-08-12 09:53:41 -06:00
parent b0ecafb731
commit db95651454
9 changed files with 145 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -2251,6 +2251,8 @@ 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
@ -2502,6 +2504,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

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

@ -246,6 +246,8 @@ 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;
@ -640,6 +642,8 @@ 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;
@ -723,6 +727,8 @@ 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;
@ -1119,6 +1125,8 @@ 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;
@ -2562,6 +2570,7 @@ 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));
}

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

@ -1049,6 +1049,7 @@ scheme_init_unsafe_hash (Scheme_Env *env)
Scheme_Object *scheme_make_pair(Scheme_Object *car, Scheme_Object *cdr)
{
DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_pair_type));
#ifdef MZ_PRECISE_GC
return GC_malloc_pair(car, cdr);
#else
@ -1793,6 +1794,8 @@ 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;
@ -3645,6 +3648,8 @@ static Scheme_Object *eqv_hash_code(int argc, Scheme_Object *argv[])
Scheme_Object *scheme_make_weak_box(Scheme_Object *v)
{
DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_weak_box_type));
#ifdef MZ_PRECISE_GC
return (Scheme_Object *)GC_malloc_weak_box(v, NULL, 0, 0);
#else

8
racket/src/racket/src/print.c
View File

@ -2808,9 +2808,13 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
cannot_print(pp, notdisplay, obj, ht, compact);
} else {
print_utf8_string(pp, "#<", 0, 2);
if (((Scheme_Struct_Type *)obj)->name) {
print_string_in_angle(pp, scheme_symbol_val(((Scheme_Struct_Type *)obj)->name),
"struct-type:",
SCHEME_SYM_LEN(((Scheme_Struct_Type *)obj)->name));
} else {
print_utf8_string(pp, "struct-type", 0, 11);
}
PRINTADDRESS(pp, obj);
print_utf8_string(pp, ">", 0, 1);
}
@ -2821,9 +2825,13 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
cannot_print(pp, notdisplay, obj, ht, compact);
} else {
print_utf8_string(pp, "#<", 0, 2);
if (((Scheme_Struct_Property *)obj)->name) {
print_string_in_angle(pp, scheme_symbol_val(((Scheme_Struct_Property *)obj)->name),
"struct-type-property:",
SCHEME_SYM_LEN(((Scheme_Struct_Property *)obj)->name));
} else {
print_utf8_string(pp, "struct-type-property", 0, 21);
}
PRINTADDRESS(pp, obj);
print_utf8_string(pp, ">", 0, 1);
}

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

@ -3288,3 +3288,92 @@ 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

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

@ -4414,6 +4414,18 @@ 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 */
/*========================================================================*/

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

@ -2543,6 +2543,8 @@ 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)
@ -2591,6 +2593,8 @@ 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)
@ -2625,6 +2629,8 @@ 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)
@ -2682,6 +2688,8 @@ 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)

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

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

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

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