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.

diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c
index 5104721..cdb45c6 100644 (file)
--- a/rts/RtsStartup.c
+++ b/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);

diff --git a/rts/Schedule.c b/rts/Schedule.c
index 8bd4241..b68e1ac 100644 (file)
--- a/rts/Schedule.c
+++ b/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

diff --git a/rts/Ticker.h b/rts/Ticker.h
index b06890a..a39e7d6 100644 (file)
--- a/rts/Ticker.h
+++ b/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 */

diff --git a/rts/Timer.c b/rts/Timer.c
index 586991a..9822239 100644 (file)
--- a/rts/Timer.c
+++ b/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:
@@ -82,18 +88,34 @@ handle_tick(int unused STG_UNUSED)
 }
 
 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();
+    }
 }

diff --git a/rts/Timer.h b/rts/Timer.h
index 6d3c415..59b695c 100644 (file)
--- a/rts/Timer.h
+++ b/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 */

diff --git a/rts/posix/Itimer.c b/rts/posix/Itimer.c
index df95f21..51e08f8 100644 (file)
--- a/rts/posix/Itimer.c
+++ b/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

diff --git a/rts/win32/Ticker.c b/rts/win32/Ticker.c
index 5b41494..d425dd5 100644 (file)
--- 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);