1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
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)
|
