diff options
| author | Tom Smeding <tom@tomsmeding.com> | 2022-04-21 00:46:24 +0200 | 
|---|---|---|
| committer | Tom Smeding <tom@tomsmeding.com> | 2022-04-21 00:46:24 +0200 | 
| commit | 7b9e405e2f77268e3242a6d723c1b65d7759fd63 (patch) | |
| tree | ace2f30ecc395a04758b18ec311b9aee41a64860 /src | |
| parent | e6ca9f166c5af915946bb8ae5ed7e5a42f40b8bd (diff) | |
Expose GC end timestamp
Diffstat (limited to 'src')
| -rw-r--r-- | src/GHC/GC_Hook.hs | 21 | 
1 files changed, 18 insertions, 3 deletions
| diff --git a/src/GHC/GC_Hook.hs b/src/GHC/GC_Hook.hs index ea1586c..44826c9 100644 --- a/src/GHC/GC_Hook.hs +++ b/src/GHC/GC_Hook.hs @@ -3,6 +3,7 @@  module GHC.GC_Hook (    setGCHook,    getGCLog, +  Details(..),  ) where  import Control.Monad ((>=>)) @@ -11,14 +12,23 @@ import Foreign.C.Types (CChar, CSize(..))  import Foreign.Marshal.Alloc (alloca, allocaBytes)  import Foreign.Ptr (Ptr, castPtr, plusPtr)  import Foreign.Storable (peek) +import qualified System.Clock as Clock  foreign import ccall "set_gchook" c_set_gchook    :: IO ()  foreign import ccall "copy_log_to_buffer" c_copy_log_to_buffer    :: CSize -> Ptr CChar -> Ptr CSize -> Ptr CSize -> IO () +-- | GC details as given to the GC hook installed by 'setGCHook'. The only +-- field that is not contained in `GCDetails_` provided by the GHC RTS is +-- 'detTimestamp', which is the time at which the GC was finished. The GC start +-- time can probably be computed by subtracting 'detElapsedNs' from this.  data Details = Details -  { -- | The generation number of this GC +  { -- | The timestamp at which the GC was finished (i.e. `gcDoneHook` was +    -- called). Note: this is recorded using the 'Clock.Monotonic' clock. +    detTimestamp :: Clock.TimeSpec + +  , -- | The generation number of this GC      detGen :: Word32    , -- | Number of threads used in this GC      detThreads :: Word32 @@ -76,12 +86,15 @@ data Details = Details    deriving (Show)  zeroDetails :: Details -zeroDetails = Details 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +zeroDetails = Details (Clock.fromNanoSecs 0) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +-- | Initialise the GC hook.  setGCHook :: IO ()  setGCHook = do    c_set_gchook +-- | Get the log of 'Details' structures up until now; also clears the log. You +-- will never get the same structure twice.  getGCLog :: IO [Details]  getGCLog =    let bufferCapacity = 2048 @@ -105,7 +118,9 @@ peekDetails unitsize startptr =    where      fields :: [(Int, Ptr a -> Details -> IO Details)]      fields = -      [(4, peekModify $ \d x -> d { detGen = x }) +      [(8, peekModify $ \d x -> d { detTimestamp = (detTimestamp d) { Clock.sec = x } }) +      ,(8, peekModify $ \d x -> d { detTimestamp = (detTimestamp d) { Clock.nsec = x } }) +      ,(4, peekModify $ \d x -> d { detGen = x })        ,(4, peekModify $ \d x -> d { detThreads = x })        ,(8, peekModify $ \d x -> d { detAllocatedBytes = x })        ,(8, peekModify $ \d x -> d { detLiveBytes = x }) | 
