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
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
|
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE TypeApplications #-}
module GHC.GC_Hook (
setGCHook,
getGCLog,
Details(..),
) 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)
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 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
, -- | 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 (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
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 =
[(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 })
,(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)
|
