Profiling: Allow heap profiling to be controlled dynamically.

This patch exposes three new functions in `GHC.Profiling` which allow
heap profiling to be enabled and disabled dynamically.

1. startHeapProfTimer - Starts heap profiling with the given RTS options
2. stopHeapProfTimer  - Stops heap profiling
3. requestHeapCensus  - Perform a heap census on the next context
                        switch, regardless of whether the timer is enabled or not.

6 files changed, 60 insertions, 11 deletions

diff --git a/rts/Proftimer.c b/rts/Proftimer.c
index 00b92a227d..29abb62a8e 100644
--- a/rts/Proftimer.c
+++ b/rts/Proftimer.c
@@ -18,7 +18,12 @@
 static bool do_prof_ticks = false;       // enable profiling ticks
 #endif
 
-static bool do_heap_prof_ticks = false;  // enable heap profiling ticks
+static bool do_heap_prof_ticks = false;  // Whether the timer is currently ticking down
+static bool heap_prof_timer_active = false;  // Whether the timer is enabled at all
+
+/* The heap_prof_timer_active flag controls whether heap profiling is enabled
+at all, once it is enabled, the `do_heap_prof_ticks` flag controls whether the
+counter is currently counting down. This is paused, for example, in Schedule.c. */
 
 // Sampling of Ticky-Ticky profiler to eventlog
 #if defined(TICKY_TICKY) && defined(TRACING)
@@ -51,26 +56,56 @@ startProfTimer( void )
 void
 stopHeapProfTimer( void )
 {
-    RELAXED_STORE(&do_heap_prof_ticks, false);
+  if (RtsFlags.ProfFlags.doHeapProfile){
+    RELAXED_STORE(&heap_prof_timer_active, false);
+    pauseHeapProfTimer();
+  }
 }
 
 void
 startHeapProfTimer( void )
 {
+  if (RtsFlags.ProfFlags.doHeapProfile){
+    RELAXED_STORE(&heap_prof_timer_active, true);
+    resumeHeapProfTimer();
+  }
+}
+
+void
+pauseHeapProfTimer ( void ) {
+    RELAXED_STORE(&do_heap_prof_ticks, false);
+}
+
+
+void
+resumeHeapProfTimer ( void ) {
     if (RtsFlags.ProfFlags.doHeapProfile &&
         RtsFlags.ProfFlags.heapProfileIntervalTicks > 0) {
-        do_heap_prof_ticks = true;
+        RELAXED_STORE(&do_heap_prof_ticks, true);
     }
 }
 
 void
+requestHeapCensus( void ){
+  // If no profiling mode is passed then just ignore the call.
+  if (RtsFlags.ProfFlags.doHeapProfile){
+    RELAXED_STORE(&performHeapProfile, true);
+  }
+}
+
+void
 initProfTimer( void )
 {
     performHeapProfile = false;
 
     ticks_to_heap_profile = RtsFlags.ProfFlags.heapProfileIntervalTicks;
 
-    startHeapProfTimer();
+    /* This might look a bit strange but the heap profile timer can
+      be toggled on/off from within Haskell by calling the startHeapProf
+      function from within Haskell */
+    if (RtsFlags.ProfFlags.startHeapProfileAtStartup){
+      startHeapProfTimer();
+    }
 }
 
 uint32_t total_ticks = 0;
@@ -99,7 +134,7 @@ handleProfTick(void)
     }
 #endif
 
