What does ordinary heap profiling (-hc, -hd, -hy) tell you about what's
in the heap? These options should work fine with STM.
Cheers,
Simon
On 16 December 2005 11:44, Joel Reymont wrote:
> Folks,
>
> I have a huge space leak someplace and I suspect this code. The
> SrvServerInfo data structure is something like 50K compressed or
> uncompressed byte data before unpickling. My thousands of bots issue
> this request at least once and I almost run out of memory with 100
> bots on a 1Gb machine on FreeBSD. Do I need deepSeq somewhere below?
>
> This is the read.
>
> read :: Handle -> (SSL, BIO, BIO) -> IO Command
> read h _ =
> do sa <- emptyByteArray 4
> hGetArray h sa 4
> (size', _) <- unpickle endian32 sa 0
> let size = fromIntegral $ size' - 4
> packet <- emptyByteArray size
> hGetArray h packet size
> unstuff packet 0
>
> I suspect that I need to deepSeq cmd'' instead of return $! cmd''
>
> unstuff :: MutByteArray -> Index -> IO Command
> unstuff array ix =
> do (kind, ix1) <- unpickle puCmdType array ix
> (cmd', _) <- unpickle (puCommand kind) array ix1
> case cmd' of
> InvalidCommand -> do fail $ "unstuff: Cannot parse " ++
> show array
> SrvCompressedCommands sz bytes ->
> do bytes' <- uncompress bytes (fromIntegral sz)
> cmd'' <- unstuff bytes' 4
> return $! cmd''
> _ -> return cmd'
>
> This is where the list of active tables is converted to a table id
> list of [Word32].
>
> pickTable _ filters (Cmd cmd@(SrvServerInfo {})) =
> do let tables = filter (tableMatches filters) $ activeTables cmd
> ids = map tiTableID tables
> case tables of
> [] -> fail $ "pickTable: No tables found: " ++ show filters
> _ ->
> do pop
> stoptimer "pickTable"
> return $! Eat $! Just $! Custom $! Tables $! ids
>
> This is where the table id list of [Word32] is consumed.
>
> takeEmptySeat _ aff_id _ (Custom (Tables ids@(table:rest))) =
> do trace 85 $ "takeEmptySeat: " ++ show (length ids)
> ++ " tables found"
> trace 100 $ "takeEmptySeat: tables: " ++ showTables ids
> trace 85 $ "takeEmptySeat: trying table# " ++ show table
> w <- get
> put_ $ w { tables_to_try = rest }
> push "goToTable" $ goToTable table aff_id
> -- kick off goToTable
> return $ Eat $ Just Go
>
> This is the SrvServerInfo structure.
>
> | SrvServerInfo
> {
> activeTables :: ![TableInfo], -- Word16/
> removedTables :: ![Word32], -- Word16/
> version :: !Int32
> }
>
> And this is the table info itself.
>
> data TableInfo = TableInfo
> {
> tiAvgPot :: !Word64,
> tiNumPlayers :: !Word16,
> tiWaiting :: !Word16,
> tiPlayersFlop :: !Word8,
> tiTableName :: !String,
> tiTableID :: !Word32,
> tiGameType :: !GameType,
> tiInfoMaxPlayers :: !Word16,
> tiIsRealMoneyTable :: !Bool,
> tiLowBet :: !Word64,
> tiHighBet :: !Word64,
> tiMinStartMoney :: !Word64,
> tiMaxStartMoney :: !Word64,
> tiGamesPerHour :: !Word16,
> tiTourType :: !TourType,
> tiTourID :: !Word32,
> tiBetType :: !BetType,
> tiCantReturnLess :: !Word32,
> tiAffiliateID :: ![Word8],
> tiLangID :: !Word32
> } deriving (Show, Typeable)
>
> Thanks, Joel
