Ticket #7216: stm-fd-wait.patch

File stm-fd-wait.patch, 2.2 KB (added by AndreasVoellmy, 2 years ago)

Patch against 2921e94a3546d3c431051271f505307d2f13b208

  • GHC/Event/Thread.hs

    From dedd802749c8002ff24504727d81d2c0f7f5ab52 Mon Sep 17 00:00:00 2001
    From: Andreas Voellmy <[email protected]>
    Date: Tue, 28 Aug 2012 23:44:30 -0400
    Subject: [PATCH] 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