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 #include "Hash.h"
  10 #include "RtsUtils.h"
  11
  12 #include <stdio.h>
  13 #include <ctype.h>
  14 #include <string.h>
  15 #include <assert.h>
  16
  17 #ifdef HAVE_SYS_TYPES_H
  18 #include <sys/types.h>
  19 #endif
  20
  21 #ifdef HAVE_SYS_STAT_H
  22 #include <sys/stat.h>
  23 #endif
  24
  25 #ifdef HAVE_UNISTD_H
  26 #include <unistd.h>
  27 #endif
  28
  29
  30 /* This is the runtime support for the Haskell Program Coverage (hpc) toolkit,
  31  * inside GHC.
  32  *
  33  */
  34
  35 static int hpc_inited = 0;              // Have you started this component?
  36 static pid_t hpc_pid = 0;               // pid of this process at hpc-boot time.
  37                                         // Only this pid will read or write .tix file(s).
  38 static FILE *tixFile;                   // file being read/written
  39 static int tix_ch;                      // current char
  40
  41 static HashTable * moduleHash = NULL;   // module name -> HpcModuleInfo
  42
  43 HpcModuleInfo *modules = 0;
  44
  45 static char *tixFilename = NULL;
  46
  47 static void GNU_ATTRIBUTE(__noreturn__)
  48 failure(char *msg) {
  49   debugTrace(DEBUG_hpc,"hpc failure: %s\n",msg);
  50   fprintf(stderr,"Hpc failure: %s\n",msg);
  51   if (tixFilename) {
  52     fprintf(stderr,"(perhaps remove %s file?)\n",tixFilename);
  53   } else {
  54     fprintf(stderr,"(perhaps remove .tix file?)\n");
  55   }
  56   stg_exit(1);
  57 }
  58
  59 static int init_open(FILE *file) {
  60   tixFile = file;
  61  if (tixFile == 0) {
  62     return 0;
  63   }
  64   tix_ch = getc(tixFile);
  65   return 1;
  66 }
  67
  68 static void expect(char c) {
  69   if (tix_ch != c) {
  70     fprintf(stderr,"('%c' '%c')\n",tix_ch,c);
  71     failure("parse error when reading .tix file");
  72   }
  73   tix_ch = getc(tixFile);
  74 }
  75
  76 static void ws(void) {
  77   while (tix_ch == ' ') {
  78     tix_ch = getc(tixFile);
  79   }
  80 }
  81
  82 static char *expectString(void) {
  83   char tmp[256], *res; // XXX
  84   int tmp_ix = 0;
  85   expect('"');
  86   while (tix_ch != '"') {
  87     tmp[tmp_ix++] = tix_ch;
  88     tix_ch = getc(tixFile);
  89   }
  90   tmp[tmp_ix++] = 0;
  91   expect('"');
  92   res = stgMallocBytes(tmp_ix,"Hpc.expectString");
  93   strcpy(res,tmp);
  94   return res;
  95 }
  96
  97 static StgWord64 expectWord64(void) {
  98   StgWord64 tmp = 0;
  99   while (isdigit(tix_ch)) {
 100     tmp = tmp * 10 + (tix_ch -'0');
 101     tix_ch = getc(tixFile);
 102   }
 103   return tmp;
 104 }
 105
 106 static void
 107 readTix(void) {
 108   unsigned int i;
 109   HpcModuleInfo *tmpModule, *lookup;
 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 *)stgMallocBytes(sizeof(HpcModuleInfo),
 121                                                 "Hpc.readTix");
 122     tmpModule->from_file = rtsTrue;
 123     expect('T');
 124     expect('i');
 125     expect('x');
 126     expect('M');
 127     expect('o');
 128     expect('d');
 129     expect('u');
 130     expect('l');
 131     expect('e');
 132     ws();
 133     tmpModule -> modName = expectString();
 134     ws();
 135     tmpModule -> hashNo = (unsigned int)expectWord64();
 136     ws();
 137     tmpModule -> tickCount = (int)expectWord64();
 138     tmpModule -> tixArr = (StgWord64 *)calloc(tmpModule->tickCount,sizeof(StgWord64));
 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     lookup = lookupHashTable(moduleHash, (StgWord)tmpModule->modName);
 154     if (tmpModule == NULL) {
 155         debugTrace(DEBUG_hpc,"readTix: new HpcModuleInfo for %s",
 156                    tmpModule->modName);
 157         insertHashTable(moduleHash, (StgWord)tmpModule->modName, tmpModule);
 158     } else {
 159         ASSERT(lookup->tixArr != 0);
 160         ASSERT(!strcmp(tmpModule->modName, lookup->modName));
 161         debugTrace(DEBUG_hpc,"readTix: existing HpcModuleInfo for %s",
 162                    tmpModule->modName);
 163         if (tmpModule->hashNo != lookup->hashNo) {
 164             fprintf(stderr,"in module '%s'\n",tmpModule->modName);
 165             failure("module mismatch with .tix/.mix file hash number");
 166             if (tixFilename != NULL) {
 167                 fprintf(stderr,"(perhaps remove %s ?)\n",tixFilename);
 168             }
 169             stg_exit(EXIT_FAILURE);
 170         }
 171         for (i=0; i < tmpModule->tickCount; i++) {
 172             lookup->tixArr[i] = tmpModule->tixArr[i];
 173         }
 174         stgFree(tmpModule->tixArr);
 175         stgFree(tmpModule->modName);
 176         stgFree(tmpModule);
 177     }
 178
 179     if (tix_ch == ',') {
 180       expect(',');
 181       ws();
 182     }
 183   }
 184   expect(']');
 185   fclose(tixFile);
 186 }
 187
 188 void
 189 startupHpc(void)
 190 {
 191   char *hpc_tixdir;
 192   char *hpc_tixfile;
 193
 194   if (moduleHash == NULL) {
 195       // no modules were registered with hs_hpc_module, so don't bother
 196       // creating the .tix file.
 197       return;
 198   }
 199
 200   if (hpc_inited != 0) {
 201     return;
 202   }
 203   hpc_inited = 1;
 204   hpc_pid    = getpid();
 205   hpc_tixdir = getenv("HPCTIXDIR");
 206   hpc_tixfile = getenv("HPCTIXFILE");
 207
 208   debugTrace(DEBUG_hpc,"startupHpc");
 209
 210   /* XXX Check results of mallocs/strdups, and check we are requesting
 211          enough bytes */
 212   if (hpc_tixfile != NULL) {
 213     tixFilename = strdup(hpc_tixfile);
 214   } else if (hpc_tixdir != NULL) {
 215     /* Make sure the directory is present;
 216      * conditional code for mkdir lifted from lndir.c
 217      */
 218 #ifdef WIN32
 219     mkdir(hpc_tixdir);
 220 #else
 221     mkdir(hpc_tixdir,0777);
 222 #endif
 223     /* Then, try open the file
 224      */
 225     tixFilename = (char *) stgMallocBytes(strlen(hpc_tixdir) +
 226                                           strlen(prog_name) + 12,
 227                                           "Hpc.startupHpc");
 228     sprintf(tixFilename,"%s/%s-%d.tix",hpc_tixdir,prog_name,(int)hpc_pid);
 229   } else {
 230     tixFilename = (char *) stgMallocBytes(strlen(prog_name) + 6,
 231                                           "Hpc.startupHpc");
 232     sprintf(tixFilename, "%s.tix", prog_name);
 233   }
 234
 235   if (init_open(fopen(tixFilename,"r"))) {
 236     readTix();
 237   }
 238 }
 239
 240 /*
 241  * Called on a per-module basis, by a constructor function compiled
 242  * with each module (see Coverage.hpcInitCode), declaring where the
 243  * tix boxes are stored in memory.  This memory can be uninitized,
 244  * because we will initialize it with either the contents of the tix
 245  * file, or all zeros.
 246  *
 247  * Note that we might call this before reading the .tix file, or after
 248  * in the case where we loaded some Haskell code from a .so with
 249  * dlopen().  So we must handle the case where we already have an
 250  * HpcModuleInfo for the module which was read from the .tix file.
 251  */
 252
 253 void
 254 hs_hpc_module(char *modName,
 255               StgWord32 modCount,
 256               StgWord32 modHashNo,
 257               StgWord64 *tixArr)
 258 {
 259   HpcModuleInfo *tmpModule;
 260   nat i;
 261
 262   if (moduleHash == NULL) {
 263       moduleHash = allocStrHashTable();
 264   }
 265
 266   tmpModule = lookupHashTable(moduleHash, (StgWord)modName);
 267   if (tmpModule == NULL)
 268   {
 269       // Did not find entry so add one on.
 270       tmpModule = (HpcModuleInfo *)stgMallocBytes(sizeof(HpcModuleInfo),
 271                                                   "Hpc.hs_hpc_module");
 272       tmpModule->modName = modName;
 273       tmpModule->tickCount = modCount;
 274       tmpModule->hashNo = modHashNo;
 275
 276       tmpModule->tixArr = tixArr;
 277       for(i=0;i < modCount;i++) {
 278           tixArr[i] = 0;
 279       }
 280       tmpModule->next = modules;
 281       tmpModule->from_file = rtsFalse;
 282       modules = tmpModule;
 283       insertHashTable(moduleHash, (StgWord)modName, tmpModule);
 284   }
 285   else
 286   {
 287       if (tmpModule->tickCount != modCount) {
 288           failure("inconsistent number of tick boxes");
 289       }
 290       ASSERT(tmpModule->tixArr != 0);
 291       if (tmpModule->hashNo != modHashNo) {
 292           fprintf(stderr,"in module '%s'\n",tmpModule->modName);
 293           failure("module mismatch with .tix/.mix file hash number");
 294           if (tixFilename != NULL) {
 295               fprintf(stderr,"(perhaps remove %s ?)\n",tixFilename);
 296           }
 297           stg_exit(EXIT_FAILURE);
 298       }
 299       // The existing tixArr was made up when we read the .tix file,
 300       // whereas this is the real tixArr, so copy the data from the
 301       // .tix into the real tixArr.
 302       for(i=0;i < modCount;i++) {
 303           tixArr[i] = tmpModule->tixArr[i];
 304       }
 305
 306       if (tmpModule->from_file) {
 307           stgFree(tmpModule->modName);
 308           stgFree(tmpModule->tixArr);
 309       }
 310       tmpModule->from_file = rtsFalse;
 311   }
 312 }
 313
 314 static void
 315 writeTix(FILE *f) {
 316   HpcModuleInfo *tmpModule;
 317   unsigned int i, inner_comma, outer_comma;
 318
 319   outer_comma = 0;
 320
 321   if (f == 0) {
 322     return;
 323   }
 324
 325   fprintf(f,"Tix [");
 326   tmpModule = modules;
 327   for(;tmpModule != 0;tmpModule = tmpModule->next) {
 328     if (outer_comma) {
 329       fprintf(f,",");
 330     } else {
 331       outer_comma = 1;
 332     }
 333     fprintf(f," TixModule \"%s\" %u %u [",
 334            tmpModule->modName,
 335             (nat)tmpModule->hashNo,
 336             (nat)tmpModule->tickCount);
 337     debugTrace(DEBUG_hpc,"%s: %u (hash=%u)\n",
 338                tmpModule->modName,
 339                (nat)tmpModule->tickCount,
 340                (nat)tmpModule->hashNo);
 341
 342     inner_comma = 0;
 343     for(i = 0;i < tmpModule->tickCount;i++) {
 344       if (inner_comma) {
 345         fprintf(f,",");
 346       } else {
 347         inner_comma = 1;
 348       }
 349
 350       if (tmpModule->tixArr) {
 351         fprintf(f,"%" FMT_Word64,tmpModule->tixArr[i]);
 352       } else {
 353         fprintf(f,"0");
 354       }
 355     }
 356     fprintf(f,"]");
 357   }
 358   fprintf(f,"]\n");
 359
 360   fclose(f);
 361 }
 362
 363 static void
 364 freeHpcModuleInfo (HpcModuleInfo *mod)
 365 {
 366     if (mod->from_file) {
 367         stgFree(mod->modName);
 368         stgFree(mod->tixArr);
 369     }
 370     stgFree(mod);
 371 }
 372
 373 /* Called at the end of execution, to write out the Hpc *.tix file
 374  * for this exection. Safe to call, even if coverage is not used.
 375  */
 376 void
 377 exitHpc(void) {
 378   debugTrace(DEBUG_hpc,"exitHpc");
 379
 380   if (hpc_inited == 0) {
 381     return;
 382   }
 383
 384   // Only write the tix file if you are the original process.
 385   // Any sub-process from use of fork from inside Haskell will
 386   // not clober the .tix file.
 387
 388   if (hpc_pid == getpid()) {
 389     FILE *f = fopen(tixFilename,"w");
 390     writeTix(f);
 391   }
 392
 393   freeHashTable(moduleHash, (void (*)(void *))freeHpcModuleInfo);
 394   moduleHash = NULL;
 395
 396   stgFree(tixFilename);
 397   tixFilename = NULL;
 398 }
 399
 400 //////////////////////////////////////////////////////////////////////////////
 401 // This is the API into Hpc RTS from Haskell, allowing the tixs boxes
 402 // to be first class.
 403
 404 HpcModuleInfo *hs_hpc_rootModule(void) {
 405   return modules;
 406 }