Fix the +RTS -V0 option introduced recently; it didn't work at all, now it does.
[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 static int hpc_inited = 0; // Have you started this component?
26 static FILE *tixFile; // file being read/written
27 static int tix_ch; // current char
28
29 // This is a cruel hack, we should completely redesign the format specifier handling in the RTS.
30 #if SIZEOF_LONG == 8
31 #define PRIuWORD64 "lu"
32 #else
33 #define PRIuWORD64 "llu"
34 #endif
35
36 HpcModuleInfo *modules = 0;
37 HpcModuleInfo *nextModule = 0;
38 int totalTixes = 0; // total number of tix boxes.
39
40 static char *tixFilename;
41
42 void hs_hpc_read(char *filename);
43 void hs_hpc_write(char *filename);
44
45 static void failure(char *msg) {
46 debugTrace(DEBUG_hpc,"hpc failure: %s\n",msg);
47 fprintf(stderr,"Hpc failure: %s\n",msg);
48 if (tixFilename) {
49 fprintf(stderr,"(perhaps remove %s file?)\n",tixFilename);
50 } else {
51 fprintf(stderr,"(perhaps remove .tix file?)\n");
52 }
53 exit(-1);
54 }
55
56 static int init_open(FILE *file) {
57 tixFile = file;
58 if (tixFile == 0) {
59 return 0;
60 }
61 tix_ch = getc(tixFile);
62 return 1;
63 }
64
65 static void expect(char c) {
66 if (tix_ch != c) {
67 fprintf(stderr,"('%c' '%c')\n",tix_ch,c);
68 failure("parse error when reading .tix file");
69 }
70 tix_ch = getc(tixFile);
71 }
72
73 static void ws(void) {
74 while (tix_ch == ' ') {
75 tix_ch = getc(tixFile);
76 }
77 }
78
79 static char *expectString(void) {
80 char tmp[256], *res;
81 int tmp_ix = 0;
82 expect('"');
83 while (tix_ch != '"') {
84 tmp[tmp_ix++] = tix_ch;
85 tix_ch = getc(tixFile);
86 }
87 tmp[tmp_ix++] = 0;
88 expect('"');
89 res = malloc(tmp_ix);
90 strcpy(res,tmp);
91 return res;
92 }
93
94 static StgWord64 expectWord64(void) {
95 StgWord64 tmp = 0;
96 while (isdigit(tix_ch)) {
97 tmp = tmp * 10 + (tix_ch -'0');
98 tix_ch = getc(tixFile);
99 }
100 return tmp;
101 }
102
103 static void
104 readTix(void) {
105 int i;
106 HpcModuleInfo *tmpModule;
107
108 totalTixes = 0;
109
110 ws();
111 expect('T');
112 expect('i');
113 expect('x');
114 ws();
115 expect('[');
116 ws();
117
118 while(tix_ch != ']') {
119 tmpModule = (HpcModuleInfo *)calloc(1,sizeof(HpcModuleInfo));
120 expect('T');
121 expect('i');
122 expect('x');
123 expect('M');
124 expect('o');
125 expect('d');
126 expect('u');
127 expect('l');
128 expect('e');
129 ws();
130 tmpModule -> modName = expectString();
131 ws();
132 tmpModule -> hashNo = (unsigned int)expectWord64();
133 ws();
134 tmpModule -> tickCount = (int)expectWord64();
135 tmpModule -> tixArr = (StgWord64 *)calloc(tmpModule->tickCount,sizeof(StgWord64));
136 tmpModule -> tickOffset = totalTixes;
137 totalTixes += tmpModule -> tickCount;
138 ws();
139 expect('[');
140 ws();
141 for(i = 0;i < tmpModule->tickCount;i++) {
142 tmpModule->tixArr[i] = expectWord64();
143 ws();
144 if (tix_ch == ',') {
145 expect(',');
146 ws();
147 }
148 }
149 expect(']');
150 ws();
151
152 if (!modules) {
153 modules = tmpModule;
154 } else {
155 nextModule->next=tmpModule;
156 }
157 nextModule=tmpModule;
158
159 if (tix_ch == ',') {
160 expect(',');
161 ws();
162 }
163 }
164 expect(']');
165 fclose(tixFile);
166 }
167
168 static void hpc_init(void) {
169 if (hpc_inited != 0) {
170 return;
171 }
172 hpc_inited = 1;
173
174 tixFilename = (char *) malloc(strlen(prog_name) + 6);
175 sprintf(tixFilename, "%s.tix", prog_name);
176
177 if (init_open(fopen(tixFilename,"r"))) {
178 readTix();
179 }
180 }
181
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.
185 */
186
187 int
188 hs_hpc_module(char *modName,
189 int modCount,
190 int modHashNo,
191 StgWord64 *tixArr) {
192 HpcModuleInfo *tmpModule, *lastModule;
193 int i;
194 int offset = 0;
195
196 debugTrace(DEBUG_hpc,"hs_hpc_module(%s,%d)",modName,modCount);
197
198 hpc_init();
199
200 tmpModule = modules;
201 lastModule = 0;
202
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");
207 }
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);
213 exit(-1);
214
215 }
216 for(i=0;i < modCount;i++) {
217 tixArr[i] = tmpModule->tixArr[i];
218 }
219 tmpModule->tixArr = tixArr;
220 return tmpModule->tickOffset;
221 }
222 lastModule = tmpModule;
223 }
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;
229 if (lastModule) {
230 tmpModule->tickOffset = lastModule->tickOffset + lastModule->tickCount;
231 } else {
232 tmpModule->tickOffset = 0;
233 }
234 tmpModule->tixArr = tixArr;
235 for(i=0;i < modCount;i++) {
236 tixArr[i] = 0;
237 }
238 tmpModule->next = 0;
239
240 if (!modules) {
241 modules = tmpModule;
242 } else {
243 lastModule->next=tmpModule;
244 }
245
246 debugTrace(DEBUG_hpc,"end: hs_hpc_module");
247
248 return offset;
249 }
250
251
252 /* This is called after all the modules have registered their local tixboxes,
253 * and does a sanity check: are we good to go?
254 */
255
256 void
257 startupHpc(void) {
258 debugTrace(DEBUG_hpc,"startupHpc");
259
260 if (hpc_inited == 0) {
261 return;
262 }
263 }
264
265
266 static void
267 writeTix(FILE *f) {
268 HpcModuleInfo *tmpModule;
269 int i, inner_comma, outer_comma;
270
271 outer_comma = 0;
272
273 if (f == 0) {
274 return;
275 }
276
277 fprintf(f,"Tix [");
278 tmpModule = modules;
279 for(;tmpModule != 0;tmpModule = tmpModule->next) {
280 if (outer_comma) {
281 fprintf(f,",");
282 } else {
283 outer_comma = 1;
284 }
285 fprintf(f," TixModule \"%s\" %u %u [",
286 tmpModule->modName,
287 tmpModule->hashNo,
288 tmpModule->tickCount);
289 debugTrace(DEBUG_hpc,"%s: %u (offset=%u) (hash=%u)\n",
290 tmpModule->modName,
291 tmpModule->tickCount,
292 tmpModule->hashNo,
293 tmpModule->tickOffset);
294
295 inner_comma = 0;
296 for(i = 0;i < tmpModule->tickCount;i++) {
297 if (inner_comma) {
298 fprintf(f,",");
299 } else {
300 inner_comma = 1;
301 }
302
303 if (tmpModule->tixArr) {
304 fprintf(f,"%" PRIuWORD64,tmpModule->tixArr[i]);
305 } else {
306 fprintf(f,"0");
307 }
308 }
309 fprintf(f,"]");
310 }
311 fprintf(f,"]\n");
312
313 fclose(f);
314 }
315
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.
318 */
319 void
320 exitHpc(void) {
321 debugTrace(DEBUG_hpc,"exitHpc");
322
323 if (hpc_inited == 0) {
324 return;
325 }
326
327 FILE *f = fopen(tixFilename,"w");
328 writeTix(f);
329 }
330
331 void hs_hpc_read(char *filename) {
332 HpcModuleInfo *orig_modules = 0, *tmpModule, *tmpOrigModule;
333 int i;
334
335 orig_modules = modules;
336 modules = 0;
337 if (init_open(fopen(filename,"r"))) {
338 readTix();
339 // Now we copy across the arrays. O(n^2), but works
340 for(tmpModule = modules;
341 tmpModule != 0;
342 tmpModule = tmpModule->next) {
343
344 for(tmpOrigModule = orig_modules;
345 tmpOrigModule != 0;
346 tmpOrigModule = tmpOrigModule->next) {
347 if (!strcmp(tmpModule->modName,tmpOrigModule->modName)) {
348 assert(tmpModule->tixArr != 0);
349 assert(tmpOrigModule->tixArr != 0);
350 assert(tmpModule->tickCount == tmpOrigModule->tickCount);
351 for(i=0;i < tmpModule->tickCount;i++) {
352 tmpOrigModule->tixArr[i] = tmpModule->tixArr[i];
353 }
354 tmpModule->tixArr = tmpOrigModule->tixArr;
355 break;
356 }
357 }
358 }
359 }
360 }
361
362 void hs_hpc_write(char *filename) {
363 writeTix(fopen(filename,"w"));
364 }
365
366 //////////////////////////////////////////////////////////////////////////////
367 // This is the API into Hpc RTS from Haskell, allowing the tixs boxes
368 // to be first class.
369
370 HpcModuleInfo *hs_hpc_rootModule(void) {
371 return modules;
372 }