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.

rts/RtsStartup.c

@@ -246,6 +246,7 @@ hs_init(int *argc, char **argv[])
     initProfiling1();
 
     /* start the virtual timer 'subsystem'. */
+    initTimer();
     startTimer();
 
     /* Initialise the stats department */
@@ -409,6 +410,7 @@ hs_exit_(rtsBool wait_foreign)
     
     /* stop the ticker */
     stopTimer();
+    exitTimer();
 
     /* reset the standard file descriptors to blocking mode */
     resetNonBlockingFd(0);

rts/Schedule.c

@@ -593,7 +593,19 @@ run_thread:
 
     dirtyTSO(t);
 
-    recent_activity = ACTIVITY_YES;
+#if defined(THREADED_RTS)
+    if (recent_activity == ACTIVITY_DONE_GC) {
+        // ACTIVITY_DONE_GC means we turned off the timer signal to
+        // conserve power (see #1623).  Re-enable it here.
+        nat prev;
+        prev = xchg(&recent_activity, ACTIVITY_YES);
+        if (prev == ACTIVITY_DONE_GC) {
+            startTimer();
+        }
+    } else {
+        recent_activity = ACTIVITY_YES;
+    }
+#endif
 
     switch (prev_what_next) {
 	
@@ -974,6 +986,8 @@ scheduleDetectDeadlock (Capability *cap, Task *task)
 	cap = scheduleDoGC (cap, task, rtsTrue/*force  major GC*/);
 
 	recent_activity = ACTIVITY_DONE_GC;
+        // disable timer signals (see #1623)
+        stopTimer();
 	
 	if ( !emptyRunQueue(cap) ) return;
 
@@ -2185,6 +2199,7 @@ forkProcess(HsStablePtr *entry
 
         // On Unix, all timers are reset in the child, so we need to start
         // the timer again.
+        initTimer();
         startTimer();
 
 	cap = rts_evalStableIO(cap, entry, NULL);  // run the action
@@ -2531,6 +2546,7 @@ initScheduler(void)
 
   context_switch = 0;
   sched_state    = SCHED_RUNNING;
+  recent_activity = ACTIVITY_YES;
 
 #if defined(THREADED_RTS)
   /* Initialise the mutex and condition variables used by

rts/Ticker.h

@@ -2,14 +2,18 @@
  *
  * (c) The GHC Team 2005
  *
- * Ticker interface (implementation is OS-specific)
+ * Interface to the OS-specific implementation of a regular time signal.
  *
  * ---------------------------------------------------------------------------*/
 
 #ifndef TICKER_H
 #define TICKER_H
 
-extern void startTicker( nat ms, TickProc handle_tick );
-extern void stopTicker ( void );
+typedef void (*TickProc)(int);
+
+extern void initTicker  (nat ms, TickProc handle_tick);
+extern void startTicker (void);
+extern void stopTicker  (void);
+extern void exitTicker  (void);
 
 #endif /* TICKER_H */

rts/Timer.c

@@ -64,15 +64,21 @@ handle_tick(int unused STG_UNUSED)
                     RtsFlags.MiscFlags.tickInterval;
       break;
   case ACTIVITY_MAYBE_NO:
-      if (ticks_to_gc == 0) break; /* 0 ==> no idle GC */
-      ticks_to_gc--;
       if (ticks_to_gc == 0) {
-	  ticks_to_gc = RtsFlags.GcFlags.idleGCDelayTime /
-                        RtsFlags.MiscFlags.tickInterval;
-	  recent_activity = ACTIVITY_INACTIVE;
-	  blackholes_need_checking = rtsTrue;
-	  /* hack: re-use the blackholes_need_checking flag */
-	  wakeUpRts();
+          /* 0 ==> no idle GC */
+          recent_activity = ACTIVITY_DONE_GC;
+          // disable timer signals (see #1623)
+          stopTimer();
+      } else {
+          ticks_to_gc--;
+          if (ticks_to_gc == 0) {
+              ticks_to_gc = RtsFlags.GcFlags.idleGCDelayTime /
+                  RtsFlags.MiscFlags.tickInterval;
+              recent_activity = ACTIVITY_INACTIVE;
+              blackholes_need_checking = rtsTrue;
+              /* hack: re-use the blackholes_need_checking flag */
+              wakeUpRts();
+          }
       }
       break;
   default:
@@ -81,19 +87,35 @@ handle_tick(int unused STG_UNUSED)
 #endif
 }
 
+void
+initTimer(void)
+{
+    initProfTimer();
+    if (RtsFlags.MiscFlags.tickInterval != 0) {
+        initTicker(RtsFlags.MiscFlags.tickInterval, handle_tick);
+    }
+}
+
 void
 startTimer(void)
 {
-  initProfTimer();
-  if (RtsFlags.MiscFlags.tickInterval != 0) {
-      startTicker(RtsFlags.MiscFlags.tickInterval, handle_tick);
-  }
+    if (RtsFlags.MiscFlags.tickInterval != 0) {
+        startTicker();
+    }
 }
 
 void
 stopTimer(void)
 {
-  if (RtsFlags.MiscFlags.tickInterval != 0) {
-      stopTicker();
-  }
+    if (RtsFlags.MiscFlags.tickInterval != 0) {
+        stopTicker();
+    }
+}
+
+void
+exitTimer(void)
+{
+    if (RtsFlags.MiscFlags.tickInterval != 0) {
+        exitTicker();
+    }
 }

rts/Timer.h

@@ -2,16 +2,16 @@
  *
  * (c) The GHC Team, 1995-2006
  *
- * Interval timer service for profiling and pre-emptive scheduling.
+ * Interface to the RTS timer signal (uses OS-dependent Ticker.h underneath)
  *
  * ---------------------------------------------------------------------------*/
 
 #ifndef TIMER_H
 #define TIMER_H
 
-typedef void (*TickProc)(int);
-
+extern void initTimer(void);
 extern void startTimer(void);
 extern void stopTimer(void);
+extern void exitTimer(void);
 
 #endif /* TIMER_H */

rts/posix/Itimer.c

@@ -127,7 +127,7 @@ install_vtalrm_handler(TickProc handle_tick)
 }
 
 void