-    if (RELAXED_LOAD(&do_heap_prof_ticks)) {
+    if (RELAXED_LOAD(&do_heap_prof_ticks) && RELAXED_LOAD(&heap_prof_timer_active))  {
         ticks_to_heap_profile--;
         if (ticks_to_heap_profile <= 0) {
             ticks_to_heap_profile = RtsFlags.ProfFlags.heapProfileIntervalTicks;
diff --git a/rts/Proftimer.h b/rts/Proftimer.h
index ad50ccb9a6..f4432e46bc 100644
--- a/rts/Proftimer.h
+++ b/rts/Proftimer.h
@@ -12,9 +12,8 @@
 
 void initProfTimer      ( void );
 void handleProfTick     ( void );
-
-void stopHeapProfTimer  ( void );
-void startHeapProfTimer ( void );
+void pauseHeapProfTimer  ( void );
+void resumeHeapProfTimer ( void );
 
 extern bool performHeapProfile;
 extern bool performTickySample;
diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c
index a5ec423f8d..bc7e86901f 100644
--- a/rts/RtsFlags.c
+++ b/rts/RtsFlags.c
@@ -212,6 +212,7 @@ void initRtsFlagsDefaults(void)
 
     RtsFlags.ProfFlags.doHeapProfile      = false;
     RtsFlags.ProfFlags.heapProfileInterval = USToTime(100000); // 100ms
+    RtsFlags.ProfFlags.startHeapProfileAtStartup = true;
 
 #if defined(PROFILING)
     RtsFlags.ProfFlags.showCCSOnException = false;
@@ -391,6 +392,11 @@ usage_text[] = {
 "  -hT      Produce a heap profile grouped by closure type",
 #endif /* PROFILING */
 
+"  -i<sec>  Time between heap profile samples (seconds, default: 0.1)",
+"  --no-automatic-heap-samples  Do not start the heap profile interval timer on start-up,",
+"                               Rather, the application will be responsible for triggering",
+"                               heap profiler samples."
+
 #if defined(TRACING)
 "",
 "  -ol<file>  Send binary eventlog to <file> (default: <program>.eventlog)",
@@ -416,7 +422,6 @@ usage_text[] = {
 "             the initial enabled event classes are 'sgpu'",
 #endif
 
-"  -i<sec>  Time between heap profile samples (seconds, default: 0.1)",
 "",
 #if defined(TICKY_TICKY)
 "  -r<file>  Produce ticky-ticky statistics (with -rstderr for stderr)",
@@ -1091,6 +1096,12 @@ error = true;
                       }
                       break;
                   }
+                  else if (strequal("no-automatic-heap-samples",
+                               &rts_argv[arg][2])) {
+                      OPTION_SAFE;
+                      RtsFlags.ProfFlags.startHeapProfileAtStartup = false;
+                      break;
+                  }
                   else {
                       OPTION_SAFE;
                       errorBelch("unknown RTS option: %s",rts_argv[arg]);
diff --git a/rts/RtsSymbols.c b/rts/RtsSymbols.c
index 7ea833ce55..989b878b56 100644
--- a/rts/RtsSymbols.c
+++ b/rts/RtsSymbols.c
@@ -984,6 +984,9 @@
       SymI_HasProto(unlockFile)                                         \
       SymI_HasProto(startProfTimer)                                     \
       SymI_HasProto(stopProfTimer)                                      \
+      SymI_HasProto(startHeapProfTimer)                                 \
+      SymI_HasProto(stopHeapProfTimer)                                  \
+      SymI_HasProto(requestHeapCensus)                                  \
       SymI_HasProto(atomic_inc)                                         \
       SymI_HasProto(atomic_dec)                                         \
       SymI_HasProto(hs_spt_lookup)                                      \
diff --git a/rts/Schedule.c b/rts/Schedule.c
index 390e505cf2..d9d5c9a74a 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -416,7 +416,7 @@ run_thread:
     // that.
     cap->r.rCurrentTSO = t;
 
-    startHeapProfTimer();
+    resumeHeapProfTimer();
 
     // ----------------------------------------------------------------------
     // Run the current thread
@@ -534,7 +534,7 @@ run_thread:
     // ----------------------------------------------------------------------
 
     // Costs for the scheduler are assigned to CCS_SYSTEM
-    stopHeapProfTimer();
+    pauseHeapProfTimer();
 #if defined(PROFILING)
     cap->r.rCCCS = CCS_SYSTEM;
 #endif
diff --git a/rts/rts.cabal.in b/rts/rts.cabal.in
index a1d0ce39a2..108b4d6b9b 100644
--- a/rts/rts.cabal.in
+++ b/rts/rts.cabal.in
@@ -180,6 +180,7 @@ library
                       rts/Types.h
                       rts/Utils.h
                       rts/prof/CCS.h
+                      rts/prof/Heap.h
                       rts/prof/LDV.h
                       rts/storage/Block.h
                       rts/storage/ClosureMacros.h