Analyzer.hs

-----------------------------------------------------------------------------
-- |
-- Module      :  Windll
-- Copyright   :  (c) Tamar Christina 2009 - 2010
-- License     :  BSD3
-- 
-- Maintainer  :  tamar@zhox.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Module to process heap requests
--
-----------------------------------------------------------------------------

module WinDll.Debug.Analyzer where

import WinDll.Debug.Records
import WinDll.Debug.Heap
import WinDll.Utils.Feedback
import WinDll.Session.Debug
import WinDll.Debug.Stack

-- | Emulate all the allocations and returned a managed Heap
emulate :: [MemAlloc] -> (Int,Int) -> Heap -> Exec Heap
emulate []     _     heap = liftIO (putStrLn "") >> return heap
emulate (m:xs) (i,t) heap = do progress _always i t 20
                               case m of
                                 MemFree{}  -> do inform _detail $ "Freeing memory from " ++ printStack (memStack m) 
                                                  heap' <- removeFromHeap heap (memStart m)
                                                  emulate xs (i + 1, t) $! heap'
                                 MemAlloc{} -> do inform _detail $ "Performing allocation for " ++ printStack (memStack m)
                                                  heap' <- case memFun m of
                                                             Malloc  -> addToHeap heap (memStart m) (maybe 1 id (memSize m))
                                                             Alloc   -> addToHeap heap (memStart m) (maybe 1 id (memSize m))
                                                             ReAlloc -> resizeHeap heap (memStart m) (maybe 1 id (memSize m))
                                                             Other   -> do inform _detail $ "Ignoring allocation at 0x" ++ asHex (memStart m)
                                                                           return heap
                                                             Record  -> addToHeap heap (memStart m) (maybe 1 id (memSize m))
                                                  emulate xs (i + 1, t) $! heap'