FIX #1623: disable the timer signal when the system is idle (threaded RTS only)

Having a timer signal go off regularly is bad for power consumption,
and generally bad practice anyway (it means the app cannot be
completely swapped out, for example).  Fortunately the threaded RTS
already had a way to detect when the system was idle, so that it can
trigger a GC and thereby find deadlocks.  After performing the GC, we
now turn off timer signals, and re-enable them again just before
running any Haskell code.

1 files changed, 57 insertions, 28 deletions

diff --git a/rts/win32/Ticker.c b/rts/win32/Ticker.c
index 5b41494d47..d425dd58ab 100644
--- a/rts/win32/Ticker.c
+++ b/rts/win32/Ticker.c
@@ -16,15 +16,16 @@
  *
  */
 
-/* To signal shutdown of the timer service, we use a local
- * event which the timer thread listens to (and stopVirtTimer()
- * signals.)
+/* To signal pause or shutdown of the timer service, we use a local
+ * event which the timer thread listens to.
  */
 static HANDLE hStopEvent = INVALID_HANDLE_VALUE;
 static HANDLE tickThread = INVALID_HANDLE_VALUE;
 
 static TickProc tickProc = NULL;
 
+static enum { TickerGo, TickerPause, TickerExit } ticker_state;
+
 /*
  * Ticking is done by a separate thread which periodically
  * wakes up to handle a tick.
@@ -44,38 +45,49 @@ TimerProc(PVOID param)
   DWORD waitRes;
   
   /* interpret a < 0 timeout period as 'instantaneous' */ 
- if (ms < 0) ms = 0;
+  if (ms < 0) ms = 0;
 
   while (1) {
-    waitRes = WaitForSingleObject(hStopEvent, ms);
-    
-    switch (waitRes) {
-    case WAIT_OBJECT_0:
-      /* event has become signalled */
-      tickProc = NULL;
-      CloseHandle(hStopEvent);
-      hStopEvent = INVALID_HANDLE_VALUE;
-      return 0;
-    case WAIT_TIMEOUT:
-      /* tick */
-      tickProc(0);
-      break;
-    case WAIT_FAILED: {
-	DWORD dw = GetLastError();
-	fprintf(stderr, "TimerProc: wait failed -- error code: %lu\n", dw); fflush(stderr);
-	break; 
-    }
-    default:
-      fprintf(stderr, "TimerProc: unexpected result %lu\n", waitRes); fflush(stderr);
-      break;
-    }
+      switch (ticker_state) {
+      case TickerGo:
+          waitRes = WaitForSingleObject(hStopEvent, ms);
+          break;
+      case TickerPause:
+          debugBelch("tick: pause");
+          waitRes = WaitForSingleObject(hStopEvent, INFINITE);
+          debugBelch("tick: wakeup");
+          break;
+      case TickerExit:
+          /* event has become signalled */
+          tickProc = NULL;
+          CloseHandle(hStopEvent);
+          hStopEvent = INVALID_HANDLE_VALUE;
+          return 0;
+      }
+      
+      switch (waitRes) {
+      case WAIT_OBJECT_0:
+          /* event has become signalled */
+          ResetEvent(hStopEvent);
+          continue;
+      case WAIT_TIMEOUT:
+          /* tick */
+          tickProc(0);
+          break;
+      case WAIT_FAILED:
+          sysErrorBelch("TimerProc: WaitForSingleObject failed");
+          break; 
+      default:
+          errorBelch("TimerProc: unexpected result %lu\n", waitRes);
+          break;
+      }
   }
   return 0;
 }
 
 
 void
-startTicker(nat ms, TickProc handle_tick)
+initTicker (nat ms, TickProc handle_tick)
 {
   unsigned threadId;
   /* 'hStopEvent' is a manual-reset event that's signalled upon
@@ -86,9 +98,11 @@ startTicker(nat ms, TickProc handle_tick)
 			     FALSE,
 			     NULL);
   if (hStopEvent == INVALID_HANDLE_VALUE) {
-    return 0;
+      sysErrorBelch("CreateEvent");
+      stg_exit(EXIT_FAILURE);
   }
   tickProc = handle_tick;
+  ticker_state = TickerPause;
   tickThread = (HANDLE)(long)_beginthreadex( NULL,
 			       0,
 			       TimerProc,
@@ -103,8 +117,22 @@ startTicker(nat ms, TickProc handle_tick)
 }
 
 void
+startTicker(void)
+{
+    ticker_state = TickerGo;
+    SetEvent(hStopEvent);
+}
+
+void
 stopTicker(void)
 {
+    ticker_state = TickerPause;
+    SetEvent(hStopEvent);
+}
+
+void
+exitTicker(void)
+{
     // We must wait for the ticker thread to terminate, since if we
     // are in a DLL that is about to be unloaded, the ticker thread
     // cannot be allowed to return to a missing DLL.
@@ -112,6 +140,7 @@ stopTicker(void)
     if (hStopEvent != INVALID_HANDLE_VALUE && 
 	tickThread != INVALID_HANDLE_VALUE) {
 	DWORD exitCode;
+        ticker_state = TickerExit;
 	SetEvent(hStopEvent);
 	while (1) {
 	    WaitForSingleObject(tickThread, 20);