-startTicker(nat ms, TickProc handle_tick)
+initTicker (TickProc handle_tick)
 {
     install_vtalrm_handler(handle_tick);
 
@@ -137,21 +137,30 @@ startTicker(nat ms, TickProc handle_tick)
 
 #if defined(USE_TIMER_CREATE)
     {
-        struct itimerspec it;
         struct sigevent ev;
 
         ev.sigev_notify = SIGEV_SIGNAL;
         ev.sigev_signo  = ITIMER_SIGNAL;
-        
-        it.it_value.tv_sec = ms / 1000;
-        it.it_value.tv_nsec = (ms % 1000) * 1000000;
-        it.it_interval = it.it_value;
-        
+
         if (timer_create(TIMER_FLAVOUR, &ev, &timer) != 0) {
             sysErrorBelch("timer_create");
             stg_exit(EXIT_FAILURE);
         }
+    }
+#endif
+}
 
+void
+startTicker(nat ms)
+{
+#if defined(USE_TIMER_CREATE)
+    {
+        struct itimerspec it;
+        
+        it.it_value.tv_sec = ms / 1000;
+        it.it_value.tv_nsec = (ms % 1000) * 1000000;
+        it.it_interval = it.it_value;
+        
         if (timer_settime(timer, 0, &it, NULL) != 0) {
             sysErrorBelch("timer_settime");
             stg_exit(EXIT_FAILURE);
@@ -201,6 +210,13 @@ stopTicker(void)
 #endif
 }
 
+void
+exitTicker(void)
+{
+    timer_delete(timer);
+    // ignore errors - we don't really care if it fails.
+}
+
 #if 0
 /* Currently unused */
 void

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,
@@ -102,8 +116,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
@@ -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);