X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=rts%2FHpc.c;h=c4ff8d3be1e2d073c9b5d3b9788769208e3a5319;hp=8e67ffcc8804cefc620e9c65e8b990fe17e34ee2;hb=cf5905ea24904cf73a041fd7535e8723a668cb9a;hpb=d5934bbb856aa0aa620c9b2e0fa51c90a1a5a048 diff --git a/rts/Hpc.c b/rts/Hpc.c index 8e67ffc..c4ff8d3 100644 --- a/rts/Hpc.c +++ b/rts/Hpc.c @@ -2,54 +2,62 @@ * (c)2006 Galois Connections, Inc. */ -// #include "HsFFI.h" +#include "PosixSource.h" +#include "Rts.h" + +#include "Trace.h" +#include "Hash.h" +#include "RtsUtils.h" #include #include -#include #include #include -#include "HsFFI.h" -#include "Hpc.h" + +#ifdef HAVE_SYS_TYPES_H +#include +#endif + +#ifdef HAVE_SYS_STAT_H +#include +#endif + +#ifdef HAVE_UNISTD_H +#include +#endif + /* This is the runtime support for the Haskell Program Coverage (hpc) toolkit, * inside GHC. * */ -#define DEBUG_HPC 0 +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 int hpc_inited = 0; // Have you started this component? -static FILE *tixFile; // file being read/written -static int tix_ch; // current char +static HashTable * moduleHash = NULL; // module name -> HpcModuleInfo -typedef struct _Info { - char *modName; // name of module - int tickCount; // number of ticks - int tickOffset; // offset into a single large .tix Array - StgWord64 *tixArr; // tix Array from the program execution (local for this module) - struct _Info *next; -} Info; +HpcModuleInfo *modules = 0; -Info *modules = 0; -Info *nextModule = 0; -StgWord64 *tixBoxes = 0; // local copy of tixBoxes array, from file. -int totalTixes = 0; // total number of tix boxes. +static char *tixFilename = NULL; - - -static char *tixFilename = "Main.tix"; - -static void failure(char *msg) { - printf("Hpc failure: %s\n",msg); - printf("(perhaps remove .tix file?)\n"); - exit(-1); +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) { + fprintf(stderr,"(perhaps remove %s file?)\n",tixFilename); + } else { + fprintf(stderr,"(perhaps remove .tix file?)\n"); + } + stg_exit(1); } - -static int init_open(char *filename) -{ - tixFile = fopen(filename,"r"); +static int init_open(FILE *file) { + tixFile = file; if (tixFile == 0) { return 0; } @@ -59,8 +67,8 @@ static int init_open(char *filename) static void expect(char c) { if (tix_ch != c) { - printf("Hpc: parse failed (%c,%c)\n",tix_ch,c); - exit(-1); + fprintf(stderr,"('%c' '%c')\n",tix_ch,c); + failure("parse error when reading .tix file"); } tix_ch = getc(tixFile); } @@ -72,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 != '"') { @@ -81,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; } @@ -95,230 +103,304 @@ static StgWord64 expectWord64(void) { return tmp; } -static void hpc_init(void) { - int i; - Info *tmpModule; - - if (hpc_inited != 0) { - return; - } - hpc_inited = 1; +static void +readTix(void) { + unsigned int i; + HpcModuleInfo *tmpModule, *lookup; + + ws(); + expect('T'); + expect('i'); + expect('x'); + ws(); + expect('['); + ws(); - if (init_open(tixFilename)) { - totalTixes = 0; - - ws(); + while(tix_ch != ']') { + tmpModule = (HpcModuleInfo *)stgMallocBytes(sizeof(HpcModuleInfo), + "Hpc.readTix"); + tmpModule->from_file = rtsTrue; expect('T'); expect('i'); expect('x'); + expect('M'); + expect('o'); + expect('d'); + expect('u'); + expect('l'); + expect('e'); + ws(); + tmpModule -> modName = expectString(); + ws(); + tmpModule -> hashNo = (unsigned int)expectWord64(); ws(); - expectWord64(); + tmpModule -> tickCount = (int)expectWord64(); + tmpModule -> tixArr = (StgWord64 *)calloc(tmpModule->tickCount,sizeof(StgWord64)); ws(); expect('['); ws(); - while(tix_ch != ']') { - tmpModule = (Info *)calloc(1,sizeof(Info)); - expect('('); - ws(); - tmpModule -> modName = expectString(); - ws(); - expect(','); - ws(); - tmpModule -> tickCount = (int)expectWord64(); - ws(); - expect(')'); + for(i = 0;i < tmpModule->tickCount;i++) { + tmpModule->tixArr[i] = expectWord64(); ws(); - - tmpModule -> tickOffset = totalTixes; - totalTixes += tmpModule -> tickCount; - - tmpModule -> tixArr = 0; - - if (!modules) { - modules = tmpModule; - } else { - nextModule->next=tmpModule; - } - nextModule=tmpModule; - if (tix_ch == ',') { expect(','); ws(); - }} - expect(']'); - ws(); - tixBoxes = (StgWord64 *)calloc(totalTixes,sizeof(StgWord64)); - - expect('['); - for(i = 0;i < totalTixes;i++) { - if (i != 0) { - expect(','); - ws(); } - tixBoxes[i] = expectWord64(); - ws(); } expect(']'); + ws(); + + 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 { + 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); + } - fclose(tixFile); + if (tix_ch == ',') { + expect(','); + ws(); + } } + expect(']'); + fclose(tixFile); } -/* 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. - */ - void -hs_hpc_module(char *modName,int modCount,StgWord64 *tixArr) { - Info *tmpModule, *lastModule; - int i; - -#if DEBUG_HPC - printf("hs_hpc_module(%s,%d)\n",modName,modCount); -#endif - - hpc_init(); +startupHpc(void) +{ + char *hpc_tixdir; + char *hpc_tixfile; - 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); - assert(tixBoxes != 0); - tmpModule->tixArr = tixArr; - for(i=0;i < modCount;i++) { - tixArr[i] = tixBoxes[i + tmpModule->tickOffset]; - } + if (moduleHash == NULL) { + // no modules were registered with hs_hpc_module, so don't bother + // creating the .tix file. return; - } - lastModule = tmpModule; } - // Did not find entry so add one on. - tmpModule = (Info *)calloc(1,sizeof(Info)); - tmpModule->modName = modName; - tmpModule->tickCount = modCount; - 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; + if (hpc_inited != 0) { + return; + } + hpc_inited = 1; + hpc_pid = getpid(); + 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) { + 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 { - lastModule->next=tmpModule; + tixFilename = (char *) stgMallocBytes(strlen(prog_name) + 6, + "Hpc.startupHpc"); + sprintf(tixFilename, "%s.tix", prog_name); } -#if DEBUG_HPC - printf("end: hs_hpc_module\n"); -#endif + if (init_open(fopen(tixFilename,"r"))) { + readTix(); + } } -/* This is called after all the modules have registered their local tixboxes, - * and does a sanity check: are we good to go? +/* + * 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 -startupHpc(void) { - Info *tmpModule; -#if DEBUG_HPC - printf("startupHpc\n"); -#endif - - if (hpc_inited == 0) { - return; +hs_hpc_module(char *modName, + StgWord32 modCount, + StgWord32 modHashNo, + StgWord64 *tixArr) +{ + HpcModuleInfo *tmpModule; + nat i; + + if (moduleHash == NULL) { + moduleHash = allocStrHashTable(); } - tmpModule = modules; + 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; - if (tixBoxes) { - for(;tmpModule != 0;tmpModule = tmpModule->next) { - if (!tmpModule->tixArr) { - fprintf(stderr,"error: module %s did not register any hpc tick data\n", - tmpModule->modName); - fprintf(stderr,"(perhaps remove %s ?)\n",tixFilename); - exit(-1); + 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"); + } + 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); + } + // 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]; + } + + if (tmpModule->from_file) { + stgFree(tmpModule->modName); + stgFree(tmpModule->tixArr); + } + tmpModule->from_file = rtsFalse; } } -/* 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 -exitHpc(void) { - Info *tmpModule; - int i, comma; +static void +writeTix(FILE *f) { + HpcModuleInfo *tmpModule; + unsigned int i, inner_comma, outer_comma; -#if DEBUG_HPC - printf("exitHpc\n"); -#endif + outer_comma = 0; - if (hpc_inited == 0) { + if (f == 0) { return; } - FILE *f = fopen(tixFilename,"w"); - - comma = 0; - - fprintf(f,"Tix 0 ["); + fprintf(f,"Tix ["); tmpModule = modules; for(;tmpModule != 0;tmpModule = tmpModule->next) { - if (comma) { + if (outer_comma) { fprintf(f,","); } else { - comma = 1; + outer_comma = 1; } - fprintf(f,"(\"%s\",%d)", + fprintf(f," TixModule \"%s\" %u %u [", tmpModule->modName, - tmpModule->tickCount); -#if DEBUG_HPC - fprintf(stderr,"%s: %d (offset=%d)\n", - tmpModule->modName, - tmpModule->tickCount, - tmpModule->tickOffset); -#endif - } - fprintf(f,"] ["); - - comma = 0; - tmpModule = modules; - for(;tmpModule != 0;tmpModule = tmpModule->next) { - if (!tmpModule->tixArr) { - fprintf(stderr,"warning: module %s did not register any hpc tick data\n", - tmpModule->modName); - } - + (nat)tmpModule->hashNo, + (nat)tmpModule->tickCount); + debugTrace(DEBUG_hpc,"%s: %u (hash=%u)\n", + tmpModule->modName, + (nat)tmpModule->tickCount, + (nat)tmpModule->hashNo); + + inner_comma = 0; for(i = 0;i < tmpModule->tickCount;i++) { - if (comma) { + if (inner_comma) { fprintf(f,","); } else { - comma = 1; + inner_comma = 1; } if (tmpModule->tixArr) { - fprintf(f,"%lld",tmpModule->tixArr[i]); + fprintf(f,"%" FMT_Word64,tmpModule->tixArr[i]); } else { fprintf(f,"0"); } - } + fprintf(f,"]"); } - fprintf(f,"]\n"); - fclose(f); + fclose(f); +} + +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 +exitHpc(void) { + debugTrace(DEBUG_hpc,"exitHpc"); + + if (hpc_inited == 0) { + return; + } + + // 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 (hpc_pid == getpid()) { + FILE *f = fopen(tixFilename,"w"); + writeTix(f); + } + + freeHashTable(moduleHash, (void (*)(void *))freeHpcModuleInfo); + moduleHash = NULL; + + 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; +}