diff options
Diffstat (limited to 'rts')
| -rw-r--r-- | rts/Hpc.c | 218 | ||||
| -rw-r--r-- | rts/Main.c | 8 | ||||
| -rw-r--r-- | rts/ProfHeap.c | 2 | ||||
| -rw-r--r-- | rts/Profiling.c | 68 | ||||
| -rw-r--r-- | rts/Profiling.h | 2 | ||||
| -rw-r--r-- | rts/RtsMain.c | 16 | ||||
| -rw-r--r-- | rts/RtsMain.h | 2 | ||||
| -rw-r--r-- | rts/RtsStartup.c | 85 |
8 files changed, 182 insertions, 219 deletions
@@ -6,6 +6,8 @@ #include "Rts.h" #include "Trace.h" +#include "Hash.h" +#include "RtsUtils.h" #include <stdio.h> #include <ctype.h> @@ -36,11 +38,11 @@ static pid_t hpc_pid = 0; // pid of this process at hpc-boot time. static FILE *tixFile; // file being read/written static int tix_ch; // current char +static HashTable * moduleHash = NULL; // module name -> HpcModuleInfo + HpcModuleInfo *modules = 0; -HpcModuleInfo *nextModule = 0; -int totalTixes = 0; // total number of tix boxes. -static char *tixFilename; +static char *tixFilename = NULL; static void GNU_ATTRIBUTE(__noreturn__) failure(char *msg) { @@ -78,7 +80,7 @@ static void ws(void) { } static char *expectString(void) { - char tmp[256], *res; + char tmp[256], *res; // XXX int tmp_ix = 0; expect('"'); while (tix_ch != '"') { @@ -87,7 +89,7 @@ static char *expectString(void) { } tmp[tmp_ix++] = 0; expect('"'); - res = malloc(tmp_ix); + res = stgMallocBytes(tmp_ix,"Hpc.expectString"); strcpy(res,tmp); return res; } @@ -104,10 +106,8 @@ static StgWord64 expectWord64(void) { static void readTix(void) { unsigned int i; - HpcModuleInfo *tmpModule; + HpcModuleInfo *tmpModule, *lookup; - totalTixes = 0; - ws(); expect('T'); expect('i'); @@ -117,7 +117,9 @@ readTix(void) { ws(); while(tix_ch != ']') { - tmpModule = (HpcModuleInfo *)calloc(1,sizeof(HpcModuleInfo)); + tmpModule = (HpcModuleInfo *)stgMallocBytes(sizeof(HpcModuleInfo), + "Hpc.readTix"); + tmpModule->from_file = rtsTrue; expect('T'); expect('i'); expect('x'); @@ -134,8 +136,6 @@ readTix(void) { ws(); tmpModule -> tickCount = (int)expectWord64(); tmpModule -> tixArr = (StgWord64 *)calloc(tmpModule->tickCount,sizeof(StgWord64)); - tmpModule -> tickOffset = totalTixes; - totalTixes += tmpModule -> tickCount; ws(); expect('['); ws(); @@ -150,13 +150,32 @@ readTix(void) { expect(']'); ws(); - if (!modules) { - modules = tmpModule; + lookup = lookupHashTable(moduleHash, (StgWord)tmpModule->modName); + if (tmpModule == NULL) { + debugTrace(DEBUG_hpc,"readTix: new HpcModuleInfo for %s", + tmpModule->modName); + insertHashTable(moduleHash, (StgWord)tmpModule->modName, tmpModule); } else { - nextModule->next=tmpModule; + ASSERT(lookup->tixArr != 0); + ASSERT(!strcmp(tmpModule->modName, lookup->modName)); + debugTrace(DEBUG_hpc,"readTix: existing HpcModuleInfo for %s", + tmpModule->modName); + if (tmpModule->hashNo != lookup->hashNo) { + fprintf(stderr,"in module '%s'\n",tmpModule->modName); + failure("module mismatch with .tix/.mix file hash number"); + if (tixFilename != NULL) { + fprintf(stderr,"(perhaps remove %s ?)\n",tixFilename); + } + stg_exit(EXIT_FAILURE); + } + for (i=0; i < tmpModule->tickCount; i++) { + lookup->tixArr[i] = tmpModule->tixArr[i]; + } + stgFree(tmpModule->tixArr); + stgFree(tmpModule->modName); + stgFree(tmpModule); } - nextModule=tmpModule; - + if (tix_ch == ',') { expect(','); ws(); @@ -166,9 +185,18 @@ readTix(void) { fclose(tixFile); } -static void hpc_init(void) { +void +startupHpc(void) +{ char *hpc_tixdir; char *hpc_tixfile; + + if (moduleHash == NULL) { + // no modules were registered with hs_hpc_module, so don't bother + // creating the .tix file. + return; + } + if (hpc_inited != 0) { return; } @@ -177,6 +205,8 @@ static void hpc_init(void) { hpc_tixdir = getenv("HPCTIXDIR"); hpc_tixfile = getenv("HPCTIXFILE"); + debugTrace(DEBUG_hpc,"startupHpc"); + /* XXX Check results of mallocs/strdups, and check we are requesting enough bytes */ if (hpc_tixfile != NULL) { @@ -192,10 +222,13 @@ static void hpc_init(void) { #endif /* Then, try open the file */ - tixFilename = (char *) malloc(strlen(hpc_tixdir) + strlen(prog_name) + 12); + tixFilename = (char *) stgMallocBytes(strlen(hpc_tixdir) + + strlen(prog_name) + 12, + "Hpc.startupHpc"); sprintf(tixFilename,"%s/%s-%d.tix",hpc_tixdir,prog_name,(int)hpc_pid); } else { - tixFilename = (char *) malloc(strlen(prog_name) + 6); + tixFilename = (char *) stgMallocBytes(strlen(prog_name) + 6, + "Hpc.startupHpc"); sprintf(tixFilename, "%s.tix", prog_name); } @@ -204,90 +237,80 @@ static void hpc_init(void) { } } -/* Called on a per-module basis, at startup time, declaring where the tix boxes are stored in memory. - * This memory can be uninitized, because we will initialize it with either the contents - * of the tix file, or all zeros. +/* + * Called on a per-module basis, by a constructor function compiled + * with each module (see Coverage.hpcInitCode), declaring where the + * tix boxes are stored in memory. This memory can be uninitized, + * because we will initialize it with either the contents of the tix + * file, or all zeros. + * + * Note that we might call this before reading the .tix file, or after + * in the case where we loaded some Haskell code from a .so with + * dlopen(). So we must handle the case where we already have an + * HpcModuleInfo for the module which was read from the .tix file. */ -int +void hs_hpc_module(char *modName, StgWord32 modCount, StgWord32 modHashNo, - StgWord64 *tixArr) { - HpcModuleInfo *tmpModule, *lastModule; - unsigned int i; - int offset = 0; - - debugTrace(DEBUG_hpc,"hs_hpc_module(%s,%d)",modName,(nat)modCount); + StgWord64 *tixArr) +{ + HpcModuleInfo *tmpModule; + nat i; - hpc_init(); + if (moduleHash == NULL) { + moduleHash = allocStrHashTable(); + } - tmpModule = modules; - lastModule = 0; - - for(;tmpModule != 0;tmpModule = tmpModule->next) { - if (!strcmp(tmpModule->modName,modName)) { + tmpModule = lookupHashTable(moduleHash, (StgWord)modName); + if (tmpModule == NULL) + { + // Did not find entry so add one on. + tmpModule = (HpcModuleInfo *)stgMallocBytes(sizeof(HpcModuleInfo), + "Hpc.hs_hpc_module"); + tmpModule->modName = modName; + tmpModule->tickCount = modCount; + tmpModule->hashNo = modHashNo; + + tmpModule->tixArr = tixArr; + for(i=0;i < modCount;i++) { + tixArr[i] = 0; + } + tmpModule->next = modules; + tmpModule->from_file = rtsFalse; + modules = tmpModule; + insertHashTable(moduleHash, (StgWord)modName, tmpModule); + } + else + { if (tmpModule->tickCount != modCount) { - failure("inconsistent number of tick boxes"); + failure("inconsistent number of tick boxes"); } - assert(tmpModule->tixArr != 0); + ASSERT(tmpModule->tixArr != 0); if (tmpModule->hashNo != modHashNo) { - fprintf(stderr,"in module '%s'\n",tmpModule->modName); - failure("module mismatch with .tix/.mix file hash number"); - fprintf(stderr,"(perhaps remove %s ?)\n",tixFilename); - stg_exit(1); - + fprintf(stderr,"in module '%s'\n",tmpModule->modName); + failure("module mismatch with .tix/.mix file hash number"); + if (tixFilename != NULL) { + fprintf(stderr,"(perhaps remove %s ?)\n",tixFilename); + } + stg_exit(EXIT_FAILURE); } + // The existing tixArr was made up when we read the .tix file, + // whereas this is the real tixArr, so copy the data from the + // .tix into the real tixArr. for(i=0;i < modCount;i++) { - tixArr[i] = tmpModule->tixArr[i]; + tixArr[i] = tmpModule->tixArr[i]; } - tmpModule->tixArr = tixArr; - return tmpModule->tickOffset; - } - lastModule = tmpModule; - } - // Did not find entry so add one on. - tmpModule = (HpcModuleInfo *)calloc(1,sizeof(HpcModuleInfo)); - tmpModule->modName = modName; - tmpModule->tickCount = modCount; - tmpModule->hashNo = modHashNo; - if (lastModule) { - tmpModule->tickOffset = lastModule->tickOffset + lastModule->tickCount; - } else { - tmpModule->tickOffset = 0; - } - tmpModule->tixArr = tixArr; - for(i=0;i < modCount;i++) { - tixArr[i] = 0; - } - tmpModule->next = 0; - - if (!modules) { - modules = tmpModule; - } else { - lastModule->next=tmpModule; - } - - debugTrace(DEBUG_hpc,"end: hs_hpc_module"); - - return offset; -} - -/* This is called after all the modules have registered their local tixboxes, - * and does a sanity check: are we good to go? - */ - -void -startupHpc(void) { - debugTrace(DEBUG_hpc,"startupHpc"); - - if (hpc_inited == 0) { - return; + if (tmpModule->from_file) { + stgFree(tmpModule->modName); + stgFree(tmpModule->tixArr); + } + tmpModule->from_file = rtsFalse; } } - static void writeTix(FILE *f) { HpcModuleInfo *tmpModule; @@ -311,11 +334,10 @@ writeTix(FILE *f) { tmpModule->modName, (nat)tmpModule->hashNo, (nat)tmpModule->tickCount); - debugTrace(DEBUG_hpc,"%s: %u (offset=%u) (hash=%u)\n", + debugTrace(DEBUG_hpc,"%s: %u (hash=%u)\n", tmpModule->modName, (nat)tmpModule->tickCount, - (nat)tmpModule->hashNo, - (nat)tmpModule->tickOffset); + (nat)tmpModule->hashNo); inner_comma = 0; for(i = 0;i < tmpModule->tickCount;i++) { @@ -338,7 +360,17 @@ writeTix(FILE *f) { fclose(f); } -/* Called at the end of execution, to write out the Hpc *.tix file +static void +freeHpcModuleInfo (HpcModuleInfo *mod) +{ + if (mod->from_file) { + stgFree(mod->modName); + stgFree(mod->tixArr); + } + stgFree(mod); +} + +/* Called at the end of execution, to write out the Hpc *.tix file * for this exection. Safe to call, even if coverage is not used. */ void @@ -357,6 +389,12 @@ exitHpc(void) { FILE *f = fopen(tixFilename,"w"); writeTix(f); } + + freeHashTable(moduleHash, (void (*)(void *))freeHpcModuleInfo); + moduleHash = NULL; + + stgFree(tixFilename); + tixFilename = NULL; } ////////////////////////////////////////////////////////////////////////////// diff --git a/rts/Main.c b/rts/Main.c index c1b028ff1b..c7a559fc14 100644 --- a/rts/Main.c +++ b/rts/Main.c @@ -15,16 +15,10 @@ #include "Rts.h" #include "RtsMain.h" -/* The symbol for the Haskell Main module's init function. It is safe to refer - * to it here because this Main.o object file will only be linked in if we are - * linking a Haskell program that uses a Haskell Main.main function. - */ -extern void __stginit_ZCMain(void); - /* Similarly, we can refer to the ZCMain_main_closure here */ extern StgClosure ZCMain_main_closure; int main(int argc, char *argv[]) { - return hs_main(argc, argv, &__stginit_ZCMain, &ZCMain_main_closure); + return hs_main(argc, argv, &ZCMain_main_closure); } diff --git a/rts/ProfHeap.c b/rts/ProfHeap.c index 39b64d4c51..f7fbd321be 100644 --- a/rts/ProfHeap.c +++ b/rts/ProfHeap.c @@ -309,7 +309,7 @@ void initProfiling1 (void) { } -void freeProfiling1 (void) +void freeProfiling (void) { } diff --git a/rts/Profiling.c b/rts/Profiling.c index 1d8627c5b1..5648f31e00 100644 --- a/rts/Profiling.c +++ b/rts/Profiling.c @@ -34,9 +34,9 @@ Arena *prof_arena; * closure_cats */ -unsigned int CC_ID; -unsigned int CCS_ID; -unsigned int HP_ID; +unsigned int CC_ID = 1; +unsigned int CCS_ID = 1; +unsigned int HP_ID = 1; /* figures for the profiling report. */ @@ -58,8 +58,8 @@ CostCentreStack *CCCS; /* Linked lists to keep track of cc's and ccs's that haven't * been declared in the log file yet */ -CostCentre *CC_LIST; -CostCentreStack *CCS_LIST; +CostCentre *CC_LIST = NULL; +CostCentreStack *CCS_LIST = NULL; /* * Built-in cost centres and cost-centre stacks: @@ -152,41 +152,10 @@ initProfiling1 (void) /* for the benefit of allocate()... */ CCCS = CCS_SYSTEM; - - /* Initialize counters for IDs */ - CC_ID = 1; - CCS_ID = 1; - HP_ID = 1; - - /* Initialize Declaration lists to NULL */ - CC_LIST = NULL; - CCS_LIST = NULL; - - /* Register all the cost centres / stacks in the program - * CC_MAIN gets link = 0, all others have non-zero link. - */ - REGISTER_CC(CC_MAIN); - REGISTER_CC(CC_SYSTEM); - REGISTER_CC(CC_GC); - REGISTER_CC(CC_OVERHEAD); - REGISTER_CC(CC_SUBSUMED); - REGISTER_CC(CC_DONT_CARE); - REGISTER_CCS(CCS_MAIN); - REGISTER_CCS(CCS_SYSTEM); - REGISTER_CCS(CCS_GC); - REGISTER_CCS(CCS_OVERHEAD); - REGISTER_CCS(CCS_SUBSUMED); - REGISTER_CCS(CCS_DONT_CARE); - - CCCS = CCS_OVERHEAD; - - /* cost centres are registered by the per-module - * initialisation code now... - */ } void -freeProfiling1 (void) +freeProfiling (void) { arenaFree(prof_arena); } @@ -202,17 +171,36 @@ initProfiling2 (void) * information into it. */ initProfilingLogFile(); + /* Register all the cost centres / stacks in the program + * CC_MAIN gets link = 0, all others have non-zero link. + */ + REGISTER_CC(CC_MAIN); + REGISTER_CC(CC_SYSTEM); + REGISTER_CC(CC_GC); + REGISTER_CC(CC_OVERHEAD); + REGISTER_CC(CC_SUBSUMED); + REGISTER_CC(CC_DONT_CARE); + + REGISTER_CCS(CCS_SYSTEM); + REGISTER_CCS(CCS_GC); + REGISTER_CCS(CCS_OVERHEAD); + REGISTER_CCS(CCS_SUBSUMED); + REGISTER_CCS(CCS_DONT_CARE); + REGISTER_CCS(CCS_MAIN); + /* find all the "special" cost centre stacks, and make them children * of CCS_MAIN. */ - ASSERT(CCS_MAIN->prevStack == 0); + ASSERT(CCS_LIST == CCS_MAIN); + CCS_LIST = CCS_LIST->prevStack; + CCS_MAIN->prevStack = NULL; CCS_MAIN->root = CC_MAIN; ccsSetSelected(CCS_MAIN); DecCCS(CCS_MAIN); - for (ccs = CCS_LIST; ccs != CCS_MAIN; ) { + for (ccs = CCS_LIST; ccs != NULL; ) { next = ccs->prevStack; - ccs->prevStack = 0; + ccs->prevStack = NULL; ActualPush_(CCS_MAIN,ccs->cc,ccs); ccs->root = ccs->cc; ccs = next; diff --git a/rts/Profiling.h b/rts/Profiling.h index 3a4184fba6..e27ad4c5ed 100644 --- a/rts/Profiling.h +++ b/rts/Profiling.h @@ -14,9 +14,9 @@ #include "BeginPrivate.h" void initProfiling1 (void); -void freeProfiling1 (void); void initProfiling2 (void); void endProfiling (void); +void freeProfiling (void); extern FILE *prof_file; extern FILE *hp_file; diff --git a/rts/RtsMain.c b/rts/RtsMain.c index b6cf546aea..0ed6df494c 100644 --- a/rts/RtsMain.c +++ b/rts/RtsMain.c @@ -28,13 +28,10 @@ # include <windows.h> #endif -extern void __stginit_ZCMain(void); - /* Annoying global vars for passing parameters to real_main() below * This is to get around problem with Windows SEH, see hs_main(). */ static int progargc; static char **progargv; -static void (*progmain_init)(void); /* This will be __stginit_ZCMain */ static StgClosure *progmain_closure; /* This will be ZCMain_main_closure */ /* Hack: we assume that we're building a batch-mode system unless @@ -47,7 +44,7 @@ static void real_main(void) SchedulerStatus status; /* all GranSim/GUM init is done in startupHaskell; sets IAmMainThread! */ - startupHaskell(progargc,progargv,progmain_init); + startupHaskell(progargc,progargv,NULL); /* kick off the computation by creating the main thread with a pointer to mainIO_closure representing the computation of the overall program; @@ -95,18 +92,17 @@ static void real_main(void) * This gets called from a tiny main function which gets linked into each * compiled Haskell program that uses a Haskell main function. * - * We expect the caller to pass __stginit_ZCMain for main_init and - * ZCMain_main_closure for main_closure. The reason we cannot refer to - * these symbols directly is because we're inside the rts and we do not know - * for sure that we'll be using a Haskell main function. + * We expect the caller to pass ZCMain_main_closure for + * main_closure. The reason we cannot refer to this symbol directly + * is because we're inside the rts and we do not know for sure that + * we'll be using a Haskell main function. */ -int hs_main(int argc, char *argv[], void (*main_init)(void), StgClosure *main_closure) +int hs_main(int argc, char *argv[], StgClosure *main_closure) { /* We do this dance with argc and argv as otherwise the SEH exception stuff (the BEGIN/END CATCH below) on Windows gets confused */ progargc = argc; progargv = argv; - progmain_init = main_init; progmain_closure = main_closure; #if defined(mingw32_HOST_OS) diff --git a/rts/RtsMain.h b/rts/RtsMain.h index 4aabc56517..24e58199bb 100644 --- a/rts/RtsMain.h +++ b/rts/RtsMain.h @@ -13,6 +13,6 @@ * The entry point for Haskell programs that use a Haskell main function * -------------------------------------------------------------------------- */ -int hs_main(int argc, char *argv[], void (*main_init)(void), StgClosure *main_closure); +int hs_main(int argc, char *argv[], StgClosure *main_closure); #endif /* RTSMAIN_H */ diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c index b860667fe4..236d07a9e0 100644 --- a/rts/RtsStartup.c +++ b/rts/RtsStartup.c @@ -224,90 +224,37 @@ hs_init(int *argc, char **argv[]) x86_init_fpu(); #endif + startupHpc(); + + // This must be done after module initialisation. + // ToDo: make this work in the presence of multiple hs_add_root()s. + initProfiling2(); + + // ditto. +#if defined(THREADED_RTS) + ioManagerStart(); +#endif + /* Record initialization times */ stat_endInit(); } // Compatibility interface void -startupHaskell(int argc, char *argv[], void (*init_root)(void)) +startupHaskell(int argc, char *argv[], void (*init_root)(void) STG_UNUSED) { hs_init(&argc, &argv); - if(init_root) - hs_add_root(init_root); } /* ----------------------------------------------------------------------------- - Per-module initialisation - - This process traverses all the compiled modules in the program - starting with "Main", and performing per-module initialisation for - each one. - - So far, two things happen at initialisation time: - - - we register stable names for each foreign-exported function - in that module. This prevents foreign-exported entities, and - things they depend on, from being garbage collected. - - - we supply a unique integer to each statically declared cost - centre and cost centre stack in the program. - - The code generator inserts a small function "__stginit_<module>" in each - module and calls the registration functions in each of the modules it - imports. - - The init* functions are compiled in the same way as STG code, - i.e. without normal C call/return conventions. Hence we must use - StgRun to call this stuff. + hs_add_root: backwards compatibility. (see #3252) -------------------------------------------------------------------------- */ -/* The init functions use an explicit stack... - */ -#define INIT_STACK_BLOCKS 4 -static StgFunPtr *init_stack = NULL; - void -hs_add_root(void (*init_root)(void)) +hs_add_root(void (*init_root)(void) STG_UNUSED) { - bdescr *bd; - nat init_sp; - Capability *cap; - - cap = rts_lock(); - - if (hs_init_count <= 0) { - barf("hs_add_root() must be called after hs_init()"); - } - - /* The initialisation stack grows downward, with sp pointing - to the last occupied word */ - init_sp = INIT_STACK_BLOCKS*BLOCK_SIZE_W; - bd = allocGroup_lock(INIT_STACK_BLOCKS); - init_stack = (StgFunPtr *)bd->start; - init_stack[--init_sp] = (StgFunPtr)stg_init_finish; - if (init_root != NULL) { - init_stack[--init_sp] = (StgFunPtr)init_root; - } - - cap->r.rSp = (P_)(init_stack + init_sp); - StgRun((StgFunPtr)stg_init, &cap->r); - - freeGroup_lock(bd); - - startupHpc(); - - // This must be done after module initialisation. - // ToDo: make this work in the presence of multiple hs_add_root()s. - initProfiling2(); - - rts_unlock(cap); - - // ditto. -#if defined(THREADED_RTS) - ioManagerStart(); -#endif + /* nothing */ } /* ---------------------------------------------------------------------------- @@ -424,7 +371,7 @@ hs_exit_(rtsBool wait_foreign) #endif endProfiling(); - freeProfiling1(); + freeProfiling(); #ifdef PROFILING // Originally, this was in report_ccs_profiling(). Now, retainer |