From 6ca1e41da1d702467dbfb0d6bf7b463884eedc31 Mon Sep 17 00:00:00 2001 From: Tom Smeding Date: Fri, 22 Apr 2022 23:33:12 +0200 Subject: 0.2.0: C hook delegate and enable/disable logging --- src/GHC/GC_Hook.hs | 96 +++++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 73 insertions(+), 23 deletions(-) (limited to 'src/GHC') diff --git a/src/GHC/GC_Hook.hs b/src/GHC/GC_Hook.hs index 35fbbc5..b3e1947 100644 --- a/src/GHC/GC_Hook.hs +++ b/src/GHC/GC_Hook.hs @@ -3,29 +3,39 @@ {-# LANGUAGE TypeApplications #-} module GHC.GC_Hook ( setGCHook, + enableGClogging, getGCLog, + gcSetHookDelegate, Details(..), ) where +import Control.Exception (throwIO) import Control.Monad ((>=>)) import Data.Word (Word32, Word64) -import Foreign.C.Types (CChar, CSize(..)) +import Foreign.C.Types (CBool(..), 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 () +foreign import ccall "set_gchook" c_set_gchook + :: IO CBool +foreign import ccall "gchook_enable_logging" c_gchook_enable_logging + :: CBool -> IO () +foreign import ccall "gchook_set_c_delegate" c_gchook_set_c_delegate + :: Ptr () -> IO CBool -- | 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 +-- 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. +-- +-- The documentation of the fields (other than @detTimestamp@) is copied from +-- GHC @rts\/include\/RtsAPI.h@. data Details = Details - { -- | The timestamp at which the GC was finished (i.e. `gcDoneHook` was + { -- | 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 @@ -35,7 +45,7 @@ data Details = Details detThreads :: Word32 , -- | Number of bytes allocated since the previous GC detAllocatedBytes :: Word64 - , -- | Total amount of live data in the heap (incliudes large + compact data). + , -- | Total amount of live data in the heap (includes large + compact data). -- Updated after every GC. Data in uncollected generations (in minor GCs) -- are considered live. detLiveBytes :: Word64 @@ -53,35 +63,28 @@ data Details = Details detParMaxCopiedBytes :: Word64 , -- | In parallel GC, the amount of balanced data copied by all threads detParBalancedCopiedBytes :: Word64 - , -- | The time elapsed during synchronisation before GC - -- NOTE: nanoseconds! + , -- | (nanoseconds) The time elapsed during synchronisation before GC detSyncElapsedNs :: Word64 - , -- | The CPU time used during GC itself - -- NOTE: nanoseconds! + , -- | (nanoseconds) The CPU time used during GC itself detCpuNs :: Word64 - , -- | The time elapsed during GC itself - -- NOTE: nanoseconds! + , -- | (nanoseconds) The time elapsed during GC itself detElapsedNs :: Word64 - , -- | Concurrent garbage collector. + , -- | (nanoseconds) Concurrent garbage collector. -- The CPU time used during the post-mark pause phase of the concurrent -- nonmoving GC. - -- NOTE: nanoseconds! detNonmovingGcSyncCpuNs :: Word64 - , -- | Concurrent garbage collector. + , -- | (nanoseconds) Concurrent garbage collector. -- The time elapsed during the post-mark pause phase of the concurrent -- nonmoving GC. - -- NOTE: nanoseconds! detNonmovingGcSyncElapsedNs :: Word64 - , -- | Concurrent garbage collector. + , -- | (nanoseconds) Concurrent garbage collector. -- The CPU time used during the post-mark pause phase of the concurrent -- nonmoving GC. - -- NOTE: nanoseconds! detNonmovingGcCpuNs :: Word64 - , -- | Concurrent garbage collector. + , -- | (nanoseconds) Concurrent garbage collector. -- The time elapsed during the post-mark pause phase of the concurrent -- nonmoving GC. - -- NOTE: nanoseconds! detNonmovingGcElapsedNs :: Word64 } deriving (Show) @@ -89,13 +92,60 @@ data Details = Details zeroDetails :: Details 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. +-- | Initialise the GC hook. Note: to use 'getGCLog' you first need to also +-- call @'enableGClogging' True@. setGCHook :: IO () -setGCHook = do - c_set_gchook +setGCHook = + c_set_gchook >>= \case + CBool 0 -> throwIO (userError "Failure setting GC hook") + CBool _ -> return () + +-- | Enable or disable GC logging. If the argument is true, logging is enabled; +-- if the argument is false, any pending logs are cleared and logging is +-- disabled from now on. +enableGClogging :: Bool -> IO () +enableGClogging yes = c_gchook_enable_logging (CBool (if yes then 1 else 0)) + +-- | Set a C function to be called after every GC. Use this in the following manner: +-- +-- * Create a file @cbits/something.c@ in your project (the actual file name +-- doesn't matter), and add @c-sources: cbits/something.c@ to the stanza of +-- the correct component in your .cabal file. +-- * Put the following in it: (The function names are unimportant.) +-- +-- > #include "Rts.h" +-- > +-- > // the static is unnecessary, but neat +-- > static void my_delegate_function(const struct GCDetails_ *d) { +-- > // put your code here +-- > } +-- > +-- > void* get_my_delegate_ptr(void) { +-- > return my_delegate_function; +-- > } +-- +-- * Use the following in Haskell: +-- +-- @ +-- {-# LANGUAGE ForeignFunctionInterface #-} +-- import Foreign.Ptr (Ptr) +-- foreign import ccall "get_my_delegate_ptr" c_get_my_delegate_ptr :: IO (Ptr ()) +-- -- ... +-- do funptr <- c_get_my_delegate_ptr +-- 'gcSetHookDelegate' funptr +-- @ +gcSetHookDelegate :: Ptr () -> IO () +gcSetHookDelegate funptr = + c_gchook_set_c_delegate funptr >>= \case + CBool 0 -> throwIO (userError "Failure setting hook delegate, already set?") + CBool _ -> return () -- | Get the log of 'Details' structures up until now; also clears the log. You -- will never get the same structure twice. +-- +-- Note: This is not entirely atomic. If you call this function concurrently, +-- it is possible that alternatingly, some events go to one 'getGCLog' call and +-- other events go to the other call. getGCLog :: IO [Details] getGCLog = getLogBatch >>= \case -- cgit v1.2.3-70-g09d2