Add more strictness in hope it will help with space leak
authorunc0rr
Thu, 22 Mar 2012 22:55:38 +0400
changeset 6805 097289be7200
parent 6804 06bedc419d04
child 6806 cdfb6c7099e5
Add more strictness in hope it will help with space leak
gameServer/Actions.hs
gameServer/RoomsAndClients.hs
gameServer/Store.hs
gameServer/stresstest.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)
         ]
 
 
--- 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
--- 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
 
 
--- 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