Hi Everyone, I'm trying to add support for per-thread allocation accounting to aid in some performance debugging. I've already instrumented the GC and can retrieve the statistics via hacks I added to current-memory-use.
I'm running into trouble reverting current-memory-use and instead adding a primitive: (thread-memory-allocations thread [allocated #f]) In src/thread.c =========== static Scheme_Object *thread_memory_allocations(int argc, Scheme_Object *args[]); GLOBAL_PRIM_W_ARITY("thread-memory-allocations" , thread_memory_allocations , 1, 2, env); static Scheme_Object *thread_memory_allocations(int argc, Scheme_Object *args[]) { Scheme_Thread *thread = NULL; intptr_t retval = 0; if (!SCHEME_THREADP(args[0])) scheme_wrong_type("thread-memory-allocations", "thread", 0, argc, args); thread = (Scheme_Thread*) args[0]; if(argc == 1 || SCHEME_FALSEP(args[1])) { retval = thread->total_memory_requested; } else { retval = thread->total_memory_allocated; } return scheme_make_integer_value(retval); } In src/schinc.h =========== #define EXPECTED_PRIM_COUNT 1043 When I build I get: ... <snip> ... cd gc2; make all mkdir xsrc make xsrc/precomp.h env XFORM_PRECOMP=yes ../racketcgc -cqu ../../../racket/gc2/xform.rkt --setup . --cpp "gcc -E -I./.. -I../../../racket/gc2/../include -I/usr/local/lib/libffi-3.0.9/include -pthread -DMZ_NO_ICONV" --keep-lines -o xsrc/precomp.h ../../../racket/gc2/precomp.c current-load-extension: expects argument of type <procedure (arity 2)>; given #"([^:]*):(.*)" *** Signal 11 I've scanned through xform.rkt but I'm not able to track down the origin of that error. Any ideas? Thanks, Nick A full patch (based on tag v5.2.1) is attached if that helps.
diff --git a/src/racket/gc2/newgc.c b/src/racket/gc2/newgc.c index 7370cde..816cf16 100644 --- a/src/racket/gc2/newgc.c +++ b/src/racket/gc2/newgc.c @@ -968,6 +975,14 @@ static void *allocate_big(const size_t request_size_bytes, int type) else addr = malloc_pages(gc, realpagesize, APAGE_SIZE, MMU_ZEROED, MMU_BIG_MED, MMU_PROTECTABLE, &bpage->mmu_src_block); + { + Scheme_Thread *thread = scheme_get_current_thread(); + if(thread) { + thread->total_memory_requested += request_size_bytes; + thread->total_memory_allocated += realpagesize; + } + } + bpage->addr = addr; bpage->size = allocate_size; bpage->size_class = 2; @@ -1100,15 +1115,24 @@ static void *allocate_medium(const size_t request_size_bytes, const int type) { NewGC *gc = GC_get_GC(); + Scheme_Thread *thread = scheme_get_current_thread(); void *objptr; gc_if_needed_account_alloc_size(gc, sz); + if(thread) { + thread->total_memory_requested += request_size_bytes; + } + objptr = medium_page_realloc_dead_slot(gc, sz, pos, type); if (!objptr) { mpage *page; objhead *info; + if(thread) { + thread->total_memory_allocated += sz; + } + page = create_new_medium_page(gc, sz, pos); info = (objhead *)PTR(NUM(page->addr) + MED_NEXT_SEARCH_SLOT(page)); @@ -1303,6 +1327,14 @@ inline static void *allocate(const size_t request_size, const int type) newptr = allocate_slowpath(gc, allocate_size, newptr); } + { + Scheme_Thread *thread = scheme_get_current_thread(); + if(thread) { + thread->total_memory_requested += request_size; + thread->total_memory_allocated += allocate_size; + } + } + /* actual Allocation */ { objhead *info = (objhead *)PTR(GC_gen0_alloc_page_ptr); @@ -1350,6 +1382,14 @@ inline static void *fast_malloc_one_small_tagged(size_t request_size, int dirty) info->size = BYTES_MULTIPLE_OF_WORD_TO_WORDS(allocate_size); /* ALIGN_BYTES_SIZE bumbed us up to the next word boundary */ { + Scheme_Thread *thread = scheme_get_current_thread(); + if(thread) { + thread->total_memory_requested += request_size; + thread->total_memory_allocated += allocate_size; + } + } + + { void * objptr = OBJHEAD_TO_OBJPTR(info); ASSERT_VALID_OBJPTR(objptr); return objptr; diff --git a/src/racket/include/scheme.h b/src/racket/include/scheme.h index e90062c..c57bccc 100644 --- a/src/racket/include/scheme.h +++ b/src/racket/include/scheme.h @@ -1130,6 +1130,8 @@ typedef struct Scheme_Thread { intptr_t accum_process_msec; intptr_t current_start_process_msec; + intptr_t total_memory_allocated; + intptr_t total_memory_requested; struct Scheme_Thread_Custodian_Hop *mr_hop; Scheme_Custodian_Reference *mref; diff --git a/src/racket/src/schminc.h b/src/racket/src/schminc.h index 4d377b1..1ed428b 100644 --- a/src/racket/src/schminc.h +++ b/src/racket/src/schminc.h @@ -13,7 +13,7 @@ #define USE_COMPILED_STARTUP 1 -#define EXPECTED_PRIM_COUNT 1042 +#define EXPECTED_PRIM_COUNT 1043 #define EXPECTED_UNSAFE_COUNT 78 #define EXPECTED_FLFXNUM_COUNT 68 #define EXPECTED_FUTURES_COUNT 11 diff --git a/src/racket/src/thread.c b/src/racket/src/thread.c index 78a919c..ca74dab 100644 --- a/src/racket/src/thread.c +++ b/src/racket/src/thread.c @@ -321,6 +321,7 @@ static Scheme_Object *union_tracking_val(int argc, Scheme_Object *args[]); static Scheme_Object *collect_garbage(int argc, Scheme_Object *args[]); static Scheme_Object *current_memory_use(int argc, Scheme_Object *args[]); +static Scheme_Object *thread_memory_allocations(int argc, Scheme_Object *args[]); static Scheme_Object *sch_thread(int argc, Scheme_Object *args[]); static Scheme_Object *sch_thread_nokill(int argc, Scheme_Object *args[]); @@ -558,8 +559,9 @@ void scheme_init_thread(Scheme_Env *env) scheme_add_evt_through_sema(scheme_will_executor_type, will_executor_sema, NULL); - GLOBAL_PRIM_W_ARITY("collect-garbage" , collect_garbage , 0, 0, env); - GLOBAL_PRIM_W_ARITY("current-memory-use" , current_memory_use , 0, 1, env); + GLOBAL_PRIM_W_ARITY("collect-garbage" , collect_garbage , 0, 0, env); + GLOBAL_PRIM_W_ARITY("current-memory-use" , current_memory_use , 0, 1, env); + GLOBAL_PRIM_W_ARITY("thread-memory-allocations" , thread_memory_allocations , 1, 2, env); GLOBAL_PRIM_W_ARITY("custodian-require-memory" , custodian_require_mem, 3, 3, env); GLOBAL_PRIM_W_ARITY("custodian-limit-memory" , custodian_limit_mem , 2, 3, env); @@ -698,6 +700,24 @@ static Scheme_Object *current_memory_use(int argc, Scheme_Object *args[]) return scheme_make_integer_value(retval); } +static Scheme_Object *thread_memory_allocations(int argc, Scheme_Object *args[]) +{ + Scheme_Thread *thread = NULL; + intptr_t retval = 0; + + if (!SCHEME_THREADP(args[0])) + scheme_wrong_type("thread-memory-allocations", "thread", 0, argc, args); + + thread = (Scheme_Thread*) args[0]; + if(argc == 1 || SCHEME_FALSEP(args[1])) { + retval = thread->total_memory_requested; + } else { + retval = thread->total_memory_allocated; + } + + return scheme_make_integer_value(retval); +} + /*========================================================================*/ /* custodians */ @@ -2219,7 +2239,8 @@ static Scheme_Thread *make_thread(Scheme_Config *config, process->mref = NULL; process->extra_mrefs = NULL; - + process->total_memory_allocated = 0; + process->total_memory_requested = 0; /* A thread points to a lot of stuff, so it's bad to put a finalization on it, which is what registering with a custodian does. Instead, we
_________________________ Racket Developers list: http://lists.racket-lang.org/dev