2 * (c)2006 Galois Connections, Inc.
20 /* This is the runtime support for the Haskell Program Coverage (hpc) toolkit,
25 static int hpc_inited = 0; // Have you started this component?
26 static pid_t hpc_pid = 0; // pid of this process at hpc-boot time.
27 // Only this pid will read or write .tix file(s).
28 static FILE *tixFile; // file being read/written
29 static int tix_ch; // current char
31 // This is a cruel hack, we should completely redesign the format specifier handling in the RTS.
33 #define PRIuWORD64 "lu"
35 #define PRIuWORD64 "llu"
38 HpcModuleInfo *modules = 0;
39 HpcModuleInfo *nextModule = 0;
40 int totalTixes = 0; // total number of tix boxes.
42 static char *tixFilename;
44 static void failure(char *msg) {
45 debugTrace(DEBUG_hpc,"hpc failure: %s\n",msg);
46 fprintf(stderr,"Hpc failure: %s\n",msg);
48 fprintf(stderr,"(perhaps remove %s file?)\n",tixFilename);
50 fprintf(stderr,"(perhaps remove .tix file?)\n");
55 static int init_open(FILE *file) {
60 tix_ch = getc(tixFile);
64 static void expect(char c) {
66 fprintf(stderr,"('%c' '%c')\n",tix_ch,c);
67 failure("parse error when reading .tix file");
69 tix_ch = getc(tixFile);
72 static void ws(void) {
73 while (tix_ch == ' ') {
74 tix_ch = getc(tixFile);
78 static char *expectString(void) {
82 while (tix_ch != '"') {
83 tmp[tmp_ix++] = tix_ch;
84 tix_ch = getc(tixFile);
93 static StgWord64 expectWord64(void) {
95 while (isdigit(tix_ch)) {
96 tmp = tmp * 10 + (tix_ch -'0');
97 tix_ch = getc(tixFile);
105 HpcModuleInfo *tmpModule;
117 while(tix_ch != ']') {
118 tmpModule = (HpcModuleInfo *)calloc(1,sizeof(HpcModuleInfo));
129 tmpModule -> modName = expectString();
131 tmpModule -> hashNo = (unsigned int)expectWord64();
133 tmpModule -> tickCount = (int)expectWord64();
134 tmpModule -> tixArr = (StgWord64 *)calloc(tmpModule->tickCount,sizeof(StgWord64));
135 tmpModule -> tickOffset = totalTixes;
136 totalTixes += tmpModule -> tickCount;
140 for(i = 0;i < tmpModule->tickCount;i++) {
141 tmpModule->tixArr[i] = expectWord64();
154 nextModule->next=tmpModule;
156 nextModule=tmpModule;
167 static void hpc_init(void) {
168 if (hpc_inited != 0) {
174 tixFilename = (char *) malloc(strlen(prog_name) + 6);
175 sprintf(tixFilename, "%s.tix", prog_name);
177 if (init_open(fopen(tixFilename,"r"))) {
182 /* Called on a per-module basis, at startup time, declaring where the tix boxes are stored in memory.
183 * This memory can be uninitized, because we will initialize it with either the contents
184 * of the tix file, or all zeros.
188 hs_hpc_module(char *modName,
192 HpcModuleInfo *tmpModule, *lastModule;
196 debugTrace(DEBUG_hpc,"hs_hpc_module(%s,%d)",modName,modCount);
203 for(;tmpModule != 0;tmpModule = tmpModule->next) {
204 if (!strcmp(tmpModule->modName,modName)) {
205 if (tmpModule->tickCount != modCount) {
206 failure("inconsistent number of tick boxes");
208 assert(tmpModule->tixArr != 0);
209 if (tmpModule->hashNo != modHashNo) {
210 fprintf(stderr,"in module '%s'\n",tmpModule->modName);
211 failure("module mismatch with .tix/.mix file hash number");
212 fprintf(stderr,"(perhaps remove %s ?)\n",tixFilename);
216 for(i=0;i < modCount;i++) {
217 tixArr[i] = tmpModule->tixArr[i];
219 tmpModule->tixArr = tixArr;
220 return tmpModule->tickOffset;
222 lastModule = tmpModule;
224 // Did not find entry so add one on.
225 tmpModule = (HpcModuleInfo *)calloc(1,sizeof(HpcModuleInfo));
226 tmpModule->modName = modName;
227 tmpModule->tickCount = modCount;
228 tmpModule->hashNo = modHashNo;
230 tmpModule->tickOffset = lastModule->tickOffset + lastModule->tickCount;
232 tmpModule->tickOffset = 0;
234 tmpModule->tixArr = tixArr;
235 for(i=0;i < modCount;i++) {
243 lastModule->next=tmpModule;
246 debugTrace(DEBUG_hpc,"end: hs_hpc_module");
252 /* This is called after all the modules have registered their local tixboxes,
253 * and does a sanity check: are we good to go?
258 debugTrace(DEBUG_hpc,"startupHpc");
260 if (hpc_inited == 0) {
268 HpcModuleInfo *tmpModule;
269 int i, inner_comma, outer_comma;
279 for(;tmpModule != 0;tmpModule = tmpModule->next) {
285 fprintf(f," TixModule \"%s\" %u %u [",
288 tmpModule->tickCount);
289 debugTrace(DEBUG_hpc,"%s: %u (offset=%u) (hash=%u)\n",
291 tmpModule->tickCount,
293 tmpModule->tickOffset);
296 for(i = 0;i < tmpModule->tickCount;i++) {
303 if (tmpModule->tixArr) {
304 fprintf(f,"%" PRIuWORD64,tmpModule->tixArr[i]);
316 /* Called at the end of execution, to write out the Hpc *.tix file
317 * for this exection. Safe to call, even if coverage is not used.
321 debugTrace(DEBUG_hpc,"exitHpc");
323 if (hpc_inited == 0) {
327 // Only write the tix file if you are the original process.
328 // Any sub-process from use of fork from inside Haskell will
329 // not clober the .tix file.
331 if (hpc_pid == getpid()) {
332 FILE *f = fopen(tixFilename,"w");
337 //////////////////////////////////////////////////////////////////////////////
338 // This is the API into Hpc RTS from Haskell, allowing the tixs boxes
339 // to be first class.
341 HpcModuleInfo *hs_hpc_rootModule(void) {