summaryrefslogtreecommitdiff
path: root/src/GHC
diff options
context:
space:
mode:
authorTom Smeding <tom@tomsmeding.com>2022-04-21 00:46:24 +0200
committerTom Smeding <tom@tomsmeding.com>2022-04-21 00:46:24 +0200
commit7b9e405e2f77268e3242a6d723c1b65d7759fd63 (patch)
treeace2f30ecc395a04758b18ec311b9aee41a64860 /src/GHC
parente6ca9f166c5af915946bb8ae5ed7e5a42f40b8bd (diff)
Expose GC end timestamp
Diffstat (limited to 'src/GHC')
-rw-r--r--src/GHC/GC_Hook.hs21
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 })