# HG changeset patch
# User unc0rr
# Date 1300018144 -10800
# Node ID db4726bf9205dede7a03734d040ed09276bc8775
# Parent  312f4dd41753825e6778abff0cd3efbcec56d9db
Implement Store truncating, so the memory even gets freed sometimes

diff -r 312f4dd41753 -r db4726bf9205 gameServer/Actions.hs
--- a/gameServer/Actions.hs	Sat Mar 12 22:55:25 2011 +0300
+++ b/gameServer/Actions.hs	Sun Mar 13 15:09:04 2011 +0300
@@ -405,7 +405,7 @@
     if isJust info then
         mapM_ processAction [ModifyServerInfo (\s -> s{lastLogins = newLogins}), ByeClient (snd .  fromJust $ info)]
         else
-        processAction $ ModifyServerInfo (\s -> s{lastLogins = (host cl, (addUTCTime 10 $ connectTime cl, "Reconnected too fast")) : newLogins})
+        processAction $ ModifyServerInfo (\s -> s{lastLogins = (host cl, (addUTCTime 0 $ connectTime cl, "Reconnected too fast")) : newLogins})
 
 
 processAction PingAll = do
diff -r 312f4dd41753 -r db4726bf9205 gameServer/Store.hs
--- a/gameServer/Store.hs	Sat Mar 12 22:55:25 2011 +0300
+++ b/gameServer/Store.hs	Sun Mar 13 15:09:04 2011 +0300
@@ -35,12 +35,16 @@
 
 -- MStore code
 initialSize :: Int
-initialSize = 10
+initialSize = 16
 
 
 growFunc :: Int -> Int
 growFunc a = a * 3 `div` 2
 
+truncFunc :: Int -> Int
+truncFunc a | a > growFunc initialSize = (a `div` 2)
+            | otherwise = a
+
 
 newStore :: IO (MStore e)
 newStore = do
@@ -65,6 +69,25 @@
     when (IntSet.null freeElems) $ growStore m
 
 
+truncateStore :: MStore e -> IO ()
+truncateStore (MStore ref) = do
+    (busyElems, freeElems, arr) <- readIORef ref
+    (_, m') <- IOA.getBounds arr
+    let newM' = truncFunc (m' + 1) - 1
+    newArr <- IOA.newArray_ (0, newM')
+    sequence_ [IOA.readArray arr i >>= IOA.writeArray newArr i | i <- IntSet.toList busyElems]
+    writeIORef ref (busyElems, freeElems `IntSet.difference` IntSet.fromAscList [newM'..m'+1], newArr)
+
+
+truncateIfNeeded :: MStore e -> IO ()
+truncateIfNeeded m@(MStore ref) = do
+    (busyElems, _, arr) <- readIORef ref
+    (_, m') <- IOA.getBounds arr
+    let newM' = truncFunc (m' + 1) - 1
+    let allLessM = all (< newM') $ IntSet.elems busyElems
+    when (newM' < m' && allLessM) $ truncateStore m
+
+
 addElem :: MStore e -> e -> IO ElemIndex
 addElem m@(MStore ref) element = do
     growIfNeeded m
@@ -76,10 +99,11 @@
 
 
 removeElem :: MStore e -> ElemIndex -> IO ()
-removeElem (MStore ref) (ElemIndex n) = do
+removeElem m@(MStore ref) (ElemIndex n) = do
     (busyElems, freeElems, arr) <- readIORef ref
     IOA.writeArray arr n (error $ "Store: no element " ++ show n)
     writeIORef ref (IntSet.delete n busyElems, IntSet.insert n freeElems, arr)
+    truncateIfNeeded m
 
 
 readElem :: MStore e -> ElemIndex -> IO e
diff -r 312f4dd41753 -r db4726bf9205 gameServer/stresstest.hs
--- a/gameServer/stresstest.hs	Sat Mar 12 22:55:25 2011 +0300
+++ b/gameServer/stresstest.hs	Sun Mar 13 15:09:04 2011 +0300
@@ -19,7 +19,7 @@
 session3 nick room = ["NICK", nick, "", "PROTO", "32", "", "LIST", "", "JOIN_ROON", room, "", "CHAT", "room 2", "", "QUIT", "quit", ""]
 
 emulateSession sock s = do
-    mapM_ (\x -> hPutStrLn sock x >> hFlush sock >> randomRIO (30000::Int, 59000) >>= threadDelay) s
+    mapM_ (\x -> hPutStrLn sock x >> hFlush sock >> randomRIO (3000000::Int, 5900000) >>= threadDelay) s
     hFlush sock
     threadDelay 225000