--- 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