Misc Hpc improvement to dynamic tracer output

 - Added HPCRIX support for passing tracer filename.
 - Added thread tracing support.
 - Cleaned up use of HsFFI.h

compiler/codeGen/CgHpc.hs

@@ -48,7 +48,11 @@ cgTickBox mod n = do
                      [ CmmLoad ext_tick_box I32
                      , CmmLit (CmmInt (fromIntegral n) I32)
 		     ]
-		  ,  NoHint) ]
+		  ,  NoHint)
+	       ,  ( CmmReg (CmmGlobal CurrentTSO)
+		  , PtrHint 
+		  )
+	       ]
                (Just [])
    where
       visible_tick = mkFastString "hs_hpc_tick"

includes/HsFFI.h

@@ -158,10 +158,6 @@ extern void hs_perform_gc (void);
 extern void hs_free_stable_ptr (HsStablePtr sp);
 extern void hs_free_fun_ptr    (HsFunPtr fp);
 
-extern int hs_hpc_module(char *modName,int modCount,StgWord64 *tixArr);
-extern void hs_hpc_tick(int globIx);
-extern void hs_hpc_throw(void);
-
 /* -------------------------------------------------------------------------- */
 
 #ifdef __cplusplus

includes/RtsExternal.h

@@ -66,6 +66,12 @@ extern void*  createAdjustor(int cconv, StgStablePtr hptr, StgFunPtr wptr,
                              char *typeString);
 extern void   freeHaskellFunctionPtr(void* ptr);
 
+/* Hpc stuff */
+extern int hs_hpc_module(char *modName,int modCount,StgWord64 *tixArr);
+extern void hs_hpc_tick(int globIx,struct StgTSO_ *current_tso);
+extern void hs_hpc_throw(struct StgTSO_ *current_tso);
+
+
 #if defined(mingw32_HOST_OS)
 extern int  rts_InstallConsoleEvent ( int action, StgStablePtr *handler );
 extern void rts_ConsoleHandlerDone  ( int ev );

rts/Exception.cmm

@@ -338,7 +338,7 @@ raisezh_fast
 #endif
     
     /* Inform the Hpc that an exception has been thrown */
-    foreign "C" hs_hpc_throw();
+    foreign "C" hs_hpc_throw(CurrentTSO);
 
 retry_pop_stack:
     StgTSO_sp(CurrentTSO) = Sp;

rts/Hpc.c

@@ -24,8 +24,7 @@ static FILE *tixFile;			// file being read/written
 static int tix_ch;			// current char
 static StgWord64 magicTixNumber;	// Magic/Hash number to mark .tix files
 
