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.

diff --git a/docs/users_guide/runtime_control.xml b/docs/users_guide/runtime_control.xml
index 6a3a9e3..e15d5cc 100644 (file)
--- a/docs/users_guide/runtime_control.xml
+++ b/docs/users_guide/runtime_control.xml
@@ -85,6 +85,34 @@
 
   </sect2>
 
+  <sect2 id="rts-options-misc">
+    <title>Miscellaneous RTS options</title>
+
+    <variablelist>
+     <varlistentry>
+       <term><option>-V<replaceable>secs</replaceable></option></term>
+       <indexterm><primary><option>-V</option></primary><secondary>RTS
+       option</secondary></indexterm>
+       <listitem>
+         <para>Sets the interval that the RTS clock ticks at.  The
+         runtime uses a single timer signal to count ticks; this timer
+         signal is used to control the context switch timer (<xref
+         linkend="sec-using-concurrent" />) and the heap profiling
+         timer <xref linkend="rts-options-heap-prof" />.  Also, the
+         time profiler uses the RTS timer signal directly to record
+         time profiling samples.</para>
+
+         <para>Normally, setting the <option>-V</option> option
+         directly is not necessary: the resolution of the RTS timer is
+         adjusted automatically if a short interval is requested with
+         the <option>-C</option> or <option>-i</option> options.
+         However, setting <option>-V</option> is required in order to
+         increase the resolution of the time profiler.</para>
+       </listitem>
+     </varlistentry>
+    </variablelist>
+  </sect2>
+
   <sect2 id="rts-options-gc">
     <title>RTS options to control the garbage collector</title>
 

diff --git a/docs/users_guide/using.xml b/docs/users_guide/using.xml
index 2868876..7bf85ef 100644 (file)
--- a/docs/users_guide/using.xml
+++ b/docs/users_guide/using.xml
@@ -1524,10 +1524,7 @@ f "2"    = 2
            every 4k of allocation).  With <option>-C0</option> or
            <option>-C</option>, context switches will occur as often as
            possible (at every heap block allocation).  By default, context
-           switches occur every 20ms.  Note that GHC's internal timer ticks
-           every 20ms, and the context switch timer is always a multiple of
-           this timer, so 20ms is the maximum granularity available for timed
-           context switches.</para>
+           switches occur every 20ms.</para>
        </listitem>
       </varlistentry>
     </variablelist>

diff --git a/includes/Cmm.h b/includes/Cmm.h
index 3d3283e..d58eebc 100644 (file)
--- a/includes/Cmm.h
+++ b/includes/Cmm.h
@@ -513,8 +513,6 @@
    Misc junk
    -------------------------------------------------------------------------- */
 
-#define TICK_MILLISECS   (1000/TICK_FREQUENCY)   /* ms per tick */
-
 #define NO_TREC        stg_NO_TREC_closure
 #define END_TSO_QUEUE  stg_END_TSO_QUEUE_closure
 

diff --git a/includes/RtsFlags.h b/includes/RtsFlags.h
index ccf170f..fbdc64e 100644 (file)
--- a/includes/RtsFlags.h
+++ b/includes/RtsFlags.h
@@ -42,7 +42,7 @@ struct GC_FLAGS {
     rtsBool ringBell;
     rtsBool frontpanel;
 
-    int idleGCDelayTicks;      /* in milliseconds */
+    int idleGCDelayTime;       /* in milliseconds */
 };
 
 struct DEBUG_FLAGS {  
@@ -112,6 +112,10 @@ struct CONCURRENT_FLAGS {
     int ctxtSwitchTicks;       /* derived */
 };
 
+struct MISC_FLAGS {
+    int tickInterval;     /* in milliseconds */
+};
+
 #ifdef PAR
 /* currently the same as GRAN_STATS_FLAGS */
 struct PAR_STATS_FLAGS {
@@ -300,6 +304,7 @@ typedef struct _RTS_FLAGS {
     /* The first portion of RTS_FLAGS is invariant. */
     struct GC_FLAGS         GcFlags;
     struct CONCURRENT_FLAGS  ConcFlags;
+    struct MISC_FLAGS        MiscFlags;
     struct DEBUG_FLAGS      DebugFlags;
     struct COST_CENTRE_FLAGS CcFlags;
     struct PROFILING_FLAGS   ProfFlags;

diff --git a/includes/mkDerivedConstants.c b/includes/mkDerivedConstants.c
index efb6c4a..05bf373 100644 (file)
--- a/includes/mkDerivedConstants.c
+++ b/includes/mkDerivedConstants.c
@@ -374,6 +374,8 @@ main(int argc, char *argv[])
                  RTS_FLAGS, DebugFlags.weak);
     struct_field_("RtsFlags_GcFlags_initialStkSize",
                  RTS_FLAGS, GcFlags.initialStkSize);
+    struct_field_("RtsFlags_MiscFlags_tickInterval",
+                 RTS_FLAGS, MiscFlags.tickInterval);
 
     struct_size(StgFunInfoExtraFwd);
     struct_field(StgFunInfoExtraFwd, slow_apply);

diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index dbaaae0..990d6f3 100644 (file)
--- 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 96a94e4..695d66e 100644 (file)
--- 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 3b49915..ce20c49 100644 (file)
--- 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 2bb061a..898acac 100644 (file)
--- 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 2deb3d8..62a347a 100644 (file)
--- 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 49e25be..585ddec 100644 (file)
--- 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 90f89b1..d56fdb6 100644 (file)
--- 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 ae26653..1fe857d 100644 (file)
--- 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 83ed84d..0f0b1e9 100644 (file)
--- 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 0dbacef..ccf3945 100644 (file)
--- 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;
       }