This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "snap-server".
The branch, table-fix has been updated
via 9828c4e3ac5689db97b55d6a9f6ee04b25656a95 (commit)
from 9b844af6e62e7beba8d88478420dd67d022c3d7d (commit)
Summary of changes:
src/Snap/Internal/Http/Server/LibevBackend.hs | 68 ++++--------------------
1 files changed, 12 insertions(+), 56 deletions(-)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 9828c4e3ac5689db97b55d6a9f6ee04b25656a95
Author: Gregory Collins <[email protected]>
Date: Thu Jun 24 18:27:41 2010 -0400
Change thread table representation to see if it will improve performance
diff --git a/src/Snap/Internal/Http/Server/LibevBackend.hs
b/src/Snap/Internal/Http/Server/LibevBackend.hs
index 3724676..eccda04 100644
--- a/src/Snap/Internal/Http/Server/LibevBackend.hs
+++ b/src/Snap/Internal/Http/Server/LibevBackend.hs
@@ -41,11 +41,8 @@ import Data.ByteString (ByteString)
import Data.ByteString.Internal (c2w, w2c)
import qualified Data.ByteString.Unsafe as B
import qualified Data.ByteString as B
-import Data.DList (DList)
-import qualified Data.DList as D
import Data.IORef
import Data.Iteratee.WrappedByteString
-import qualified Data.List as List
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Typeable
@@ -80,10 +77,7 @@ data Backend = Backend
, _asyncObj :: !EvAsyncPtr
, _killCb :: !(FunPtr AsyncCallback)
, _killObj :: !EvAsyncPtr
- , _connectionThreads :: !(MVar (Set ThreadId))
- , _connThreadEdits :: !(IORef (DList (Set ThreadId -> Set ThreadId)))
- , _connThreadId :: !(MVar ThreadId)
- , _connThreadIsDone :: !(MVar ())
+ , _connectionThreads :: !(IORef (Set ThreadId))
, _threadActivity :: !(MVar ())
, _backendCPU :: !Int
}
@@ -218,10 +212,7 @@ new (sock,sockFd) cpu = do
-- thread set stuff
connThreadMVar <- newEmptyMVar
- connSet <- newMVar Set.empty
- editsRef <- newIORef D.empty
- connThreadDone <- newEmptyMVar
- threadActivity <- newMVar ()
+ connSet <- newIORef Set.empty
let b = Backend sock
sockFd
@@ -236,17 +227,11 @@ new (sock,sockFd) cpu = do
killCB
killObj
connSet
- editsRef
connThreadMVar
- connThreadDone
- threadActivity
cpu
forkOnIO cpu $ loopThread b
- conntid <- forkOnIO cpu $ connTableSeqThread b
- putMVar connThreadMVar conntid
-
debug $ "Backend.new: loop spawned"
return b
@@ -355,7 +340,7 @@ waitForThreads backend t = timeout t wait >> return ()
where
threadSet = _connectionThreads backend
wait = do
- threads <- readMVar threadSet
+ threads <- readIORef threadSet
if (Set.null threads)
then return ()
else threadDelay (seconds 1) >> wait
@@ -383,12 +368,14 @@ timerCallback tmv _ _ _ = do
addThreadSetEdit :: Backend -> (Set ThreadId -> Set ThreadId) -> IO ()
addThreadSetEdit backend edit = do
- atomicModifyIORef (_connThreadEdits backend) $ \els ->
- (D.snoc els edit, ())
-
- tryPutMVar (_threadActivity backend) ()
+ let tref = _connectionThreads backend
+ atomicModifyIORef tref f
+ -- force the result
+ !t <- readIORef tref
return ()
+ where
+ f !s = (edit s, ())
freeConnection :: Connection -> IO ()
freeConnection conn = ignoreException $ do
@@ -438,44 +425,13 @@ ignoreException :: IO () -> IO ()
ignoreException = handle (\(_::SomeException) -> return ())
-connTableSeqThread :: Backend -> IO ()
-connTableSeqThread backend = loop `finally` putMVar threadDone ()
- where
- threadDone = _connThreadIsDone backend
- editsRef = _connThreadEdits backend
- table = _connectionThreads backend
- activity = _threadActivity backend
-
- loop = do
- takeMVar activity
-
- -- grab the edits
- edits <- atomicModifyIORef editsRef $ \t -> (D.empty, D.toList t)
-
- -- apply the edits
- modifyMVar_ table $ \t -> block $ do
- let !t' = List.foldl' (flip ($)) t edits
- return t'
-
- -- zzz
- threadDelay 1000000
- loop
-
-
freeBackend :: Backend -> IO ()
freeBackend backend = ignoreException $ block $ do
-- note: we only get here after an unloop
- readMVar (_connThreadId backend) >>= killThread
- takeMVar $ _connThreadIsDone backend
-
- -- read edits and obtain final thread table
- threads <- withMVar (_connectionThreads backend) $ \table -> do
- edits <- liftM D.toList $
- readIORef (_connThreadEdits backend)
-
- let !t = List.foldl' (flip ($)) table edits
- return $ Set.toList t
+ -- obtain final thread table
+ threads <- liftM Set.toList $
+ readIORef (_connectionThreads backend)
mapM_ killThread threads
-----------------------------------------------------------------------
hooks/post-receive
--
snap-server
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
