Hpc.c 7.2 KB
Newer Older
andy@galois.com's avatar
andy@galois.com committed
1
2
3
4
5
6
7
8
9
/*
 * (c)2006 Galois Connections, Inc.
 */ 

#include <stdio.h>
#include <ctype.h>
#include <stdlib.h>
#include <string.h>
#include <assert.h>
andy@galois.com's avatar
andy@galois.com committed
10

11
#include "Rts.h"
andy@galois.com's avatar
andy@galois.com committed
12
#include "Hpc.h"
13
#include "Trace.h"
andy@galois.com's avatar
andy@galois.com committed
14

15
16
17
18
19
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif


andy@galois.com's avatar
andy@galois.com committed
20
21
22
23
24
/* This is the runtime support for the Haskell Program Coverage (hpc) toolkit,
 * inside GHC.
 *
 */

25
static int hpc_inited = 0;		// Have you started this component?
26
27
static pid_t hpc_pid = 0;		// pid of this process at hpc-boot time.
					// Only this pid will read or write .tix file(s).
28
29
static FILE *tixFile;			// file being read/written
static int tix_ch;			// current char
andy@galois.com's avatar
andy@galois.com committed
30

31
32
33
34
35
36
37
// This is a cruel hack, we should completely redesign the format specifier handling in the RTS.
#if SIZEOF_LONG == 8
#define PRIuWORD64 "lu"
#else
#define PRIuWORD64 "llu"
#endif

38
39
HpcModuleInfo *modules = 0;
HpcModuleInfo *nextModule = 0;
andy@galois.com's avatar
andy@galois.com committed
40
41
int totalTixes = 0;		// total number of tix boxes.

42
static char *tixFilename;
andy@galois.com's avatar
andy@galois.com committed
43
44

static void failure(char *msg) {
45
  debugTrace(DEBUG_hpc,"hpc failure: %s\n",msg);
46
  fprintf(stderr,"Hpc failure: %s\n",msg);
47
48
49
50
51
  if (tixFilename) {
    fprintf(stderr,"(perhaps remove %s file?)\n",tixFilename);
  } else {
    fprintf(stderr,"(perhaps remove .tix file?)\n");
  }
andy@galois.com's avatar
andy@galois.com committed
52
53
54
  exit(-1);
}

55
56
static int init_open(FILE *file) {
  tixFile = file;
andy@galois.com's avatar
andy@galois.com committed
57
58
59
60
61
62
63
64
65
 if (tixFile == 0) {
    return 0;
  }
  tix_ch = getc(tixFile);
  return 1;
}

static void expect(char c) {
  if (tix_ch != c) {
66
    fprintf(stderr,"('%c' '%c')\n",tix_ch,c);
67
    failure("parse error when reading .tix file");
andy@galois.com's avatar
andy@galois.com committed
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
  }
  tix_ch = getc(tixFile);
}

static void ws(void) {
  while (tix_ch == ' ') {
    tix_ch = getc(tixFile);
  }
}

static char *expectString(void) {
  char tmp[256], *res;
  int tmp_ix = 0;
  expect('"');
  while (tix_ch != '"') {
    tmp[tmp_ix++] = tix_ch;
    tix_ch = getc(tixFile);
  }
  tmp[tmp_ix++] = 0;
  expect('"');
  res = malloc(tmp_ix);
  strcpy(res,tmp);
  return res;
}

static StgWord64 expectWord64(void) {
  StgWord64 tmp = 0;
  while (isdigit(tix_ch)) {
    tmp = tmp * 10 + (tix_ch -'0');
    tix_ch = getc(tixFile);
  }
  return tmp;
}

