Improve the handling of threadDelay in the non-threaded RTS

Firstly, we were rounding up too much, such that the smallest delay
was 20ms.  Secondly, there is no need to use millisecond resolution on
a 64-bit machine where we have room in the TSO to use the normal
nanosecond resolution that we use elsewhere in the RTS.

4 files changed, 36 insertions, 19 deletions

diff --git a/includes/rts/storage/TSO.h b/includes/rts/storage/TSO.h
index 5e54bff72c..82f5a75948 100644
--- a/includes/rts/storage/TSO.h
+++ b/includes/rts/storage/TSO.h
@@ -57,7 +57,7 @@ typedef union {
 #if !defined(THREADED_RTS)
   StgWord target;
     // Only for the non-threaded RTS: the target time for a thread
-    // blocked in threadDelay, in units of 10ms.  This is a
+    // blocked in threadDelay, in units of 1ms.  This is a
     // compromise: we don't want to take up much space in the TSO.  If
     // you want better resolution for threadDelay, use -threaded.
 #endif
diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index e368ed195b..aaedabb951 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -1838,11 +1838,7 @@ stg_delayzh
 #else
 
 
-    W_ time;
-    (time) = foreign "C" getourtimeofday() [R1];
-    // getourtimeofday() returns a value in units of 10ms
-    // R1 is in microseconds, we need to (/ 10000), rounding up
-    target = time + 1 + (R1 + 10000-1) / 10000;
+    (target) = foreign "C" getDelayTarget(R1) [R1];
 
     StgTSO_block_info(CurrentTSO) = target;
 
diff --git a/rts/posix/Select.c b/rts/posix/Select.c
index dc40b706d8..a2a66a6b8a 100644
--- a/rts/posix/Select.c
+++ b/rts/posix/Select.c
@@ -2,7 +2,10 @@
  *
  * (c) The GHC Team 1995-2002
  *
- * Support for concurrent non-blocking I/O and thread waiting.
+ * Support for concurrent non-blocking I/O and thread waiting in the
+ * non-threaded RTS.  In the threded RTS, this file is not used at
+ * all, instead we use the IO manager thread implemented in Haskell in
+ * the base package.
  *
  * ---------------------------------------------------------------------------*/
 
@@ -39,21 +42,39 @@
 
 #if !defined(THREADED_RTS)
 
-/* 
- * The threaded RTS uses an IO-manager thread in Haskell instead (see GHC.Conc) 
- */
-
-#define LowResTimeToTime(t) (USToTime((t) * 10000))
+// The target time for a threadDelay is stored in a one-word quantity
+// in the TSO (tso->block_info.target).  On a 32-bit machine we
+// therefore can't afford to use nanosecond resolution because it
+// would overflow too quickly, so instead we use millisecond
+// resolution.
+
+#if SIZEOF_VOID_P == 4
+#define LowResTimeToTime(t)          (USToTime((t) * 1000))
+#define TimeToLowResTimeRoundDown(t) (TimeToUS(t) / 1000)
+#define TimeToLowResTimeRoundUp(t)   ((TimeToUS(t) + 1000-1) / 1000)
+#else
+#define LowResTimeToTime(t) (t)
+#define TimeToLowResTimeRoundDown(t) (t)
+#define TimeToLowResTimeRoundUp(t)   (t)
+#endif
 
 /*
  * Return the time since the program started, in LowResTime,
  * rounded down.
- *
- * This is only used by posix/Select.c.  It should probably go away.
  */
-LowResTime getourtimeofday(void)
+static LowResTime getLowResTimeOfDay(void)
+{
+    return TimeToLowResTimeRoundDown(stat_getElapsedTime());
+}
+
+/*
+ * For a given microsecond delay, return the target time in LowResTime.
+ */
+LowResTime getDelayTarget (HsInt us)
 {
-  return TimeToUS(stat_getElapsedTime()) / 10000;
+    // round up the target time, because we never want to sleep *less*
+    // than the desired amount.
+    return TimeToLowResTimeRoundUp(stat_getElapsedTime() + USToTime(us));
 }
 
 /* There's a clever trick here to avoid problems when the time wraps
@@ -136,7 +157,7 @@ awaitEvent(rtsBool wait)
      */
     do {
 
-      now = getourtimeofday();
+      now = getLowResTimeOfDay();
       if (wakeUpSleepingThreads(now)) {
 	  return;
       }
@@ -255,7 +276,7 @@ awaitEvent(rtsBool wait)
 	  
 	  /* check for threads that need waking up 
 	   */
-          wakeUpSleepingThreads(getourtimeofday());
+          wakeUpSleepingThreads(getLowResTimeOfDay());
 	  
 	  /* If new runnable threads have arrived, stop waiting for
 	   * I/O and run them.
diff --git a/rts/posix/Select.h b/rts/posix/Select.h
index 15fa00ac66..50d49d4ba5 100644
--- a/rts/posix/Select.h
+++ b/rts/posix/Select.h
@@ -12,6 +12,6 @@
 // An absolute time value in units of 10ms.
 typedef StgWord LowResTime;
 
-RTS_PRIVATE LowResTime getourtimeofday ( void );
+RTS_PRIVATE LowResTime getDelayTarget (HsInt us);
 
 #endif /* POSIX_SELECT_H */