diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,13 @@ # Revision history for ghc-debug-client +## 0.5.0.0 -- 2023-06-06 + +* Remove eventlog2html dependency and hence `profile` function. These can be + implemented in your own library if you want to use them. +* Update with support for ghc-9.4 and ghc-9.6. +* Add support for debugging over a TCP socket (`withDebuggeeConnectTCP`) + + ## 0.4.0.1 -- 2023-03-09 * Relax some version bounds and use eventlog2html 0.9.3 diff --git a/ghc-debug-client.cabal b/ghc-debug-client.cabal --- a/ghc-debug-client.cabal +++ b/ghc-debug-client.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: ghc-debug-client -version: 0.4.0.1 +version: 0.5.0.0 synopsis: Useful functions for writing heap analysis tools which use ghc-debug. description: Useful functions for writing heap analysis tools which use @@ -42,23 +42,22 @@ network >= 2.6 , containers ^>= 0.6, unordered-containers ^>= 0.2.13, - ghc-debug-common == 0.4.0.0, - ghc-debug-convention == 0.4.0.0, + ghc-debug-common == 0.5.0.0, + ghc-debug-convention == 0.5.0.0, text >= 1.2.4 && < 3, process ^>= 1.6, filepath ^>= 1.4, directory ^>= 1.3, bitwise ^>= 1.0, hashable >= 1.3 && < 1.5, - mtl ^>= 2.2, - eventlog2html == 0.9.3, + mtl >= 2.2 && <2.4, binary ^>= 0.8, psqueues ^>= 0.2, dom-lt ^>= 0.2, async ^>= 2.2, monoidal-containers >= 0.6, language-dot ^>= 0.1, - ghc-prim >= 0.8 && <0.10, + ghc-prim >= 0.8 && <0.11, stm ^>= 2.5, bytestring, contra-tracer diff --git a/src/GHC/Debug/Client/Monad.hs b/src/GHC/Debug/Client/Monad.hs --- a/src/GHC/Debug/Client/Monad.hs +++ b/src/GHC/Debug/Client/Monad.hs @@ -18,9 +18,12 @@ -- * Running/Connecting to a debuggee , withDebuggeeRun , withDebuggeeConnect + , withDebuggeeConnectTCP , debuggeeRun , debuggeeConnect + , debuggeeConnectTCP , debuggeeConnectWithTracer + , debuggeeConnectWithTracerTCP , debuggeeClose -- * Snapshot run , snapshotInit @@ -31,6 +34,7 @@ ) where import Control.Exception (finally) +import Data.Word (Word16) import Network.Socket import System.Process import System.Environment @@ -81,6 +85,19 @@ `finally` debuggeeClose new_env +-- | Bracketed version of @debuggeeConnectTCP@. Connects to a debuggee, runs the +-- action, then closes the debuggee. +withDebuggeeConnectTCP + :: String -- ^ host of the tcp socket (e.g. @"127.0.0.1"@) + -> Word16 -- ^ port of the tcp socket (e.g. @1235@) + -> (Debuggee -> IO a) + -> IO a +withDebuggeeConnectTCP host port action = do + new_env <- debuggeeConnectTCP host port + action new_env + `finally` + debuggeeClose new_env + -- | Run a debuggee and connect to it. Use @debuggeeClose@ when you're done. debuggeeRun :: FilePath -- ^ path to executable to run as the debuggee -> FilePath -- ^ filename of socket (e.g. @"\/tmp\/ghc-debug"@) @@ -94,6 +111,9 @@ debuggeeConnect :: FilePath -> IO Debuggee debuggeeConnect = debuggeeConnectWithTracer debugTracer +debuggeeConnectTCP :: String -> Word16 -> IO Debuggee +debuggeeConnectTCP = debuggeeConnectWithTracerTCP debugTracer + -- | Connect to a debuggee on the given socket. Use @debuggeeClose@ when you're done. debuggeeConnectWithTracer :: Tracer IO String @@ -102,6 +122,19 @@ debuggeeConnectWithTracer tracer socketName = do s <- socket AF_UNIX Stream defaultProtocol connect s (SockAddrUnix socketName) + hdl <- socketToHandle s ReadWriteMode + new_env <- newEnv @DebugM tracer (SocketMode hdl) + return (Debuggee new_env) + +debuggeeConnectWithTracerTCP + :: Tracer IO String + -> String -- ^ host of the tcp socket (e.g. @"127.0.0.1"@) + -> Word16 -- ^ port of the tcp socket (e.g. @1235@) + -> IO Debuggee +debuggeeConnectWithTracerTCP tracer host port = do + addr:_ <- getAddrInfo (Just defaultHints) (Just host) (Just $ show port) + s <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) + connect s (addrAddress addr) hdl <- socketToHandle s ReadWriteMode new_env <- newEnv @DebugM tracer (SocketMode hdl) return (Debuggee new_env) diff --git a/src/GHC/Debug/ParTrace.hs b/src/GHC/Debug/ParTrace.hs --- a/src/GHC/Debug/ParTrace.hs +++ b/src/GHC/Debug/ParTrace.hs @@ -22,6 +22,7 @@ import qualified Data.IntMap as IM import Data.Array.BitArray.IO hiding (map) import Control.Monad.Reader +import Control.Monad import Data.Word import GHC.Debug.Client.Monad.Simple import GHC.Debug.Client.Monad.Class diff --git a/src/GHC/Debug/Profile.hs b/src/GHC/Debug/Profile.hs --- a/src/GHC/Debug/Profile.hs +++ b/src/GHC/Debug/Profile.hs @@ -11,8 +11,7 @@ {-# LANGUAGE RecordWildCards #-} {- | Functions for performing whole heap census in the style of the normal - heap profiling -} -module GHC.Debug.Profile( profile - , censusClosureType +module GHC.Debug.Profile( censusClosureType , census2LevelClosureType , closureCensusBy , CensusByClosureType @@ -32,19 +31,21 @@ import Control.Monad.State import Data.List (sortBy) import Data.Ord -import Control.Concurrent -import Eventlog.Types -import Eventlog.Data -import Eventlog.Total -import Eventlog.HtmlTemplate -import Eventlog.Args (defaultArgs, Option(..)) import Data.Text (pack, Text, unpack) import Data.Semigroup import qualified Data.Text as T import qualified Data.Map.Monoidal.Strict as MMap import Data.Bitraversable +import Control.Monad +--import Control.Concurrent +--import Eventlog.Types +--import Eventlog.Data +--import Eventlog.Total +--import Eventlog.HtmlTemplate +--import Eventlog.Args (defaultArgs, Option(..)) + type CensusByClosureType = Map.Map Text CensusStats -- | Perform a heap census in the same style as the -hT profile. @@ -163,6 +164,7 @@ writeFile outpath (unlines $ "key, total, count, max, avg" : map showLine res) +{- -- | Peform a profile at the given interval (in seconds), the result will -- be rendered after each iteration using @eventlog2html@. profile :: FilePath -> Int -> Debuggee -> IO () @@ -209,5 +211,6 @@ let html = templateString header data_json descs closure_descs as writeFile "profile/ht.html" html return () + -} diff --git a/src/GHC/Debug/Retainers.hs b/src/GHC/Debug/Retainers.hs --- a/src/GHC/Debug/Retainers.hs +++ b/src/GHC/Debug/Retainers.hs @@ -1,11 +1,12 @@ {-# LANGUAGE ViewPatterns #-} -- | Functions for computing retainers -module GHC.Debug.Retainers(findRetainersOf, findRetainersOfConstructor, findRetainersOfConstructorExact, findRetainers, addLocationToStack, displayRetainerStack, addLocationToStack', displayRetainerStack') where +module GHC.Debug.Retainers(findRetainersOf, findRetainersOfConstructor, findRetainersOfConstructorExact, findRetainersOfInfoTable, findRetainers, addLocationToStack, displayRetainerStack, addLocationToStack', displayRetainerStack') where import GHC.Debug.Client import Control.Monad.State import GHC.Debug.Trace import GHC.Debug.Types.Graph +import Control.Monad import qualified Data.Set as Set import Control.Monad.RWS @@ -44,6 +45,12 @@ Just cur_loc -> return $ (infoName cur_loc) == clos_name + +findRetainersOfInfoTable :: Maybe Int -> [ClosurePtr] -> InfoTablePtr -> DebugM [[ClosurePtr]] +findRetainersOfInfoTable limit rroots info_ptr = + findRetainers limit rroots go + where + go _ sc = return $ tableId (info (noSize sc)) == info_ptr -- | From the given roots, find any path to one of the given pointers. -- Note: This function can be quite slow! The first argument is a limit to diff --git a/src/GHC/Debug/Trace.hs b/src/GHC/Debug/Trace.hs --- a/src/GHC/Debug/Trace.hs +++ b/src/GHC/Debug/Trace.hs @@ -11,6 +11,7 @@ import qualified Data.IntMap as IM import Data.Array.BitArray.IO import Control.Monad.Reader +import Control.Monad import Data.IORef import Data.Word diff --git a/src/GHC/Debug/TypePointsFrom.hs b/src/GHC/Debug/TypePointsFrom.hs --- a/src/GHC/Debug/TypePointsFrom.hs +++ b/src/GHC/Debug/TypePointsFrom.hs @@ -39,6 +39,7 @@ import Data.List (sortOn) import Language.Dot import qualified Data.Set as S +import Control.Monad type Key = InfoTablePtr