Ticket #7216: threadWaitSTM.patch

File threadWaitSTM.patch, 5.4 KB (added by AndreasVoellmy, 18 months ago)

Return an unregistration function with the threadWait*STM functions; added some haddock comments.

  • GHC/Event/Thread.hs

    From dedd802749c8002ff24504727d81d2c0f7f5ab52 Mon Sep 17 00:00:00 2001
    From: Andreas Voellmy <andreas.voellmy@gmail.com>
    Date: Tue, 28 Aug 2012 23:44:30 -0400
    Subject: [PATCH 1/2] Added threadWait functions to wait on FD readiness with
     STM actions.
    
    ---
     GHC/Event/Thread.hs |   28 +++++++++++++++++++++++++++-
     1 file changed, 27 insertions(+), 1 deletion(-)
    
    diff --git a/GHC/Event/Thread.hs b/GHC/Event/Thread.hs
    index 2643950..794f01e 100644
    a b module GHC.Event.Thread 
    66    , ensureIOManagerIsRunning 
    77    , threadWaitRead 
    88    , threadWaitWrite 
     9    , threadWaitReadSTM 
     10    , threadWaitWriteSTM 
    911    , closeFdWith 
    1012    , threadDelay 
    1113    , registerDelay 
    import Foreign.Ptr (Ptr) 
    1820import GHC.Base 
    1921import GHC.Conc.Sync (TVar, ThreadId, ThreadStatus(..), atomically, forkIO, 
    2022                      labelThread, modifyMVar_, newTVar, sharedCAF, 
    21                       threadStatus, writeTVar) 
     23                      threadStatus, writeTVar, newTVarIO, readTVar, retry,throwSTM,STM) 
    2224import GHC.IO (mask_, onException) 
    2325import GHC.IO.Exception (ioError) 
    2426import GHC.MVar (MVar, newEmptyMVar, newMVar, putMVar, takeMVar) 
    threadWait evt fd = mask_ $ do 
    9496    then ioError $ errnoToIOError "threadWait" eBADF Nothing Nothing 
    9597    else return () 
    9698 
     99 
     100threadWaitSTM :: Event -> Fd -> IO (STM ()) 
     101threadWaitSTM evt fd = mask_ $ do 
     102  m <- newTVarIO Nothing 
     103  Just mgr <- getSystemEventManager  
     104  registerFd mgr (\reg e -> unregisterFd_ mgr reg >> atomically (writeTVar m (Just e))) fd evt 
     105  return (do mevt <- readTVar m 
     106             case mevt of 
     107               Nothing -> retry 
     108               Just evt ->  
     109                 if evt `eventIs` evtClose 
     110                 then throwSTM $ errnoToIOError "threadWait" eBADF Nothing Nothing 
     111                 else return () 
     112         ) 
     113 
     114threadWaitReadSTM :: Fd -> IO (STM ()) 
     115threadWaitReadSTM = threadWaitSTM evtRead 
     116{-# INLINE threadWaitReadSTM #-} 
     117 
     118threadWaitWriteSTM :: Fd -> IO (STM ()) 
     119threadWaitWriteSTM = threadWaitSTM evtWrite 
     120{-# INLINE threadWaitWriteSTM #-} 
     121 
     122 
    97123-- | Retrieve the system event manager. 
    98124-- 
    99125-- This function always returns 'Just' the system event manager when using the 
  • GHC/Event/Thread.hs

    -- 
    1.7.10.2 (Apple Git-33)
    
    
    From cb37f8bdeda63057273d95a52a06d4d2fd779b29 Mon Sep 17 00:00:00 2001
    From: Andreas Voellmy <andreas.voellmy@gmail.com>
    Date: Wed, 17 Oct 2012 11:02:12 -0400
    Subject: [PATCH 2/2] Added the unregistration command to the return value of
     threadWait*STM functions.
    
    This allows the calling thread to unregister interest in the file, e.g. in the case
    of an exception in the thread.
    ---
     GHC/Event/Thread.hs |   43 ++++++++++++++++++++++++++++++-------------
     1 file changed, 30 insertions(+), 13 deletions(-)
    
    diff --git a/GHC/Event/Thread.hs b/GHC/Event/Thread.hs
    index 794f01e..bca0565 100644
    a b threadWait evt fd = mask_ $ do 
    9797    else return () 
    9898 
    9999 
    100 threadWaitSTM :: Event -> Fd -> IO (STM ()) 
     100threadWaitSTM :: Event -> Fd -> IO (STM (), IO ()) 
    101101threadWaitSTM evt fd = mask_ $ do 
    102102  m <- newTVarIO Nothing 
    103103  Just mgr <- getSystemEventManager  
    104   registerFd mgr (\reg e -> unregisterFd_ mgr reg >> atomically (writeTVar m (Just e))) fd evt 
    105   return (do mevt <- readTVar m 
    106              case mevt of 
    107                Nothing -> retry 
    108                Just evt ->  
    109                  if evt `eventIs` evtClose 
    110                  then throwSTM $ errnoToIOError "threadWait" eBADF Nothing Nothing 
    111                  else return () 
    112          ) 
    113  
    114 threadWaitReadSTM :: Fd -> IO (STM ()) 
     104  reg <- registerFd mgr (\reg e -> unregisterFd_ mgr reg >> atomically (writeTVar m (Just e))) fd evt 
     105  let waitAction = 
     106        do mevt <- readTVar m 
     107           case mevt of 
     108             Nothing -> retry 
     109             Just evt ->  
     110               if evt `eventIs` evtClose 
     111               then throwSTM $ errnoToIOError "threadWaitSTM" eBADF Nothing Nothing 
     112               else return () 
     113  return (waitAction, unregisterFd_ mgr reg >> return ()) 
     114 
     115-- | Allows a thread to use an STM action to wait for a file descriptor to be readable. 
     116-- The STM action will retry until the file descriptor has data ready. 
     117-- The second element of the return value pair is an IO action that can be used 
     118-- to deregister interest in the file descriptor.  
     119-- 
     120-- The STM action will throw an 'IOError' if the file descriptor was closed 
     121-- while the STM action is being executed.  To safely close a file descriptor 
     122-- that has been used with 'threadWaitReadSTM', use 'closeFdWith'. 
     123threadWaitReadSTM :: Fd -> IO (STM (), IO ()) 
    115124threadWaitReadSTM = threadWaitSTM evtRead 
    116125{-# INLINE threadWaitReadSTM #-} 
    117126 
    118 threadWaitWriteSTM :: Fd -> IO (STM ()) 
     127-- | Allows a thread to use an STM action to wait until a file descriptor can accept a write. 
     128-- The STM action will retry while the file until the given file descriptor can accept a write. 
     129-- The second element of the return value pair is an IO action that can be used to deregister 
     130-- interest in the file descriptor.  
     131-- 
     132-- The STM action will throw an 'IOError' if the file descriptor was closed 
     133-- while the STM action is being executed.  To safely close a file descriptor 
     134-- that has been used with 'threadWaitWriteSTM', use 'closeFdWith'. 
     135threadWaitWriteSTM :: Fd -> IO (STM (), IO ()) 
    119136threadWaitWriteSTM = threadWaitSTM evtWrite 
    120137{-# INLINE threadWaitWriteSTM #-} 
    121138