102
103
static void
readTix(void) {
104
  unsigned int i;
105
  HpcModuleInfo *tmpModule;
andy@galois.com's avatar
andy@galois.com committed
106

107
108
109
110
111
112
113
114
115
116
117
  totalTixes = 0;
    
  ws();
  expect('T');
  expect('i');
  expect('x');
  ws();
  expect('[');
  ws();
  
  while(tix_ch != ']') {
118
    tmpModule = (HpcModuleInfo *)calloc(1,sizeof(HpcModuleInfo));
andy@galois.com's avatar
andy@galois.com committed
119
120
121
    expect('T');
    expect('i');
    expect('x');
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
    expect('M');
    expect('o');
    expect('d');
    expect('u');
    expect('l');
    expect('e');
    ws();
    tmpModule -> modName = expectString();
    ws();
    tmpModule -> hashNo = (unsigned int)expectWord64();
    ws();
    tmpModule -> tickCount = (int)expectWord64();
    tmpModule -> tixArr = (StgWord64 *)calloc(tmpModule->tickCount,sizeof(StgWord64));
    tmpModule -> tickOffset = totalTixes;
    totalTixes += tmpModule -> tickCount;
andy@galois.com's avatar
andy@galois.com committed
137
138
139
    ws();
    expect('[');
    ws();
140
141
    for(i = 0;i < tmpModule->tickCount;i++) {
      tmpModule->tixArr[i] = expectWord64();
142
      ws();
andy@galois.com's avatar
andy@galois.com committed
143
144
145
      if (tix_ch == ',') {
	expect(',');
	ws();
146
147
      }
    }
andy@galois.com's avatar
andy@galois.com committed
148
    expect(']');
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
    ws();
    
    if (!modules) {
      modules = tmpModule;
    } else {
      nextModule->next=tmpModule;
    }
    nextModule=tmpModule;
    
    if (tix_ch == ',') {
      expect(',');
      ws();
    }
  }
  expect(']');
  fclose(tixFile);
}

static void hpc_init(void) {
  if (hpc_inited != 0) {
    return;
  }
  hpc_inited = 1;
172
  hpc_pid    = getpid();
173
174
175
176
177
178

  tixFilename = (char *) malloc(strlen(prog_name) + 6);
  sprintf(tixFilename, "%s.tix", prog_name);

  if (init_open(fopen(tixFilename,"r"))) {
    readTix();
andy@galois.com's avatar
andy@galois.com committed
179
180
181
182
183
184
185
186
  }
}

/* Called on a per-module basis, at startup time, declaring where the tix boxes are stored in memory.
 * This memory can be uninitized, because we will initialize it with either the contents
 * of the tix file, or all zeros.
 */

andy@galois.com's avatar
andy@galois.com committed
187
int
188
hs_hpc_module(char *modName,
189
190
	      unsigned int modCount,
	      unsigned int modHashNo,
191
	      StgWord64 *tixArr) {
192
  HpcModuleInfo *tmpModule, *lastModule;
193
  unsigned int i;
andy@galois.com's avatar
andy@galois.com committed
194
  int offset = 0;
andy@galois.com's avatar
andy@galois.com committed
195
  
196
  debugTrace(DEBUG_hpc,"hs_hpc_module(%s,%d)",modName,modCount);
andy@galois.com's avatar
andy@galois.com committed
197
198
199
200
201
202
203
204
205
206
207

  hpc_init();

  tmpModule = modules;
  lastModule = 0;
  
  for(;tmpModule != 0;tmpModule = tmpModule->next) {
    if (!strcmp(tmpModule->modName,modName)) {
      if (tmpModule->tickCount != modCount) {
	failure("inconsistent number of tick boxes");
      }
208
209
210
211
212
213
214
215
      assert(tmpModule->tixArr != 0);	
      if (tmpModule->hashNo != modHashNo) {
	fprintf(stderr,"in module '%s'\n",tmpModule->modName);
	failure("module mismatch with .tix/.mix file hash number");
	fprintf(stderr,"(perhaps remove %s ?)\n",tixFilename);
	exit(-1);

      }
andy@galois.com's avatar
andy@galois.com committed
216
      for(i=0;i < modCount;i++) {
217
	tixArr[i] = tmpModule->tixArr[i];
andy@galois.com's avatar
andy@galois.com committed
218
      }
219
      tmpModule->tixArr = tixArr;
andy@galois.com's avatar
andy@galois.com committed
220
      return tmpModule->tickOffset;
andy@galois.com's avatar
andy@galois.com committed
221
222
223
224
    }
    lastModule = tmpModule;
  }
  // Did not find entry so add one on.
225
  tmpModule = (HpcModuleInfo *)calloc(1,sizeof(HpcModuleInfo));
andy@galois.com's avatar
andy@galois.com committed
226
227
  tmpModule->modName = modName;
  tmpModule->tickCount = modCount;
228
  tmpModule->hashNo = modHashNo;
andy@galois.com's avatar
andy@galois.com committed
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
  if (lastModule) {
    tmpModule->tickOffset = lastModule->tickOffset + lastModule->tickCount;
  } else {
    tmpModule->tickOffset = 0;
  }
  tmpModule->tixArr = tixArr;
  for(i=0;i < modCount;i++) {
    tixArr[i] = 0;
  }
  tmpModule->next = 0;

  if (!modules) {
    modules = tmpModule;
  } else {
    lastModule->next=tmpModule;
  }

246
247
  debugTrace(DEBUG_hpc,"end: hs_hpc_module");

andy@galois.com's avatar
andy@galois.com committed
248
249
250
  return offset;
}

