* (c)2006 Galois Connections, Inc.
*/
-// #include "HsFFI.h"
-
#include <stdio.h>
#include <ctype.h>
#include <stdlib.h>
#include <string.h>
#include <assert.h>
#include "HsFFI.h"
+
#include "Rts.h"
#include "Hpc.h"
static int tix_ch; // current char
static StgWord64 magicTixNumber; // Magic/Hash number to mark .tix files
+static FILE *rixFile = NULL; // The tracer file/pipe
+
typedef struct _Info {
char *modName; // name of module
int tickCount; // number of ticks
* of the tix file, or all zeros.
*/
-void
+int
hs_hpc_module(char *modName,int modCount,StgWord64 *tixArr) {
Info *tmpModule, *lastModule;
int i;
+ int offset = 0;
#if DEBUG_HPC
printf("hs_hpc_module(%s,%d)\n",modName,modCount);
for(i=0;i < modCount;i++) {
tixArr[i] = tixBoxes[i + tmpModule->tickOffset];
}
- return;
+ return tmpModule->tickOffset;
}
lastModule = tmpModule;
}
#if DEBUG_HPC
printf("end: hs_hpc_module\n");
#endif
+ 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 = tid;
+ // How do we print StgWord32's without a cast?
+ fprintf(rixFile,"Thread Switch %d\n",(unsigned int)tid);
+ }
+}
+
+/*
+ * Called on *every* exception thrown
+ */
+void
+hs_hpc_event(char *msg,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.
+
+ // 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,"%s\n",msg);
+ }
+}
+
+/* Called on every tick, dynamically to our file record of program execution
+ */
+
+void
+hs_hpc_tick(int globIx, StgTSO *current_tso) {
+#if DEBUG_HPC && DEBUG
+ printf("hs_hpc_tick(%d)\n",globIx);
+#endif
+ assert(hpc_inited != 0);
+ if (rixFile != NULL) {
+ send_ThreadId(current_tso);
+ fprintf(rixFile,"%d\n",globIx);
+ }
+
+#if DEBUG_HPC
+ printf("end: hs_hpc_tick\n");
+#endif
+
}
/* This is called after all the modules have registered their local tixboxes,
void
startupHpc(void) {
Info *tmpModule;
+ char *hpcRix;
#if DEBUG_HPC
printf("startupHpc\n");
#endif
}
}
}
+
+ // 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);
+ }
+
}
+
/* 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.
*/
fprintf(f,"]\n");
fclose(f);
+
+ if (rixFile != NULL) {
+ fprintf(rixFile,"Finished\n");
+ fclose(rixFile);
+ }
}