diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/GHC/GC_Hook.hs | 130 |
1 files changed, 130 insertions, 0 deletions
diff --git a/src/GHC/GC_Hook.hs b/src/GHC/GC_Hook.hs new file mode 100644 index 0000000..ea1586c --- /dev/null +++ b/src/GHC/GC_Hook.hs @@ -0,0 +1,130 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE TypeApplications #-} +module GHC.GC_Hook ( + setGCHook, + getGCLog, +) where + +import Control.Monad ((>=>)) +import Data.Word (Word32, Word64) +import Foreign.C.Types (CChar, CSize(..)) +import Foreign.Marshal.Alloc (alloca, allocaBytes) +import Foreign.Ptr (Ptr, castPtr, plusPtr) +import Foreign.Storable (peek) + +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 () + +data Details = Details + { -- | The generation number of this GC + detGen :: Word32 + , -- | Number of threads used in this GC + detThreads :: Word32 + , -- | Number of bytes allocated since the previous GC + detAllocatedBytes :: Word64 + , -- | Total amount of live data in the heap (incliudes large + compact data). + -- Updated after every GC. Data in uncollected generations (in minor GCs) + -- are considered live. + detLiveBytes :: Word64 + , -- | Total amount of live data in large objects + detLargeObjectsBytes :: Word64 + , -- | Total amount of live data in compact regions + detCompactBytes :: Word64 + , -- | Total amount of slop (wasted memory) + detSlopBytes :: Word64 + , -- | Total amount of memory in use by the RTS + detMemInUseBytes :: Word64 + , -- | Total amount of data copied during this GC + detCopiedBytes :: Word64 + , -- | In parallel GC, the max amount of data copied by any one thread + 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! + detSyncElapsedNs :: Word64 + , -- | The CPU time used during GC itself + -- NOTE: nanoseconds! + detCpuNs :: Word64 + , -- | The time elapsed during GC itself + -- NOTE: nanoseconds! + detElapsedNs :: Word64 + + , -- | 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. + -- The time elapsed during the post-mark pause phase of the concurrent + -- nonmoving GC. + -- NOTE: nanoseconds! + detNonmovingGcSyncElapsedNs :: Word64 + , -- | 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. + -- The time elapsed during the post-mark pause phase of the concurrent + -- nonmoving GC. + -- NOTE: nanoseconds! + detNonmovingGcElapsedNs :: Word64 + } + deriving (Show) + +zeroDetails :: Details +zeroDetails = Details 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + +setGCHook :: IO () +setGCHook = do + c_set_gchook + +getGCLog :: IO [Details] +getGCLog = + let bufferCapacity = 2048 + in allocaBytes bufferCapacity $ \pbuffer -> + alloca $ \punitsize -> + alloca $ \pnumstored -> do + c_copy_log_to_buffer (fromIntegral @Int @CSize bufferCapacity) pbuffer punitsize pnumstored + unitsize <- fromIntegral @CSize @Int <$> peek punitsize + numstored <- fromIntegral @CSize @Int <$> peek pnumstored + sequence [peekDetails unitsize (pbuffer `plusPtr` (i * unitsize)) + | i <- [0 .. numstored - 1]] + +peekDetails :: Int -> Ptr a -> IO Details +peekDetails unitsize startptr = + let getField :: Int -> (Int, Ptr a -> Details -> IO Details) + -> Details -> IO Details + getField offset (_, fun) = fun (startptr `plusPtr` offset) + in if last offsets == unitsize + then foldr (>=>) return (zipWith getField offsets fields) zeroDetails + else error "hook.c not compatible with GC_Hook.hs, ShadowDetails mismatch" + where + fields :: [(Int, Ptr a -> Details -> IO Details)] + fields = + [(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 }) + ,(8, peekModify $ \d x -> d { detLargeObjectsBytes = x }) + ,(8, peekModify $ \d x -> d { detCompactBytes = x }) + ,(8, peekModify $ \d x -> d { detSlopBytes = x }) + ,(8, peekModify $ \d x -> d { detMemInUseBytes = x }) + ,(8, peekModify $ \d x -> d { detCopiedBytes = x }) + ,(8, peekModify $ \d x -> d { detParMaxCopiedBytes = x }) + ,(8, peekModify $ \d x -> d { detParBalancedCopiedBytes = x }) + ,(8, peekModify $ \d x -> d { detSyncElapsedNs = x }) + ,(8, peekModify $ \d x -> d { detCpuNs = x }) + ,(8, peekModify $ \d x -> d { detElapsedNs = x }) + ,(8, peekModify $ \d x -> d { detNonmovingGcSyncCpuNs = x }) + ,(8, peekModify $ \d x -> d { detNonmovingGcSyncElapsedNs = x }) + ,(8, peekModify $ \d x -> d { detNonmovingGcCpuNs = x }) + ,(8, peekModify $ \d x -> d { detNonmovingGcElapsedNs = x }) + ] + where peekModify g p d = peek (castPtr p) >>= \x -> return (g d x) + + offsets :: [Int] + offsets = scanl (+) 0 (map fst fields) |