andy@galois.com's avatar
andy@galois.com committed
251
252
253
254
255
256
257

/* This is called after all the modules have registered their local tixboxes,
 * and does a sanity check: are we good to go?
 */

void
startupHpc(void) {
258
  debugTrace(DEBUG_hpc,"startupHpc");
andy@galois.com's avatar
andy@galois.com committed
259
260
261
262
263
264
 
 if (hpc_inited == 0) {
    return;
  }
}

andy@galois.com's avatar
andy@galois.com committed
265

266
267
static void
writeTix(FILE *f) {
268
  HpcModuleInfo *tmpModule;  
269
  unsigned int i, inner_comma, outer_comma;
andy@galois.com's avatar
andy@galois.com committed
270

271
  outer_comma = 0;
andy@galois.com's avatar
andy@galois.com committed
272

273
  if (f == 0) {
andy@galois.com's avatar
andy@galois.com committed
274
275
276
    return;
  }

277
  fprintf(f,"Tix [");
andy@galois.com's avatar
andy@galois.com committed
278
279
  tmpModule = modules;
  for(;tmpModule != 0;tmpModule = tmpModule->next) {
280
    if (outer_comma) {
andy@galois.com's avatar
andy@galois.com committed
281
282
      fprintf(f,",");
    } else {
283
      outer_comma = 1;
andy@galois.com's avatar
andy@galois.com committed
284
    }
285
    fprintf(f," TixModule \"%s\" %u %u [",
andy@galois.com's avatar
andy@galois.com committed
286
	   tmpModule->modName,
287
	    tmpModule->hashNo,
andy@galois.com's avatar
andy@galois.com committed
288
	    tmpModule->tickCount);
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
    debugTrace(DEBUG_hpc,"%s: %u (offset=%u) (hash=%u)\n",
	       tmpModule->modName,
	       tmpModule->tickCount,
	       tmpModule->hashNo,
	       tmpModule->tickOffset);

    inner_comma = 0;
    for(i = 0;i < tmpModule->tickCount;i++) {
      if (inner_comma) {
	fprintf(f,",");
      } else {
	inner_comma = 1;
      }

      if (tmpModule->tixArr) {
	fprintf(f,"%" PRIuWORD64,tmpModule->tixArr[i]);
      } else {
	fprintf(f,"0");
      }
    }
    fprintf(f,"]");
andy@galois.com's avatar
andy@galois.com committed
310
  }
311
  fprintf(f,"]\n");
andy@galois.com's avatar
andy@galois.com committed
312
  
313
314
  fclose(f);
}
andy@galois.com's avatar
andy@galois.com committed
315

316
317
318
319
320
321
/* Called at the end of execution, to write out the Hpc *.tix file  
 * for this exection. Safe to call, even if coverage is not used.
 */
void
exitHpc(void) {
  debugTrace(DEBUG_hpc,"exitHpc");
andy@galois.com's avatar
andy@galois.com committed
322

323
324
  if (hpc_inited == 0) {
    return;
andy@galois.com's avatar
andy@galois.com committed
325
  }
326

327
328
329
330
331
332
333
334
  // Only write the tix file if you are the original process.
  // Any sub-process from use of fork from inside Haskell will
  // not clober the .tix file.

  if (hpc_pid == getpid()) {
    FILE *f = fopen(tixFilename,"w");
    writeTix(f);
  }
andy@galois.com's avatar
andy@galois.com committed
335
336
}

337
338
339
//////////////////////////////////////////////////////////////////////////////
// This is the API into Hpc RTS from Haskell, allowing the tixs boxes
// to be first class.
340

341
342
343
HpcModuleInfo *hs_hpc_rootModule(void) {
  return modules;
}