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