module WinDll.Debug.Records
( MemAlloc(..)
, Caller(..)
, fileName
, writeMemAlloc
) where
import WinDll.Debug.Stack ( Stack )
import System.Directory ( doesFileExist, createDirectoryIfMissing )
import Control.Monad ( when )
import Control.Concurrent.MVar
import System.FilePath
import System.IO.Unsafe
type PtrLocation = Int
type MemSize = Int
data Caller = Malloc
| Alloc
| ReAlloc
| Other
| Record
deriving (Show, Read)
data MemAlloc = MemAlloc { memFun :: Caller
, memStack :: Stack
, memStart :: PtrLocation
, memStop :: Maybe PtrLocation
, memSize :: Maybe MemSize
, memTime :: String
}
| MemFree { memStack :: Stack
, memStart :: PtrLocation
, memSize :: Maybe MemSize
, memTime :: String
}
deriving (Show, Read)
directory :: String
directory = "MemDumps"
fileName :: IO String
fileName = do let path = "Memory.dump"
createDirectoryIfMissing True directory
return $ directory </> path
fileLock :: MVar Int
fileLock = unsafePerformIO $ newMVar 0
writeMemAlloc :: MemAlloc -> IO ()
writeMemAlloc mem = do takeMVar fileLock
fn <- fileName
exists <- doesFileExist fn
when (not exists) $ writeFile fn []
appendFile fn (show mem ++ "\n")
putMVar fileLock 0