-static int hpc_ticks_inited = 0;	// Have you started the dynamic external ticking?
-static FILE *rixFile;			// The tracer file/pipe
+static FILE *rixFile = NULL;		// The tracer file/pipe
 
 typedef struct _Info {
   char *modName;		// name of module
@@ -245,72 +244,51 @@ hs_hpc_module(char *modName,int modCount,StgWord64 *tixArr) {
   return offset;
 }
 
+static StgThreadID previous_tid = 0;
+
+static void 
+send_ThreadId(StgTSO *current_tso) {
+  // This assumes that there is no real thread 0.
+  StgThreadID tid = (current_tso == 0) ? 0 : current_tso->id;
+  if (tid != previous_tid) {
+    previous_tid = current_tso->id;
+    // How do we print StgWord32's without a cast?
+    fprintf(rixFile,"Thread %d\n",(unsigned int)tid);
+  }
+}
 
 /*
  * Called on *every* exception thrown
  */
 void
-hs_hpc_throw() {
+hs_hpc_throw(StgTSO *current_tso) {
   // Assumes that we have had at least *one* tick first.
   // All exceptions before the first tick are not reported.
   // The only time this might be an issue is in bootstrapping code,
   // so this is a feature.
-  if (hpc_inited != 0 && hpc_ticks_inited != 0) {
+
+  // This is called on *every* exception, even when Hpc is not enabled.
+
+  if (rixFile != NULL) {
+    assert(hpc_inited != 0);
+    send_ThreadId(current_tso);
     fprintf(rixFile,"Throw\n");
   }
 }
 
-/* Called on every tick
+/* Called on every tick, dynamically to our file record of program execution
  */
 
 void
-hs_hpc_tick(int globIx) {
-  int threadId = 0;	 // for now, assume single thread
-			 // TODO: work out how to get the thread Id to here.
-
-  
+hs_hpc_tick(int globIx, StgTSO *current_tso) {
 #if DEBUG_HPC && DEBUG
   printf("hs_hpc_tick(%d)\n",globIx);
 #endif
-  if (!hpc_ticks_inited) {
-    char* trace_filename;
-    int comma;
-    Info *tmpModule;  
-
-    assert(hpc_inited);
-    hpc_ticks_inited = 1;
-
-    trace_filename = (char *) malloc(strlen(prog_name) + 6);
-    sprintf(trace_filename, "%s.rix", prog_name);
-    rixFile = fopen(trace_filename,"w+");
-
-    comma = 0;
-    
-    fprintf(rixFile,"START %s\n",prog_name);
-    fprintf(rixFile,"[");
-    tmpModule = modules;
-    for(;tmpModule != 0;tmpModule = tmpModule->next) {
-      if (comma) {
-	fprintf(rixFile,",");
-      } else {
-	comma = 1;
-      }
-      fprintf(rixFile,"(\"%s\",%u)",
-	      tmpModule->modName,
-	      tmpModule->tickCount);
-#if DEBUG_HPC
-      fprintf(stderr,"(tracer)%s: %u (offset=%u)\n",
-	      tmpModule->modName,
-	      tmpModule->tickCount,
-	      tmpModule->tickOffset);
-#endif
-    }
-    fprintf(rixFile,"]\n");
-    fflush(rixFile);
+  assert(hpc_inited != 0);
+  if (rixFile != NULL) {
+    send_ThreadId(current_tso);
+    fprintf(rixFile,"%d\n",globIx);
   }
-  assert(rixFile != 0);
-
-  fprintf(rixFile,"%d\n",globIx);
 
 #if DEBUG_HPC
   printf("end: hs_hpc_tick\n");
@@ -325,6 +303,7 @@ hs_hpc_tick(int globIx) {
 void
 startupHpc(void) {
   Info *tmpModule;
+  char *hpcRix;
 #if DEBUG_HPC
   printf("startupHpc\n");
 #endif
@@ -345,6 +324,43 @@ startupHpc(void) {
       }
     }
   }
+
+  // HPCRIX contains the name of the file to send our dynamic runtime output to.
+  // This might be a real file, or perhaps a named pipe.
+  hpcRix = getenv("HPCRIX");
+  if (hpcRix) {
+    int comma;
+    Info *tmpModule;  
+
+    assert(hpc_inited);
+
+    rixFile = fopen(hpcRix,"w");
+
+    comma = 0;
+    
+    fprintf(rixFile,"Starting %s\n",prog_name);
+    fprintf(rixFile,"[");
+    tmpModule = modules;
+    for(;tmpModule != 0;tmpModule = tmpModule->next) {
+      if (comma) {
+	fprintf(rixFile,",");
+      } else {
+	comma = 1;
+      }
+      fprintf(rixFile,"(\"%s\",%u)",
+	      tmpModule->modName,
+	      tmpModule->tickCount);
+#if DEBUG_HPC
+      fprintf(stderr,"(tracer)%s: %u (offset=%u)\n",
+	      tmpModule->modName,
+	      tmpModule->tickCount,
+	      tmpModule->tickOffset);
+#endif
+    }
+    fprintf(rixFile,"]\n");
+    fflush(rixFile);
+  }
+
 }
 
 
@@ -415,7 +431,8 @@ exitHpc(void) {
   fprintf(f,"]\n");
   fclose(f);
 
-  if (hpc_ticks_inited && rixFile != 0) {
+  if (rixFile != NULL) {
+    fprintf(rixFile,"Finished\n",prog_name);
     fclose(rixFile);
   }