new RTS flag: -V to modify the resolution of the RTS timer

Fixed version of an old patch by Simon Marlow. His description read:
 Also, now an arbitrarily short context switch interval may now be
 specified, as we increase the RTS ticker's resolution to match the
 requested context switch interval.  This also applies to +RTS -i (heap
 profiling) and +RTS -I (the idle GC timer).  +RTS -V is actually only
 required for increasing the resolution of the profile timer.

10 files changed, 80 insertions, 48 deletions

diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index dbaaae0fa2..990d6f31d9 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -1975,8 +1975,8 @@ delayzh_fast
 #else
 
     W_ time;
-    time = foreign "C" getourtimeofday();
-    target = (R1 / (TICK_MILLISECS*1000)) + time;
+    time = foreign "C" getourtimeofday() [R1];
+    target = (R1 / (TO_W_(RtsFlags_MiscFlags_tickInterval(RtsFlags))*1000)) + time;
     StgTSO_block_info(CurrentTSO) = target;
 
     /* Insert the new thread in the sleeping queue. */
diff --git a/rts/Profiling.c b/rts/Profiling.c
index 96a94e4e2e..695d66e019 100644
--- a/rts/Profiling.c
+++ b/rts/Profiling.c
@@ -277,7 +277,7 @@ initProfilingLogFile(void)
     if (RtsFlags.CcFlags.doCostCentres == COST_CENTRES_XML) {
 	/* dump the time, and the profiling interval */
 	fprintf(prof_file, "\"%s\"\n", time_str());
-	fprintf(prof_file, "\"%d ms\"\n", TICK_MILLISECS);
+	fprintf(prof_file, "\"%d ms\"\n", RtsFlags.MiscFlags.tickInterval);
 	
 	/* declare all the cost centres */
 	{
@@ -732,8 +732,10 @@ reportCCSProfiling( void )
     fprintf(prof_file, "\n\n");
 
     fprintf(prof_file, "\ttotal time  = %11.2f secs   (%lu ticks @ %d ms)\n",
-	    total_prof_ticks / (StgFloat) TICK_FREQUENCY, 
-	    total_prof_ticks, TICK_MILLISECS);
+	    (double) total_prof_ticks *
+        (double) RtsFlags.MiscFlags.tickInterval / 1000,
+	    (unsigned long) total_prof_ticks,
+        (int) RtsFlags.MiscFlags.tickInterval);
 
     fprintf(prof_file, "\ttotal alloc = %11s bytes",
 	    ullong_format_string(total_alloc * sizeof(W_),
diff --git a/rts/Proftimer.c b/rts/Proftimer.c
index 3b499152d6..ce20c491af 100644
--- a/rts/Proftimer.c
+++ b/rts/Proftimer.c
@@ -57,9 +57,6 @@ initProfTimer( void )
 {
     performHeapProfile = rtsFalse;
 
-    RtsFlags.ProfFlags.profileIntervalTicks = 
-	RtsFlags.ProfFlags.profileInterval / TICK_MILLISECS;
-
     ticks_to_heap_profile = RtsFlags.ProfFlags.profileIntervalTicks;
 
     startHeapProfTimer();
diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c
index 2bb061ad80..898acac344 100644
--- a/rts/RtsFlags.c
+++ b/rts/RtsFlags.c
@@ -12,7 +12,6 @@
 #include "RtsFlags.h"
 #include "RtsUtils.h"
 #include "BlockAlloc.h"
-#include "Timer.h"		/* CS_MIN_MILLISECS */
 #include "Profiling.h"
 
 #ifdef HAVE_CTYPE_H
@@ -150,7 +149,7 @@ void initRtsFlagsDefaults(void)
 #ifdef RTS_GTK_FRONTPANEL
     RtsFlags.GcFlags.frontpanel         = rtsFalse;
 #endif
-    RtsFlags.GcFlags.idleGCDelayTicks   = 300 / TICK_MILLISECS; /* ticks */
+    RtsFlags.GcFlags.idleGCDelayTime    = 300; /* millisecs */
 
 #ifdef DEBUG
     RtsFlags.DebugFlags.scheduler	= rtsFalse;
@@ -191,7 +190,8 @@ void initRtsFlagsDefaults(void)
     RtsFlags.ProfFlags.doHeapProfile      = rtsFalse;
 #endif
 
-    RtsFlags.ConcFlags.ctxtSwitchTime	= CS_MIN_MILLISECS;  /* In milliseconds */
+    RtsFlags.MiscFlags.tickInterval	= 50;  /* In milliseconds */
+    RtsFlags.ConcFlags.ctxtSwitchTime	= 50;  /* In milliseconds */
 
 #ifdef THREADED_RTS
     RtsFlags.ParFlags.nNodes	        = 1;
@@ -790,14 +790,9 @@ error = rtsTrue;
 		} else {
 		    I_ cst; /* tmp */
 
-		    /* Convert to ticks */
+		    /* Convert to millisecs */
 		    cst = (I_) ((atof(rts_argv[arg]+2) * 1000));
-		    if (cst > 0 && cst < TICK_MILLISECS) {
-			cst = TICK_MILLISECS;
-		    } else {
-			cst = cst / TICK_MILLISECS;
-		    }
-		    RtsFlags.GcFlags.idleGCDelayTicks = cst;
+		    RtsFlags.GcFlags.idleGCDelayTime = cst;
 		}
 		break;
 
@@ -993,10 +988,6 @@ error = rtsTrue;
 
 		    /* Convert to milliseconds */
 		    cst = (I_) ((atof(rts_argv[arg]+2) * 1000));
-		    cst = (cst / CS_MIN_MILLISECS) * CS_MIN_MILLISECS;
-		    if (cst != 0 && cst < CS_MIN_MILLISECS)
-			cst = CS_MIN_MILLISECS;
-
 		    RtsFlags.ProfFlags.profileInterval = cst;
 		}
 		break;
@@ -1011,14 +1002,23 @@ error = rtsTrue;
 
 		    /* Convert to milliseconds */
 		    cst = (I_) ((atof(rts_argv[arg]+2) * 1000));
-		    cst = (cst / CS_MIN_MILLISECS) * CS_MIN_MILLISECS;
-		    if (cst != 0 && cst < CS_MIN_MILLISECS)
-			cst = CS_MIN_MILLISECS;
-
 		    RtsFlags.ConcFlags.ctxtSwitchTime = cst;
 		}
     	    	break;
 
+              case 'V': /* master tick interval */
+                if (rts_argv[arg][2] == '\0') {
+                    // turns off ticks completely
+                    RtsFlags.MiscFlags.tickInterval = 0;
+                } else {
+                    I_ cst; /* tmp */
+
+                    /* Convert to milliseconds */
+                    cst = (I_) ((atof(rts_argv[arg]+2) * 1000));
+                    RtsFlags.MiscFlags.tickInterval = cst;
+                }
+                break;
+
 #if defined(THREADED_RTS) && !defined(NOSMP)
 	      case 'N':
 		THREADED_BUILD_ONLY(
@@ -1153,6 +1153,47 @@ error = rtsTrue;
 	    }
 	}
     }
