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