# HG changeset patch # User unc0rr # Date 1332442538 -14400 # Node ID 097289be72000be7877a076ae5e53e2e1dce1d95 # Parent 06bedc419d0482b83a5a06bcb5724fcc00b06edc Add more strictness in hope it will help with space leak diff -r 06bedc419d04 -r 097289be7200 gameServer/Actions.hs --- a/gameServer/Actions.hs Wed Mar 21 00:05:46 2012 -0400 +++ b/gameServer/Actions.hs Thu Mar 22 22:55:38 2012 +0400 @@ -488,7 +488,7 @@ [ AnswerClients [sendChan cl] ["CONNECTED", "Hedgewars server http://www.hedgewars.org/", serverVersion] , CheckBanned - , AddIP2Bans (host cl) "Reconnected too fast" (addUTCTime 10 $ connectTime cl) + --, AddIP2Bans (host cl) "Reconnected too fast" (addUTCTime 10 $ connectTime cl) ] diff -r 06bedc419d04 -r 097289be7200 gameServer/RoomsAndClients.hs --- a/gameServer/RoomsAndClients.hs Wed Mar 21 00:05:46 2012 -0400 +++ b/gameServer/RoomsAndClients.hs Thu Mar 22 22:55:38 2012 +0400 @@ -1,3 +1,5 @@ +{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving #-} + module RoomsAndClients( RoomIndex(), ClientIndex(), @@ -34,24 +36,25 @@ import Store import Control.Monad +import Control.DeepSeq data Room r = Room { - roomClients' :: [ClientIndex], - room' :: r + roomClients' :: ![ClientIndex], + room' :: !r } data Client c = Client { - clientRoom' :: RoomIndex, - client' :: c + clientRoom' :: !RoomIndex, + client' :: !c } newtype RoomIndex = RoomIndex ElemIndex - deriving (Eq) + deriving (Eq, NFData) newtype ClientIndex = ClientIndex ElemIndex - deriving (Eq, Show, Read, Ord) + deriving (Eq, Show, Read, Ord, NFData) instance Show RoomIndex where show (RoomIndex i) = 'r' : show i @@ -82,10 +85,10 @@ roomAddClient :: ClientIndex -> Room r -> Room r -roomAddClient cl rm = let cls = cl : roomClients' rm; nr = rm{roomClients' = cls} in cls `seq` nr +roomAddClient cl rm = let cls = cl : roomClients' rm; nr = rm{roomClients' = cls} in cls `deepseq` nr roomRemoveClient :: ClientIndex -> Room r -> Room r -roomRemoveClient cl rm = let cls = filter (/= cl) $ roomClients' rm; nr = rm{roomClients' = cls} in cls `seq` nr +roomRemoveClient cl rm = let cls = filter (/= cl) $ roomClients' rm; nr = rm{roomClients' = cls} in cls `deepseq` nr addRoom :: MRoomsAndClients r c -> r -> IO RoomIndex diff -r 06bedc419d04 -r 097289be7200 gameServer/Store.hs --- a/gameServer/Store.hs Wed Mar 21 00:05:46 2012 -0400 +++ b/gameServer/Store.hs Thu Mar 22 22:55:38 2012 +0400 @@ -1,3 +1,4 @@ +{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving #-} module Store( ElemIndex(), MStore(), @@ -22,10 +23,11 @@ import qualified Data.IntSet as IntSet import Data.IORef import Control.Monad +import Control.DeepSeq newtype ElemIndex = ElemIndex Int - deriving (Eq, Show, Read, Ord) + deriving (Eq, Show, Read, Ord, NFData) newtype MStore e = MStore (IORef (IntSet.IntSet, IntSet.IntSet, IOA.IOArray Int e)) newtype IStore e = IStore (IntSet.IntSet, IA.Array Int e) @@ -84,7 +86,7 @@ addElem m@(MStore ref) element = do growIfNeeded m (busyElems, freeElems, arr) <- readIORef ref - let (n, freeElems') = IntSet.deleteFindMin freeElems + let (!n, freeElems') = IntSet.deleteFindMin freeElems IOA.writeArray arr n element writeIORef ref (IntSet.insert n busyElems, freeElems', arr) return $ ElemIndex n @@ -113,12 +115,12 @@ elemExists :: MStore e -> ElemIndex -> IO Bool elemExists (MStore ref) (ElemIndex n) = do - (_, free, _) <- readIORef ref + (_, !free, _) <- readIORef ref return $ n `IntSet.notMember` free indicesM :: MStore e -> IO [ElemIndex] indicesM (MStore ref) = do - (busy, _, _) <- readIORef ref + (!busy, _, _) <- readIORef ref return $ map ElemIndex $ IntSet.toList busy diff -r 06bedc419d04 -r 097289be7200 gameServer/stresstest.hs --- a/gameServer/stresstest.hs Wed Mar 21 00:05:46 2012 -0400 +++ b/gameServer/stresstest.hs Thu Mar 22 22:55:38 2012 +0400 @@ -14,10 +14,10 @@ import System.Posix #endif -session 0 nick room = ["NICK", nick, "", "PROTO", "38", "", "PING", "", "CHAT", "lobby 1", "", "PONG", "", "CREATE_ROOM", room, "", "CHAT", "room 1", "", "QUIT", "creator", ""] -session 1 nick room = ["NICK", nick, "", "PROTO", "38", "", "LIST", "", "JOIN_ROOM", room, "", "PONG", "", "CHAT", "room 2", "", "PART", "", "CHAT", "lobby after part", "", "QUIT", "part-quit", ""] -session 2 nick room = ["NICK", nick, "", "PROTO", "38", "", "LIST", "", "JOIN_ROOM", room, "", "PONG", "", "CHAT", "room 2", "", "QUIT", "quit", ""] -session 3 nick room = ["NICK", nick, "", "PROTO", "38", "", "CHAT", "lobby 1", "", "CREATE_ROOM", room, "", "", "PONG", "CHAT", "room 1", "", "PART", "creator", "", "QUIT", "part-quit", ""] +session 0 nick room = ["NICK", nick, "", "PROTO", "42", "", "PING", "", "CHAT", "lobby 1", "", "PONG", "", "CREATE_ROOM", room, "", "CHAT", "room 1", "", "QUIT", "creator", ""] +session 1 nick room = ["NICK", nick, "", "PROTO", "42", "", "LIST", "", "JOIN_ROOM", room, "", "PONG", "", "CHAT", "room 2", "", "PART", "", "CHAT", "lobby after part", "", "QUIT", "part-quit", ""] +session 2 nick room = ["NICK", nick, "", "PROTO", "42", "", "LIST", "", "JOIN_ROOM", room, "", "PONG", "", "CHAT", "room 2", "", "QUIT", "quit", ""] +session 3 nick room = ["NICK", nick, "", "PROTO", "42", "", "CHAT", "lobby 1", "", "CREATE_ROOM", room, "", "", "PONG", "CHAT", "room 1", "", "PART", "creator", "", "QUIT", "part-quit", ""] emulateSession sock s = do mapM_ (\x -> hPutStrLn sock x >> hFlush sock >> randomRIO (100000::Int, 600000) >>= threadDelay) s