use FMT_Word64 instead of locally-defined version
[ghc.git] / rts / Hpc.c
1 /*
2 * (c)2006 Galois Connections, Inc.
3 */
4
5 #include "PosixSource.h"
6 #include "Rts.h"
7
8 #include "Trace.h"
9
10 #include <stdio.h>
11 #include <ctype.h>
12 #include <string.h>
13 #include <assert.h>
14
15 #ifdef HAVE_SYS_TYPES_H
16 #include <sys/types.h>
17 #endif
18
19 #ifdef HAVE_SYS_STAT_H
20 #include <sys/stat.h>
21 #endif
22
23 #ifdef HAVE_UNISTD_H
24 #include <unistd.h>
25 #endif
26
27
28 /* This is the runtime support for the Haskell Program Coverage (hpc) toolkit,
29 * inside GHC.
30 *
31 */
32
33 static int hpc_inited = 0; // Have you started this component?
34 static pid_t hpc_pid = 0; // pid of this process at hpc-boot time.
35 // Only this pid will read or write .tix file(s).
36 static FILE *tixFile; // file being read/written
37 static int tix_ch; // current char
38
39 HpcModuleInfo *modules = 0;
40 HpcModuleInfo *nextModule = 0;
41 int totalTixes = 0; // total number of tix boxes.
42
43 static char *tixFilename;
44
45 static void GNU_ATTRIBUTE(__noreturn__)
46 failure(char *msg) {
47 debugTrace(DEBUG_hpc,"hpc failure: %s\n",msg);
48 fprintf(stderr,"Hpc failure: %s\n",msg);
49 if (tixFilename) {
50 fprintf(stderr,"(perhaps remove %s file?)\n",tixFilename);
51 } else {
52 fprintf(stderr,"(perhaps remove .tix file?)\n");
53 }
54 exit(-1);
55 }
56
57 static int init_open(FILE *file) {
58 tixFile = file;
59 if (tixFile == 0) {
60 return 0;
61 }
62 tix_ch = getc(tixFile);
63 return 1;
64 }
65
66 static void expect(char c) {
67 if (tix_ch != c) {
68 fprintf(stderr,"('%c' '%c')\n",tix_ch,c);
69 failure("parse error when reading .tix file");
70 }
71 tix_ch = getc(tixFile);
72 }
73
74 static void ws(void) {
75 while (tix_ch == ' ') {
76 tix_ch = getc(tixFile);
77 }
78 }
79
80 static char *expectString(void) {
81 char tmp[256], *res;
82 int tmp_ix = 0;
83 expect('"');
84 while (tix_ch != '"') {
85 tmp[tmp_ix++] = tix_ch;
86 tix_ch = getc(tixFile);
87 }
88 tmp[tmp_ix++] = 0;
89 expect('"');
90 res = malloc(tmp_ix);
91 strcpy(res,tmp);
92 return res;
93 }
94
95 static StgWord64 expectWord64(void) {
96 StgWord64 tmp = 0;
97 while (isdigit(tix_ch)) {
98 tmp = tmp * 10 + (tix_ch -'0');
99 tix_ch = getc(tixFile);
100 }
101 return tmp;
102 }
103
104 static void
105 readTix(void) {
106 unsigned int i;
107 HpcModuleInfo *tmpModule;
108
109 totalTixes = 0;
110
111 ws();
112 expect('T');
113 expect('i');
114 expect('x');
115 ws();
116 expect('[');
117 ws();
118
119 while(tix_ch != ']') {
120 tmpModule = (HpcModuleInfo *)calloc(1,sizeof(HpcModuleInfo));
121 expect('T');
122 expect('i');
123 expect('x');
124 expect('M');
125 expect('o');
126 expect('d');
127 expect('u');
128 expect('l');
129 expect('e');
130 ws();
131 tmpModule -> modName = expectString();
132 ws();
133 tmpModule -> hashNo = (unsigned int)expectWord64();
134 ws();
135 tmpModule -> tickCount = (int)expectWord64();
136 tmpModule -> tixArr = (StgWord64 *)calloc(tmpModule->tickCount,sizeof(StgWord64));
137 tmpModule -> tickOffset = totalTixes;
138 totalTixes += tmpModule -> tickCount;
139 ws();
140 expect('[');
141 ws();
142 for(i = 0;i < tmpModule->tickCount;i++) {
143 tmpModule->tixArr[i] = expectWord64();
144 ws();
145 if (tix_ch == ',') {
146 expect(',');
147 ws();
148 }
149 }
150 expect(']');
151 ws();
152
153 if (!modules) {
154 modules = tmpModule;
155 } else {
156 nextModule->next=tmpModule;
157 }
158 nextModule=tmpModule;
159
160 if (tix_ch == ',') {
161 expect(',');
162 ws();
163 }
164 }
165 expect(']');
166 fclose(tixFile);
167 }
168
169 static void hpc_init(void) {
170 char *hpc_tixdir;
171 char *hpc_tixfile;
172 if (hpc_inited != 0) {
173 return;
174 }
175 hpc_inited = 1;
176 hpc_pid = getpid();
177 hpc_tixdir = getenv("HPCTIXDIR");
178 hpc_tixfile = getenv("HPCTIXFILE");
179
180 /* XXX Check results of mallocs/strdups, and check we are requesting
181 enough bytes */
182 if (hpc_tixfile != NULL) {
183 tixFilename = strdup(hpc_tixfile);
184 } else if (hpc_tixdir != NULL) {
185 /* Make sure the directory is present;
186 * conditional code for mkdir lifted from lndir.c
187 */
188 #ifdef WIN32
189 mkdir(hpc_tixdir);
190 #else
191 mkdir(hpc_tixdir,0777);
192 #endif
193 /* Then, try open the file
194 */
195 tixFilename = (char *) malloc(strlen(hpc_tixdir) + strlen(prog_name) + 12);
196 sprintf(tixFilename,"%s/%s-%d.tix",hpc_tixdir,prog_name,(int)hpc_pid);
197 } else {
198 tixFilename = (char *) malloc(strlen(prog_name) + 6);
199 sprintf(tixFilename, "%s.tix", prog_name);
200 }
201
202 if (init_open(fopen(tixFilename,"r"))) {
203 readTix();
204 }
205 }
206
207 /* Called on a per-module basis, at startup time, declaring where the tix boxes are stored in memory.
208 * This memory can be uninitized, because we will initialize it with either the contents
209 * of the tix file, or all zeros.
210 */
211
212 int
213 hs_hpc_module(char *modName,
214 StgWord32 modCount,
215 StgWord32 modHashNo,
216 StgWord64 *tixArr) {
217 HpcModuleInfo *tmpModule, *lastModule;
218 unsigned int i;
219 int offset = 0;
220
221 debugTrace(DEBUG_hpc,"hs_hpc_module(%s,%d)",modName,(nat)modCount);
222
223 hpc_init();
224
225 tmpModule = modules;
226 lastModule = 0;
227
228 for(;tmpModule != 0;tmpModule = tmpModule->next) {
229 if (!strcmp(tmpModule->modName,modName)) {
230 if (tmpModule->tickCount != modCount) {
231 failure("inconsistent number of tick boxes");
232 }
233 assert(tmpModule->tixArr != 0);
234 if (tmpModule->hashNo != modHashNo) {
235 fprintf(stderr,"in module '%s'\n",tmpModule->modName);
236 failure("module mismatch with .tix/.mix file hash number");
237 fprintf(stderr,"(perhaps remove %s ?)\n",tixFilename);
238 exit(-1);
239
240 }
241 for(i=0;i < modCount;i++) {
242 tixArr[i] = tmpModule->tixArr[i];
243 }
244 tmpModule->tixArr = tixArr;
245 return tmpModule->tickOffset;
246 }
247 lastModule = tmpModule;
248 }
249 // Did not find entry so add one on.
250 tmpModule = (HpcModuleInfo *)calloc(1,sizeof(HpcModuleInfo));
251 tmpModule->modName = modName;
252 tmpModule->tickCount = modCount;
253 tmpModule->hashNo = modHashNo;
254 if (lastModule) {
255 tmpModule->tickOffset = lastModule->tickOffset + lastModule->tickCount;
256 } else {
257 tmpModule->tickOffset = 0;
258 }
259 tmpModule->tixArr = tixArr;
260 for(i=0;i < modCount;i++) {
261 tixArr[i] = 0;
262 }
263 tmpModule->next = 0;
264
265 if (!modules) {
266 modules = tmpModule;
267 } else {
268 lastModule->next=tmpModule;
269 }
270
271 debugTrace(DEBUG_hpc,"end: hs_hpc_module");
272
273 return offset;
274 }
275
276
277 /* This is called after all the modules have registered their local tixboxes,
278 * and does a sanity check: are we good to go?
279 */
280
281 void
282 startupHpc(void) {
283 debugTrace(DEBUG_hpc,"startupHpc");
284
285 if (hpc_inited == 0) {
286 return;
287 }
288 }
289
290
291 static void
292 writeTix(FILE *f) {
293 HpcModuleInfo *tmpModule;
294 unsigned int i, inner_comma, outer_comma;
295
296 outer_comma = 0;
297
298 if (f == 0) {
299 return;
300 }
301
302 fprintf(f,"Tix [");
303 tmpModule = modules;
304 for(;tmpModule != 0;tmpModule = tmpModule->next) {
305 if (outer_comma) {
306 fprintf(f,",");
307 } else {
308 outer_comma = 1;
309 }
310 fprintf(f," TixModule \"%s\" %u %u [",
311 tmpModule->modName,
312 (nat)tmpModule->hashNo,
313 (nat)tmpModule->tickCount);
314 debugTrace(DEBUG_hpc,"%s: %u (offset=%u) (hash=%u)\n",
315 tmpModule->modName,
316 (nat)tmpModule->tickCount,
317 (nat)tmpModule->hashNo,
318 (nat)tmpModule->tickOffset);
319
320 inner_comma = 0;
321 for(i = 0;i < tmpModule->tickCount;i++) {
322 if (inner_comma) {
323 fprintf(f,",");
324 } else {
325 inner_comma = 1;
326 }
327
328 if (tmpModule->tixArr) {
329 fprintf(f,"%" FMT_Word64,tmpModule->tixArr[i]);
330 } else {
331 fprintf(f,"0");
332 }
333 }
334 fprintf(f,"]");
335 }
336 fprintf(f,"]\n");
337
338 fclose(f);
339 }
340
341 /* Called at the end of execution, to write out the Hpc *.tix file
342 * for this exection. Safe to call, even if coverage is not used.
343 */
344 void
345 exitHpc(void) {
346 debugTrace(DEBUG_hpc,"exitHpc");
347
348 if (hpc_inited == 0) {
349 return;
350 }
351
352 // Only write the tix file if you are the original process.
353 // Any sub-process from use of fork from inside Haskell will
354 // not clober the .tix file.
355
356 if (hpc_pid == getpid()) {
357 FILE *f = fopen(tixFilename,"w");
358 writeTix(f);
359 }
360 }
361
362 //////////////////////////////////////////////////////////////////////////////
363 // This is the API into Hpc RTS from Haskell, allowing the tixs boxes
364 // to be first class.
365
366 HpcModuleInfo *hs_hpc_rootModule(void) {
367 return modules;
368 }