Adding new ffi calls into the Hpc rts subsystem
[ghc.git] / rts / Hpc.c
1 /*
2 * (c)2006 Galois Connections, Inc.
3 */
4
5 #include <stdio.h>
6 #include <ctype.h>
7 #include <stdlib.h>
8 #include <string.h>
9 #include <assert.h>
10
11 #include "Rts.h"
12 #include "Hpc.h"
13 #include "Trace.h"
14
15 #ifdef HAVE_UNISTD_H
16 #include <unistd.h>
17 #endif
18
19
20 /* This is the runtime support for the Haskell Program Coverage (hpc) toolkit,
21 * inside GHC.
22 *
23 */
24
25 #define WOP_SIZE 1024
26
27 static int hpc_inited = 0; // Have you started this component?
28 static FILE *tixFile; // file being read/written
29 static int tix_ch; // current char
30
31 static FILE *rixFile = NULL; // The tracer file/pipe (to debugger)
32 static FILE *rixCmdFile = NULL; // The tracer file/pipe (from debugger)
33 static StgWord64 rixCounter = 0; // The global event counter
34 static int debuggee_pid;
35
36 typedef enum {
37 RixThreadFinishedOp = -1,
38 RixRaiseOp = -2,
39 RixFinishedOp = -3
40 } HpcRixOp;
41
42
43 typedef struct _Info {
44 char *modName; // name of module
45 int tickCount; // number of ticks
46 int tickOffset; // offset into a single large .tix Array
47 int hashNo; // Hash number for this module's mix info
48 StgWord64 *tixArr; // tix Array from the program execution (local for this module)
49 struct _Info *next;
50 } Info;
51
52 // This is a cruel hack, we should completely redesign the format specifier handling in the RTS.
53 #if SIZEOF_LONG == 8
54 #define PRIuWORD64 "lu"
55 #else
56 #define PRIuWORD64 "llu"
57 #endif
58
59 Info *modules = 0;
60 Info *nextModule = 0;
61 int totalTixes = 0; // total number of tix boxes.
62
63 static char *tixFilename;
64
65 static void failure(char *msg) {
66 debugTrace(DEBUG_hpc,"hpc failure: %s\n",msg);
67 fprintf(stderr,"Hpc failure: %s\n",msg);
68 if (tixFilename) {
69 fprintf(stderr,"(perhaps remove %s file?)\n",tixFilename);
70 } else {
71 fprintf(stderr,"(perhaps remove .tix file?)\n");
72 }
73 exit(-1);
74 }
75
76 static int init_open(FILE *file) {
77 tixFile = file;
78 if (tixFile == 0) {
79 return 0;
80 }
81 tix_ch = getc(tixFile);
82 return 1;
83 }
84
85 static void expect(char c) {
86 if (tix_ch != c) {
87 fprintf(stderr,"('%c' '%c')\n",tix_ch,c);
88 failure("parse error when reading .tix file");
89 }
90 tix_ch = getc(tixFile);
91 }
92
93 static void ws(void) {
94 while (tix_ch == ' ') {
95 tix_ch = getc(tixFile);
96 }
97 }
98
99 static char *expectString(void) {
100 char tmp[256], *res;
101 int tmp_ix = 0;
102 expect('"');
103 while (tix_ch != '"') {
104 tmp[tmp_ix++] = tix_ch;
105 tix_ch = getc(tixFile);
106 }
107 tmp[tmp_ix++] = 0;
108 expect('"');
109 res = malloc(tmp_ix);
110 strcpy(res,tmp);
111 return res;
112 }
113
114 static StgWord64 expectWord64(void) {
115 StgWord64 tmp = 0;
116 while (isdigit(tix_ch)) {
117 tmp = tmp * 10 + (tix_ch -'0');
118 tix_ch = getc(tixFile);
119 }
120 return tmp;
121 }
122
123 static void
124 readTix(void) {
125 int i;
126 Info *tmpModule;
127
128 totalTixes = 0;
129
130 ws();
131 expect('T');
132 expect('i');
133 expect('x');
134 ws();
135 expect('[');
136 ws();
137
138 while(tix_ch != ']') {
139 tmpModule = (Info *)calloc(1,sizeof(Info));
140 expect('T');
141 expect('i');
142 expect('x');
143 expect('M');
144 expect('o');
145 expect('d');
146 expect('u');
147 expect('l');
148 expect('e');
149 ws();
150 tmpModule -> modName = expectString();
151 ws();
152 tmpModule -> hashNo = (unsigned int)expectWord64();
153 ws();
154 tmpModule -> tickCount = (int)expectWord64();
155 tmpModule -> tixArr = (StgWord64 *)calloc(tmpModule->tickCount,sizeof(StgWord64));
156 tmpModule -> tickOffset = totalTixes;
157 totalTixes += tmpModule -> tickCount;
158 ws();
159 expect('[');
160 ws();
161 for(i = 0;i < tmpModule->tickCount;i++) {
162 tmpModule->tixArr[i] = expectWord64();
163 ws();
164 if (tix_ch == ',') {
165 expect(',');
166 ws();
167 }
168 }
169 expect(']');
170 ws();
171
172 if (!modules) {
173 modules = tmpModule;
174 } else {
175 nextModule->next=tmpModule;
176 }
177 nextModule=tmpModule;
178
179 if (tix_ch == ',') {
180 expect(',');
181 ws();
182 }
183 }
184 expect(']');
185 fclose(tixFile);
186 }
187
188 static void hpc_init(void) {
189 if (hpc_inited != 0) {
190 return;
191 }
192 hpc_inited = 1;
193
194 tixFilename = (char *) malloc(strlen(prog_name) + 6);
195 sprintf(tixFilename, "%s.tix", prog_name);
196
197 if (init_open(fopen(tixFilename,"r"))) {
198 readTix();
199 }
200 }
201
202 /* Called on a per-module basis, at startup time, declaring where the tix boxes are stored in memory.
203 * This memory can be uninitized, because we will initialize it with either the contents
204 * of the tix file, or all zeros.
205 */
206
207 int
208 hs_hpc_module(char *modName,
209 int modCount,
210 int modHashNo,
211 StgWord64 *tixArr) {
212 Info *tmpModule, *lastModule;
213 int i;
214 int offset = 0;
215
216 debugTrace(DEBUG_hpc,"hs_hpc_module(%s,%d)",modName,modCount);
217
218 hpc_init();
219
220 tmpModule = modules;
221 lastModule = 0;
222
223 for(;tmpModule != 0;tmpModule = tmpModule->next) {
224 if (!strcmp(tmpModule->modName,modName)) {
225 if (tmpModule->tickCount != modCount) {
226 failure("inconsistent number of tick boxes");
227 }
228 assert(tmpModule->tixArr != 0);
229 if (tmpModule->hashNo != modHashNo) {
230 fprintf(stderr,"in module '%s'\n",tmpModule->modName);
231 failure("module mismatch with .tix/.mix file hash number");
232 fprintf(stderr,"(perhaps remove %s ?)\n",tixFilename);
233 exit(-1);
234
235 }
236 for(i=0;i < modCount;i++) {
237 tixArr[i] = tmpModule->tixArr[i];
238 }
239 tmpModule->tixArr = tixArr;
240 return tmpModule->tickOffset;
241 }
242 lastModule = tmpModule;
243 }
244 // Did not find entry so add one on.
245 tmpModule = (Info *)calloc(1,sizeof(Info));
246 tmpModule->modName = modName;
247 tmpModule->tickCount = modCount;
248 tmpModule->hashNo = modHashNo;
249 if (lastModule) {
250 tmpModule->tickOffset = lastModule->tickOffset + lastModule->tickCount;
251 } else {
252 tmpModule->tickOffset = 0;
253 }
254 tmpModule->tixArr = tixArr;
255 for(i=0;i < modCount;i++) {
256 tixArr[i] = 0;
257 }
258 tmpModule->next = 0;
259
260 if (!modules) {
261 modules = tmpModule;
262 } else {
263 lastModule->next=tmpModule;
264 }
265
266 debugTrace(DEBUG_hpc,"end: hs_hpc_module");
267
268 return offset;
269 }
270
271 static void breakPointCommand(HpcRixOp rixOp, StgThreadID rixTid);
272
273 // Breakpointing
274 static StgThreadID previousTid = 0;
275 static StgWord64 rixBPCounter = 0; // The global event breakpoint counter
276 static int *tixBoxBP;
277 static HpcRixOp rixOpBack[WOP_SIZE]; // The actual op
278 static HpcRixOp rixTidBack[WOP_SIZE]; // Tid's before the op
279
280 void
281 hs_hpc_raise_event(StgTSO *current_tso) {
282 hs_hpc_tick(RixRaiseOp,current_tso);
283 }
284
285 void
286 hs_hpc_thread_finished_event(StgTSO *current_tso) {
287 hs_hpc_tick(RixThreadFinishedOp,current_tso);
288 }
289
290 /* Called on every tick, dynamically, sending to our
291 * external record of program execution.
292 */
293
294 void
295 hs_hpc_tick(int rixOp, StgTSO *current_tso) {
296
297 debugTrace(DEBUG_hpc,"hs_hpc_tick(%x)",rixOp);
298
299 if (rixFile == NULL) {
300 return;
301 }
302 assert(rixCmdFile != NULL);
303 StgThreadID tid = (current_tso == 0) ? 0 : current_tso->id;
304
305 // now check to see if we have met a breakpoint condition
306 if (rixCounter == rixBPCounter
307 || tid != previousTid) {
308 breakPointCommand(rixOp,tid);
309 } else {
310 if (rixOp >= 0) {
311 // Tix op
312 if (tixBoxBP[rixOp] == 1) { // reached a bp tixbox
313 breakPointCommand(rixOp,tid);
314 }
315 } else {
316 // record the special operation
317 breakPointCommand(rixOp,tid);
318 }
319 }
320 // update the history information.
321 previousTid = tid;
322 rixOpBack[rixCounter % WOP_SIZE] = rixOp;
323 rixTidBack[rixCounter % WOP_SIZE] = tid;
324 rixCounter++;
325
326 debugTrace(DEBUG_hpc, "end: hs_hpc_tick");
327 }
328
329 static void
330 printEvent(FILE *out,StgWord64 rixCounter,StgThreadID rixTid,HpcRixOp rixOp) {
331 char prefixMsg[128];
332 char suffixMsg[128];
333
334 sprintf(prefixMsg,
335 "Event %" PRIuWORD64 " %u ",
336 rixCounter,
337 (unsigned int)rixTid);
338
339 switch(rixOp) {
340 case RixThreadFinishedOp:
341 sprintf(suffixMsg,"ThreadFinished");
342 break;
343 case RixRaiseOp:
344 sprintf(suffixMsg,"Raise");
345 break;
346 case RixFinishedOp:
347 sprintf(suffixMsg,"Finished");
348 break;
349 default:
350 sprintf(suffixMsg,"%u",rixOp);
351 }
352
353 fprintf(out,"%s%s\n",prefixMsg,suffixMsg);
354 debugTrace(DEBUG_hpc,"sending %s%s",prefixMsg,suffixMsg);
355 }
356
357 static void
358 breakPointCommand(HpcRixOp rixOp, StgThreadID rixTid) {
359 StgWord64 tmp64 = 0;
360 unsigned int tmp = 0;
361
362 if (getpid() != debuggee_pid) {
363 // We are not the original process, to do not issue
364 // any events, and do not try to talk to the debugger.
365 return;
366 }
367
368 debugTrace(DEBUG_hpc,"breakPointCommand %d %x",rixOp,(unsigned int)rixTid);
369
370 printEvent(rixFile,rixCounter,rixTid,rixOp);
371 fflush(rixFile);
372
373 /* From here, you can ask some basic questions.
374 *
375 * c<nat> set the (one) counter breakpoint
376 * s<nat> set the (many) tickbox breakpoint
377 * u<nat> unset the (many) tickbox breakpoint
378 * h history
379
380 * Note that you aways end up here on the first tick
381 * because the rixBPCounter starts equal to 0.
382 */
383 int c = getc(rixCmdFile);
384 while(c != 10 && c != -1) {
385 switch(c) {
386 case 'c': // c1234 -- set counter breakpoint at 1234
387 c = getc(rixCmdFile);
388 tmp64 = 0;
389 while(isdigit(c)) {
390 tmp64 = tmp64 * 10 + (c - '0');
391 c = getc(rixCmdFile);
392 }
393 debugTrace(DEBUG_hpc,"setting countBP = %" PRIuWORD64,tmp64);
394
395 rixBPCounter = tmp64;
396 break;
397 case 's': // s2323 -- set tick box breakpoint at 2323
398 c = getc(rixCmdFile);
399 tmp = 0;
400 while(isdigit(c)) {
401 tmp = tmp * 10 + (c - '0');
402 c = getc(rixCmdFile);
403 }
404
405 debugTrace(DEBUG_hpc,"seting bp for tix %d",tmp);
406
407 tixBoxBP[tmp] = 1;
408 break;
409 case 'u': // u2323 -- unset tick box breakpoint at 2323
410 c = getc(rixCmdFile);
411 tmp = 0;
412 while(isdigit(c)) {
413 tmp = tmp * 10 + (c - '0');
414 c = getc(rixCmdFile);
415 }
416
417 debugTrace(DEBUG_hpc,"unseting bp for tix %d",tmp);
418
419 tixBoxBP[tmp] = 0;
420 break;
421 case 'h': // h -- history of the last few (WOP_SIZE) steps
422 if (rixCounter > WOP_SIZE) {
423 tmp64 = rixCounter - WOP_SIZE;
424 } else {
425 tmp64 = 0;
426 }
427 for(;tmp64 < rixCounter;tmp64++) {
428 printEvent(rixFile,
429 tmp64,
430 rixTidBack[tmp64 % WOP_SIZE],
431 rixOpBack[tmp64 % WOP_SIZE]);
432 }
433 fflush(rixFile);
434 c = getc(rixCmdFile);
435 break;
436 default:
437
438 debugTrace(DEBUG_hpc,"strange command from HPCRIX (%d)",c);
439
440 c = getc(rixCmdFile);
441 }
442 while (c != 10) { // the end of the line
443 c = getc(rixCmdFile); // to the end of the line
444 }
445 c = getc(rixCmdFile); // the first char on the next command
446 }
447
448 debugTrace(DEBUG_hpc,"leaving breakPointCommand");
449
450 }
451
452 /* This is called after all the modules have registered their local tixboxes,
453 * and does a sanity check: are we good to go?
454 */
455
456 void
457 startupHpc(void) {
458 char *hpcRix;
459
460 debugTrace(DEBUG_hpc,"startupHpc");
461
462 if (hpc_inited == 0) {
463 return;
464 }
465 // HPCRIX contains the name of the file to send our dynamic runtime output to (a named pipe).
466
467 hpcRix = getenv("HPCRIX");
468 if (hpcRix) {
469 int comma;
470 Info *tmpModule;
471 int rixFD, rixCmdFD;
472 int tixCount = 0;
473
474 assert(hpc_inited);
475
476 if (sscanf(hpcRix,"%d:%d",&rixFD,&rixCmdFD) != 2) {
477 /* Bad format for HPCRIX.
478 */
479 debugTrace(DEBUG_hpc,"Bad HPCRIX (%s)",hpcRix);
480 exit(0);
481 }
482
483 debugTrace(DEBUG_hpc,"found HPCRIX pipes: %d:%d",rixFD,rixCmdFD);
484
485 rixFile = fdopen(rixFD,"w");
486 assert(rixFile != NULL);
487
488 rixCmdFile = fdopen(rixCmdFD,"r");
489 assert(rixCmdFile != NULL);
490
491 // If we fork a process, then we do not want ticks inside
492 // the sub-process to talk to the debugger. So we remember
493 // our pid at startup time, so we can check if we are still
494 // the original process.
495
496 debuggee_pid = getpid();
497
498 comma = 0;
499
500 fprintf(rixFile,"Starting %s\n",prog_name);
501 fprintf(rixFile,"[");
502 tmpModule = modules;
503 for(;tmpModule != 0;tmpModule = tmpModule->next) {
504 if (comma) {
505 fprintf(rixFile,",");
506 } else {
507 comma = 1;
508 }
509 fprintf(rixFile,"(\"%s\",%u)",
510 tmpModule->modName,
511 tmpModule->tickCount);
512
513 tixCount += tmpModule->tickCount;
514
515 debugTrace(DEBUG_hpc,"(tracer)%s: %u (offset=%u) (hash=%u)\n",
516 tmpModule->modName,
517 tmpModule->tickCount,
518 tmpModule->hashNo,
519 tmpModule->tickOffset);
520
521 }
522 fprintf(rixFile,"]\n");
523 fflush(rixFile);
524
525 // Allocate the tixBox breakpoint array
526 // These are set to 1 if you want to
527 // stop at a specific breakpoint
528 tixBoxBP = (int *)calloc(tixCount,sizeof(int));
529 }
530
531 }
532
533
534 static void
535 writeTix(FILE *f) {
536 Info *tmpModule;
537 int i, inner_comma, outer_comma;
538
539 outer_comma = 0;
540
541 if (f == 0) {
542 return;
543 }
544
545 fprintf(f,"Tix [");
546 tmpModule = modules;
547 for(;tmpModule != 0;tmpModule = tmpModule->next) {
548 if (outer_comma) {
549 fprintf(f,",");
550 } else {
551 outer_comma = 1;
552 }
553 fprintf(f," TixModule \"%s\" %u %u [",
554 tmpModule->modName,
555 tmpModule->hashNo,
556 tmpModule->tickCount);
557 debugTrace(DEBUG_hpc,"%s: %u (offset=%u) (hash=%u)\n",
558 tmpModule->modName,
559 tmpModule->tickCount,
560 tmpModule->hashNo,
561 tmpModule->tickOffset);
562
563 inner_comma = 0;
564 for(i = 0;i < tmpModule->tickCount;i++) {
565 if (inner_comma) {
566 fprintf(f,",");
567 } else {
568 inner_comma = 1;
569 }
570
571 if (tmpModule->tixArr) {
572 fprintf(f,"%" PRIuWORD64,tmpModule->tixArr[i]);
573 } else {
574 fprintf(f,"0");
575 }
576 }
577 fprintf(f,"]");
578 }
579 fprintf(f,"]\n");
580
581 fclose(f);
582 }
583
584 /* Called at the end of execution, to write out the Hpc *.tix file
585 * for this exection. Safe to call, even if coverage is not used.
586 */
587 void
588 exitHpc(void) {
589 debugTrace(DEBUG_hpc,"exitHpc");
590
591 if (hpc_inited == 0) {
592 return;
593 }
594
595 FILE *f = fopen(tixFilename,"w");
596 writeTix(f);
597
598 if (rixFile != NULL) {
599 hs_hpc_tick(RixFinishedOp,(StgThreadID)0);
600 fclose(rixFile);
601 }
602 if (rixCmdFile != NULL) {
603 fclose(rixCmdFile);
604 }
605
606 }
607
608 void hs_hpc_read(char *filename) {
609 Info *orig_modules = 0, *tmpModule, *tmpOrigModule;
610 int i;
611
612 orig_modules = modules;
613 modules = 0;
614 if (init_open(fopen(filename,"r"))) {
615 readTix();
616 // Now we copy across the arrays. O(n^2), but works
617 for(tmpModule = modules;
618 tmpModule != 0;
619 tmpModule = tmpModule->next) {
620
621 for(tmpOrigModule = orig_modules;
622 tmpOrigModule != 0;
623 tmpOrigModule = tmpOrigModule->next) {
624 if (!strcmp(tmpModule->modName,tmpOrigModule->modName)) {
625 assert(tmpModule->tixArr != 0);
626 assert(tmpOrigModule->tixArr != 0);
627 assert(tmpModule->tickCount == tmpOrigModule->tickCount);
628 for(i=0;i < tmpModule->tickCount;i++) {
629 tmpOrigModule->tixArr[i] = tmpModule->tixArr[i];
630 }
631 tmpModule->tixArr = tmpOrigModule->tixArr;
632 break;
633 }
634 }
635 }
636 }
637 }
638
639 void hs_hpc_write(char *filename) {
640 writeTix(fopen(filename,"w"));
641 }
642
643
644