[project @ 2005-03-02 13:11:00 by simonmar]

[ghc-base.git] / GHC / Conc.lhs

diff --git a/GHC/Conc.lhs b/GHC/Conc.lhs
index 6dbe991..8476498 100644 (file)
--- a/GHC/Conc.lhs
+++ b/GHC/Conc.lhs
@@ -14,7 +14,12 @@
 -- 
 -----------------------------------------------------------------------------
 
--- #hide
+-- No: #hide, because bits of this module are exposed by the stm package.
+-- However, we don't want this module to be the home location for the
+-- bits it exports, we'd rather have Control.Concurrent and the other
+-- higher level modules be the home.  Hence:
+
+-- #not-home
 module GHC.Conc
        ( ThreadId(..)
 
@@ -568,24 +573,26 @@ service_loop wakeup readfds writefds ptimeval old_reqs old_delays = do
   fdSet wakeup readfds
   maxfd <- buildFdSets 0 readfds writefds reqs
 
-  -- check the current time and wake up any thread in threadDelay whose
-  -- timeout has expired.  Also find the timeout value for the select() call.
-  now <- getTicksOfDay
-  (delays', timeout) <- getDelay now ptimeval delays
-
   -- perform the select()
-  let do_select = do
+  let do_select delays = do
+         -- check the current time and wake up any thread in
+         -- threadDelay whose timeout has expired.  Also find the
+         -- timeout value for the select() call.
+         now <- getTicksOfDay
+         (delays', timeout) <- getDelay now ptimeval delays
+
          res <- c_select ((max wakeup maxfd)+1) readfds writefds 
                        nullPtr timeout
          if (res == -1)
             then do
                err <- getErrno
                if err == eINTR
-                       then do_select
-                       else return res
+                       then do_select delays'
+                       else return (res,delays')
             else
-               return res
-  res <- do_select
+               return (res,delays')
+
+  (res,delays') <- do_select delays
   -- ToDo: check result
 
   b <- takeMVar prodding