X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FProfHeap.c;h=9cb47a19fdacf0b50dd12c070b95199301e8d536;hb=63179a7b10069d8f69f5bceef27008c9c7fb0aa8;hp=db9e41fa18a45c7c3d773e1046dab73953086a87;hpb=50935f16dd3b479416530a991d52ee2fa7bd62ef;p=ghc-hetmet.git diff --git a/rts/ProfHeap.c b/rts/ProfHeap.c index db9e41f..9cb47a1 100644 --- a/rts/ProfHeap.c +++ b/rts/ProfHeap.c @@ -146,7 +146,8 @@ static char *type_names[] = { "BLACKHOLE", "SE_BLACKHOLE", "SE_CAF_BLACKHOLE", - "MVAR", + "MVAR_CLEAN", + "MVAR_DIRTY", "ARR_WORDS", "MUT_ARR_PTRS_CLEAN", "MUT_ARR_PTRS_DIRTY", @@ -181,7 +182,7 @@ static char *type_names[] = { * the band to which this closure's heap space is attributed in the * heap profile. * ------------------------------------------------------------------------- */ -STATIC_INLINE void * +static void * closureIdentity( StgClosure *p ) { switch (RtsFlags.ProfFlags.doHeapProfile) { @@ -396,10 +397,25 @@ void freeProfiling1 (void) void initProfiling2 (void) { + char *prog; + + prog = stgMallocBytes(strlen(prog_name) + 1, "initProfiling2"); + strcpy(prog, prog_name); +#ifdef mingw32_HOST_OS + // on Windows, drop the .exe suffix if there is one + { + char *suff; + suff = strrchr(prog,'.'); + if (suff != NULL && !strcmp(suff,".exe")) { + *suff = '\0'; + } + } +#endif + if (RtsFlags.ProfFlags.doHeapProfile) { /* Initialise the log file name */ - hp_filename = stgMallocBytes(strlen(prog_name) + 6, "hpFileName"); - sprintf(hp_filename, "%s.hp", prog_name); + hp_filename = stgMallocBytes(strlen(prog) + 6, "hpFileName"); + sprintf(hp_filename, "%s.hp", prog); /* open the log file */ if ((hp_file = fopen(hp_filename, "w")) == NULL) { @@ -410,6 +426,8 @@ void initProfiling2 (void) } } + stgFree(prog); + initHeapProfiling(); } @@ -974,7 +992,8 @@ heapCensusChain( Census *census, bdescr *bd ) size = bco_sizeW((StgBCO *)p); break; - case MVAR: + case MVAR_CLEAN: + case MVAR_DIRTY: case WEAK: case STABLE_NAME: case MUT_VAR_CLEAN: @@ -1149,13 +1168,6 @@ heapCensus( void ) #endif // Traverse the heap, collecting the census info - - // First the small_alloc_list: we have to fix the free pointer at - // the end by calling tidyAllocatedLists() first. - tidyAllocateLists(); - heapCensusChain( census, small_alloc_list ); - - // Now traverse the heap in each generation/step. if (RtsFlags.GcFlags.generations == 1) { heapCensusChain( census, g0s0->blocks ); } else {