X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FHpc.c;h=c4ff8d3be1e2d073c9b5d3b9788769208e3a5319;hb=ffd3bd85a6febeec05c99d0da7dfdf34cad59caf;hp=8411e614483f8097ac399e600bf78f8f23342cae;hpb=df58c2a53d37caf4f3b4d0b60a0466461bba7d19;p=ghc-hetmet.git diff --git a/rts/Hpc.c b/rts/Hpc.c index 8411e61..c4ff8d3 100644 --- a/rts/Hpc.c +++ b/rts/Hpc.c @@ -2,15 +2,25 @@ * (c)2006 Galois Connections, Inc. */ +#include "PosixSource.h" +#include "Rts.h" + +#include "Trace.h" +#include "Hash.h" +#include "RtsUtils.h" + #include #include -#include #include #include -#include "Rts.h" -#include "Hpc.h" -#include "Trace.h" +#ifdef HAVE_SYS_TYPES_H +#include +#endif + +#ifdef HAVE_SYS_STAT_H +#include +#endif #ifdef HAVE_UNISTD_H #include @@ -22,47 +32,20 @@ * */ -#define WOP_SIZE 1024 - static int hpc_inited = 0; // Have you started this component? +static pid_t hpc_pid = 0; // pid of this process at hpc-boot time. + // Only this pid will read or write .tix file(s). static FILE *tixFile; // file being read/written static int tix_ch; // current char -static FILE *rixFile = NULL; // The tracer file/pipe (to debugger) -static FILE *rixCmdFile = NULL; // The tracer file/pipe (from debugger) -static StgWord64 rixCounter = 0; // The global event counter -static int debuggee_pid; - -typedef enum { - RixThreadFinishedOp = -1, - RixRaiseOp = -2, - RixFinishedOp = -3 -} HpcRixOp; - - -typedef struct _Info { - char *modName; // name of module - int tickCount; // number of ticks - int tickOffset; // offset into a single large .tix Array - int hashNo; // Hash number for this module's mix info - StgWord64 *tixArr; // tix Array from the program execution (local for this module) - struct _Info *next; -} Info; - -// This is a cruel hack, we should completely redesign the format specifier handling in the RTS. -#if SIZEOF_LONG == 8 -#define PRIuWORD64 "lu" -#else -#define PRIuWORD64 "llu" -#endif +static HashTable * moduleHash = NULL; // module name -> HpcModuleInfo -Info *modules = 0; -Info *nextModule = 0; -int totalTixes = 0; // total number of tix boxes. +HpcModuleInfo *modules = 0; -static char *tixFilename; +static char *tixFilename = NULL; -static void failure(char *msg) { +static void GNU_ATTRIBUTE(__noreturn__) +failure(char *msg) { debugTrace(DEBUG_hpc,"hpc failure: %s\n",msg); fprintf(stderr,"Hpc failure: %s\n",msg); if (tixFilename) { @@ -70,7 +53,7 @@ static void failure(char *msg) { } else { fprintf(stderr,"(perhaps remove .tix file?)\n"); } - exit(-1); + stg_exit(1); } static int init_open(FILE *file) { @@ -97,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 != '"') { @@ -106,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; } @@ -122,11 +105,9 @@ static StgWord64 expectWord64(void) { static void readTix(void) { - int i; - Info *tmpModule; + unsigned int i; + HpcModuleInfo *tmpModule, *lookup; - totalTixes = 0; - ws(); expect('T'); expect('i'); @@ -136,7 +117,9 @@ readTix(void) { ws(); while(tix_ch != ']') { - tmpModule = (Info *)calloc(1,sizeof(Info)); + tmpModule = (HpcModuleInfo *)stgMallocBytes(sizeof(HpcModuleInfo), + "Hpc.readTix"); + tmpModule->from_file = rtsTrue; expect('T'); expect('i'); expect('x'); @@ -153,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(); @@ -169,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(); @@ -185,356 +185,136 @@ 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; } hpc_inited = 1; + hpc_pid = getpid(); + hpc_tixdir = getenv("HPCTIXDIR"); + hpc_tixfile = getenv("HPCTIXFILE"); - tixFilename = (char *) malloc(strlen(prog_name) + 6); - sprintf(tixFilename, "%s.tix", prog_name); - - if (init_open(fopen(tixFilename,"r"))) { - readTix(); - } -} - -/* 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. - */ - -int -hs_hpc_module(char *modName, - int modCount, - int modHashNo, - StgWord64 *tixArr) { - Info *tmpModule, *lastModule; - int i; - int offset = 0; - - debugTrace(DEBUG_hpc,"hs_hpc_module(%s,%d)",modName,modCount); - - hpc_init(); - - tmpModule = modules; - lastModule = 0; - - for(;tmpModule != 0;tmpModule = tmpModule->next) { - if (!strcmp(tmpModule->modName,modName)) { - if (tmpModule->tickCount != modCount) { - failure("inconsistent number of tick boxes"); - } - 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); - exit(-1); + debugTrace(DEBUG_hpc,"startupHpc"); - } - for(i=0;i < modCount;i++) { - tixArr[i] = tmpModule->tixArr[i]; - } - tmpModule->tixArr = tixArr; - return tmpModule->tickOffset; - } - lastModule = tmpModule; - } - // Did not find entry so add one on. - tmpModule = (Info *)calloc(1,sizeof(Info)); - tmpModule->modName = modName; - tmpModule->tickCount = modCount; - tmpModule->hashNo = modHashNo; - if (lastModule) { - tmpModule->tickOffset = lastModule->tickOffset + lastModule->tickCount; + /* XXX Check results of mallocs/strdups, and check we are requesting + enough bytes */ + if (hpc_tixfile != NULL) { + tixFilename = strdup(hpc_tixfile); + } else if (hpc_tixdir != NULL) { + /* Make sure the directory is present; + * conditional code for mkdir lifted from lndir.c + */ +#ifdef WIN32 + mkdir(hpc_tixdir); +#else + mkdir(hpc_tixdir,0777); +#endif + /* Then, try open the file + */ + 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 { - tmpModule->tickOffset = 0; - } - tmpModule->tixArr = tixArr; - for(i=0;i < modCount;i++) { - tixArr[i] = 0; + tixFilename = (char *) stgMallocBytes(strlen(prog_name) + 6, + "Hpc.startupHpc"); + sprintf(tixFilename, "%s.tix", prog_name); } - tmpModule->next = 0; - if (!modules) { - modules = tmpModule; - } else { - lastModule->next=tmpModule; + if (init_open(fopen(tixFilename,"r"))) { + readTix(); } - - debugTrace(DEBUG_hpc,"end: hs_hpc_module"); - - return offset; } -static void breakPointCommand(HpcRixOp rixOp, StgThreadID rixTid); - -// Breakpointing -static StgThreadID previousTid = 0; -static StgWord64 rixBPCounter = 0; // The global event breakpoint counter -static int *tixBoxBP; -static HpcRixOp rixOpBack[WOP_SIZE]; // The actual op -static HpcRixOp rixTidBack[WOP_SIZE]; // Tid's before the op - -void -hs_hpc_raise_event(StgTSO *current_tso) { - hs_hpc_tick(RixRaiseOp,current_tso); -} - -void -hs_hpc_thread_finished_event(StgTSO *current_tso) { - hs_hpc_tick(RixThreadFinishedOp,current_tso); -} - -/* Called on every tick, dynamically, sending to our - * external record of program execution. +/* + * 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. */ void -hs_hpc_tick(int rixOp, StgTSO *current_tso) { - - debugTrace(DEBUG_hpc,"hs_hpc_tick(%x)",rixOp); - - if (rixFile == NULL) { - return; - } - assert(rixCmdFile != NULL); - StgThreadID tid = (current_tso == 0) ? 0 : current_tso->id; - - // now check to see if we have met a breakpoint condition - if (rixCounter == rixBPCounter - || tid != previousTid) { - breakPointCommand(rixOp,tid); - } else { - if (rixOp >= 0) { - // Tix op - if (tixBoxBP[rixOp] == 1) { // reached a bp tixbox - breakPointCommand(rixOp,tid); - } - } else { - // record the special operation - breakPointCommand(rixOp,tid); - } - } - // update the history information. - previousTid = tid; - rixOpBack[rixCounter % WOP_SIZE] = rixOp; - rixTidBack[rixCounter % WOP_SIZE] = tid; - rixCounter++; - - debugTrace(DEBUG_hpc, "end: hs_hpc_tick"); -} - -static void -printEvent(FILE *out,StgWord64 rixCounter,StgThreadID rixTid,HpcRixOp rixOp) { - char prefixMsg[128]; - char suffixMsg[128]; - - sprintf(prefixMsg, - "Event %" PRIuWORD64 " %u ", - rixCounter, - (unsigned int)rixTid); - - switch(rixOp) { - case RixThreadFinishedOp: - sprintf(suffixMsg,"ThreadFinished"); - break; - case RixRaiseOp: - sprintf(suffixMsg,"Raise"); - break; - case RixFinishedOp: - sprintf(suffixMsg,"Finished"); - break; - default: - sprintf(suffixMsg,"%u",rixOp); +hs_hpc_module(char *modName, + StgWord32 modCount, + StgWord32 modHashNo, + StgWord64 *tixArr) +{ + HpcModuleInfo *tmpModule; + nat i; + + if (moduleHash == NULL) { + moduleHash = allocStrHashTable(); } - fprintf(out,"%s%s\n",prefixMsg,suffixMsg); - debugTrace(DEBUG_hpc,"sending %s%s",prefixMsg,suffixMsg); -} + 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; -static void -breakPointCommand(HpcRixOp rixOp, StgThreadID rixTid) { - StgWord64 tmp64 = 0; - unsigned int tmp = 0; - - if (getpid() != debuggee_pid) { - // We are not the original process, to do not issue - // any events, and do not try to talk to the debugger. - return; + 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); } - - debugTrace(DEBUG_hpc,"breakPointCommand %d %x",rixOp,(unsigned int)rixTid); - - printEvent(rixFile,rixCounter,rixTid,rixOp); - fflush(rixFile); - - /* From here, you can ask some basic questions. - * - * c set the (one) counter breakpoint - * s set the (many) tickbox breakpoint - * u unset the (many) tickbox breakpoint - * h history - - * Note that you aways end up here on the first tick - * because the rixBPCounter starts equal to 0. - */ - int c = getc(rixCmdFile); - while(c != 10 && c != -1) { - switch(c) { - case 'c': // c1234 -- set counter breakpoint at 1234 - c = getc(rixCmdFile); - tmp64 = 0; - while(isdigit(c)) { - tmp64 = tmp64 * 10 + (c - '0'); - c = getc(rixCmdFile); + else + { + if (tmpModule->tickCount != modCount) { + failure("inconsistent number of tick boxes"); } - debugTrace(DEBUG_hpc,"setting countBP = %" PRIuWORD64,tmp64); - - rixBPCounter = tmp64; - break; - case 's': // s2323 -- set tick box breakpoint at 2323 - c = getc(rixCmdFile); - tmp = 0; - while(isdigit(c)) { - tmp = tmp * 10 + (c - '0'); - c = getc(rixCmdFile); + 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"); + if (tixFilename != NULL) { + fprintf(stderr,"(perhaps remove %s ?)\n",tixFilename); + } + stg_exit(EXIT_FAILURE); } - - debugTrace(DEBUG_hpc,"seting bp for tix %d",tmp); - - tixBoxBP[tmp] = 1; - break; - case 'u': // u2323 -- unset tick box breakpoint at 2323 - c = getc(rixCmdFile); - tmp = 0; - while(isdigit(c)) { - tmp = tmp * 10 + (c - '0'); - c = getc(rixCmdFile); + // 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]; } - debugTrace(DEBUG_hpc,"unseting bp for tix %d",tmp); - - tixBoxBP[tmp] = 0; - break; - case 'h': // h -- history of the last few (WOP_SIZE) steps - if (rixCounter > WOP_SIZE) { - tmp64 = rixCounter - WOP_SIZE; - } else { - tmp64 = 0; - } - for(;tmp64 < rixCounter;tmp64++) { - printEvent(rixFile, - tmp64, - rixTidBack[tmp64 % WOP_SIZE], - rixOpBack[tmp64 % WOP_SIZE]); + if (tmpModule->from_file) { + stgFree(tmpModule->modName); + stgFree(tmpModule->tixArr); } - fflush(rixFile); - c = getc(rixCmdFile); - break; - default: - - debugTrace(DEBUG_hpc,"strange command from HPCRIX (%d)",c); - - c = getc(rixCmdFile); - } - while (c != 10) { // the end of the line - c = getc(rixCmdFile); // to the end of the line - } - c = getc(rixCmdFile); // the first char on the next command + tmpModule->from_file = rtsFalse; } - - debugTrace(DEBUG_hpc,"leaving breakPointCommand"); - } -/* 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) { - char *hpcRix; - - debugTrace(DEBUG_hpc,"startupHpc"); - - if (hpc_inited == 0) { - return; - } - // HPCRIX contains the name of the file to send our dynamic runtime output to (a named pipe). - - hpcRix = getenv("HPCRIX"); - if (hpcRix) { - int comma; - Info *tmpModule; - int rixFD, rixCmdFD; - int tixCount = 0; - - assert(hpc_inited); - - if (sscanf(hpcRix,"%d:%d",&rixFD,&rixCmdFD) != 2) { - /* Bad format for HPCRIX. - */ - debugTrace(DEBUG_hpc,"Bad HPCRIX (%s)",hpcRix); - exit(0); - } - - debugTrace(DEBUG_hpc,"found HPCRIX pipes: %d:%d",rixFD,rixCmdFD); - - rixFile = fdopen(rixFD,"w"); - assert(rixFile != NULL); - - rixCmdFile = fdopen(rixCmdFD,"r"); - assert(rixCmdFile != NULL); - - // If we fork a process, then we do not want ticks inside - // the sub-process to talk to the debugger. So we remember - // our pid at startup time, so we can check if we are still - // the original process. - - debuggee_pid = getpid(); - - comma = 0; - - fprintf(rixFile,"Starting %s\n",prog_name); - fprintf(rixFile,"["); - tmpModule = modules; - for(;tmpModule != 0;tmpModule = tmpModule->next) { - if (comma) { - fprintf(rixFile,","); - } else { - comma = 1; - } - fprintf(rixFile,"(\"%s\",%u)", - tmpModule->modName, - tmpModule->tickCount); - - tixCount += tmpModule->tickCount; - - debugTrace(DEBUG_hpc,"(tracer)%s: %u (offset=%u) (hash=%u)\n", - tmpModule->modName, - tmpModule->tickCount, - tmpModule->hashNo, - tmpModule->tickOffset); - - } - fprintf(rixFile,"]\n"); - fflush(rixFile); - - // Allocate the tixBox breakpoint array - // These are set to 1 if you want to - // stop at a specific breakpoint - tixBoxBP = (int *)calloc(tixCount,sizeof(int)); - } - -} - - static void writeTix(FILE *f) { - Info *tmpModule; - int i, inner_comma, outer_comma; + HpcModuleInfo *tmpModule; + unsigned int i, inner_comma, outer_comma; outer_comma = 0; @@ -552,13 +332,12 @@ writeTix(FILE *f) { } fprintf(f," TixModule \"%s\" %u %u [", tmpModule->modName, - tmpModule->hashNo, - tmpModule->tickCount); - debugTrace(DEBUG_hpc,"%s: %u (offset=%u) (hash=%u)\n", + (nat)tmpModule->hashNo, + (nat)tmpModule->tickCount); + debugTrace(DEBUG_hpc,"%s: %u (hash=%u)\n", tmpModule->modName, - tmpModule->tickCount, - tmpModule->hashNo, - tmpModule->tickOffset); + (nat)tmpModule->tickCount, + (nat)tmpModule->hashNo); inner_comma = 0; for(i = 0;i < tmpModule->tickCount;i++) { @@ -569,7 +348,7 @@ writeTix(FILE *f) { } if (tmpModule->tixArr) { - fprintf(f,"%" PRIuWORD64,tmpModule->tixArr[i]); + fprintf(f,"%" FMT_Word64,tmpModule->tixArr[i]); } else { fprintf(f,"0"); } @@ -581,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 @@ -592,53 +381,26 @@ exitHpc(void) { return; } - FILE *f = fopen(tixFilename,"w"); - writeTix(f); + // Only write the tix file if you are the original process. + // Any sub-process from use of fork from inside Haskell will + // not clober the .tix file. - if (rixFile != NULL) { - hs_hpc_tick(RixFinishedOp,(StgThreadID)0); - fclose(rixFile); - } - if (rixCmdFile != NULL) { - fclose(rixCmdFile); + if (hpc_pid == getpid()) { + FILE *f = fopen(tixFilename,"w"); + writeTix(f); } - -} -void hs_hpc_read(char *filename) { - Info *orig_modules = 0, *tmpModule, *tmpOrigModule; - int i; + freeHashTable(moduleHash, (void (*)(void *))freeHpcModuleInfo); + moduleHash = NULL; - orig_modules = modules; - modules = 0; - if (init_open(fopen(filename,"r"))) { - readTix(); - // Now we copy across the arrays. O(n^2), but works - for(tmpModule = modules; - tmpModule != 0; - tmpModule = tmpModule->next) { - - for(tmpOrigModule = orig_modules; - tmpOrigModule != 0; - tmpOrigModule = tmpOrigModule->next) { - if (!strcmp(tmpModule->modName,tmpOrigModule->modName)) { - assert(tmpModule->tixArr != 0); - assert(tmpOrigModule->tixArr != 0); - assert(tmpModule->tickCount == tmpOrigModule->tickCount); - for(i=0;i < tmpModule->tickCount;i++) { - tmpOrigModule->tixArr[i] = tmpModule->tixArr[i]; - } - tmpModule->tixArr = tmpOrigModule->tixArr; - break; - } - } - } - } -} - -void hs_hpc_write(char *filename) { - writeTix(fopen(filename,"w")); + stgFree(tixFilename); + tixFilename = NULL; } +////////////////////////////////////////////////////////////////////////////// +// This is the API into Hpc RTS from Haskell, allowing the tixs boxes +// to be first class. - +HpcModuleInfo *hs_hpc_rootModule(void) { + return modules; +}