+
+    // Determine what tick interval we should use for the RTS timer
+    // by taking the shortest of the various intervals that we need to
+    // monitor.
+    if (RtsFlags.MiscFlags.tickInterval <= 0) {
+        RtsFlags.MiscFlags.tickInterval = 50;
+    }
+
+    if (RtsFlags.ConcFlags.ctxtSwitchTime > 0) {
+        RtsFlags.MiscFlags.tickInterval =
+            stg_min(RtsFlags.ConcFlags.ctxtSwitchTime,
+                    RtsFlags.MiscFlags.tickInterval);
+    }
+
+    if (RtsFlags.GcFlags.idleGCDelayTime > 0) {
+        RtsFlags.MiscFlags.tickInterval =
+            stg_min(RtsFlags.GcFlags.idleGCDelayTime,
+                    RtsFlags.MiscFlags.tickInterval);
+    }
+
+#ifdef PROFILING
+    if (RtsFlags.ProfFlags.profileInterval > 0) {
+        RtsFlags.MiscFlags.tickInterval =
+            stg_min(RtsFlags.ProfFlags.profileInterval,
+                    RtsFlags.MiscFlags.tickInterval);
+    }
+#endif
+
+    if (RtsFlags.ConcFlags.ctxtSwitchTime > 0) {
+        RtsFlags.ConcFlags.ctxtSwitchTicks =
+            RtsFlags.ConcFlags.ctxtSwitchTime /
+            RtsFlags.MiscFlags.tickInterval;
+    } else {
+        RtsFlags.ConcFlags.ctxtSwitchTicks = 0;
+    }
+
+#ifdef PROFILING
+    RtsFlags.ProfFlags.profileIntervalTicks =
+        RtsFlags.ProfFlags.profileInterval / RtsFlags.MiscFlags.tickInterval;
+#endif
+
     if (error) {
 	const char **p;
 
diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c
index 2deb3d8e67..62a347a44d 100644
--- a/rts/RtsStartup.c
+++ b/rts/RtsStartup.c
@@ -210,7 +210,7 @@ hs_init(int *argc, char **argv[])
 #endif
 
     /* start the virtual timer 'subsystem'. */
-    startTimer(TICK_MILLISECS);
+    startTimer();
 
     /* Initialise the stats department */
     initStats();
diff --git a/rts/Schedule.c b/rts/Schedule.c
index 49e25be329..585ddec0ef 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -2509,9 +2509,6 @@ initScheduler(void)
   context_switch = 0;
   sched_state    = SCHED_RUNNING;
 
-  RtsFlags.ConcFlags.ctxtSwitchTicks =
-      RtsFlags.ConcFlags.ctxtSwitchTime / TICK_MILLISECS;
-      
 #if defined(THREADED_RTS)
   /* Initialise the mutex and condition variables used by
    * the scheduler. */
diff --git a/rts/Timer.c b/rts/Timer.c
index 90f89b1c06..d56fdb656f 100644
--- a/rts/Timer.c
+++ b/rts/Timer.c
@@ -54,20 +54,22 @@ handle_tick(int unused STG_UNUSED)
 
 #if defined(THREADED_RTS)
   /* 
-   * If we've been inactive for idleGCDelayTicks (set by +RTS
+   * If we've been inactive for idleGCDelayTime (set by +RTS
    * -I), tell the scheduler to wake up and do a GC, to check
    * for threads that are deadlocked.
    */
   switch (recent_activity) {
   case ACTIVITY_YES:
       recent_activity = ACTIVITY_MAYBE_NO;
-      ticks_to_gc = RtsFlags.GcFlags.idleGCDelayTicks;
+      ticks_to_gc = RtsFlags.GcFlags.idleGCDelayTime /
+                    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.idleGCDelayTicks;
+	  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 */
@@ -81,17 +83,17 @@ handle_tick(int unused STG_UNUSED)
 }
 
 int
-startTimer(nat ms)
+startTimer(void)
 {
 #ifdef PROFILING
   initProfTimer();
 #endif
 
-  return startTicker(ms, handle_tick);
+  return startTicker(RtsFlags.MiscFlags.tickInterval, handle_tick);
 }
 
 int
-stopTimer()
+stopTimer(void)
 {
   return stopTicker();
 }
diff --git a/rts/Timer.h b/rts/Timer.h
index ae26653462..1fe857d969 100644
--- a/rts/Timer.h
+++ b/rts/Timer.h
@@ -1,6 +1,6 @@
 /* -----------------------------------------------------------------------------
  *
- * (c) The GHC Team, 1995-2005
+ * (c) The GHC Team, 1995-2006
  *
  * Interval timer service for profiling and pre-emptive scheduling.
  *
@@ -9,16 +9,9 @@
 #ifndef TIMER_H
 #define TIMER_H
 
-# define TICK_MILLISECS   (1000/TICK_FREQUENCY)   /* ms per tick */
-
-/* Context switch timing constants. Context switches happen after a
- * whole number of ticks, the default being every tick.
- */
-#define CS_MIN_MILLISECS TICK_MILLISECS       /* milliseconds per slice */
-
 typedef void (*TickProc)(int);
 
-extern int startTimer(nat ms);
+extern int startTimer(void);
 extern int stopTimer(void);
 
 #endif /* TIMER_H */
diff --git a/rts/posix/Itimer.c b/rts/posix/Itimer.c
index 83ed84d6ef..0f0b1e977e 100644
--- a/rts/posix/Itimer.c
+++ b/rts/posix/Itimer.c
@@ -221,6 +221,6 @@ getourtimeofday(void)
   struct timeval tv;
   gettimeofday(&tv, (struct timezone *) NULL);
   	// cast to lnat because nat may be 64 bit when int is only 32 bit
-  return ((lnat)tv.tv_sec * TICK_FREQUENCY +
-	  (lnat)tv.tv_usec * TICK_FREQUENCY / 1000000);
+  return ((lnat)tv.tv_sec * 1000 / RtsFlags.MiscFlags.tickInterval +
+	  (lnat)tv.tv_usec / (RtsFlags.MiscFlags.tickInterval * 1000));
 }
diff --git a/rts/posix/Select.c b/rts/posix/Select.c
index 0dbacef7a8..ccf39458d2 100644
--- a/rts/posix/Select.c
+++ b/rts/posix/Select.c
@@ -126,7 +126,7 @@ awaitEvent(rtsBool wait)
 	  min = 0;
       } else if (sleeping_queue != END_TSO_QUEUE) {
 	  min = (sleeping_queue->block_info.target - ticks) 
-	      * TICK_MILLISECS * 1000;
+	      * RtsFlags.MiscFlags.tickInterval * 1000;
       } else {
 	  min = 0x7ffffff;
       }