blob: 51e3958ba224e0a14c6ad3b619e996df1e648965 (
plain)
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
|
{-# LANGUAGE RecordWildCards, LambdaCase #-}
module GHCi.Leak
( LeakIndicators
, getLeakIndicators
, checkLeakIndicators
) where
import Control.Monad
import Data.Bits
import Foreign.Ptr (ptrToIntPtr, intPtrToPtr)
import GHC
import GHC.Ptr (Ptr (..))
import GHCi.Util
import GHC.Driver.Env
import GHC.Driver.Ppr
import GHC.Utils.Outputable
import GHC.Unit.Module.ModDetails
import GHC.Unit.Home.ModInfo
import GHC.Platform (target32Bit)
import GHC.Linker.Types
import Prelude
import System.Mem
import System.Mem.Weak
import GHC.Types.Unique.DFM
import Control.Exception
-- Checking for space leaks in GHCi. See #15111, and the
-- -fghci-leak-check flag.
data LeakIndicators = LeakIndicators [LeakModIndicators]
data LeakModIndicators = LeakModIndicators
{ leakMod :: Weak HomeModInfo
, leakIface :: Weak ModIface
, leakDetails :: Weak ModDetails
, leakLinkable :: [Maybe (Weak Linkable)]
}
-- | Grab weak references to some of the data structures representing
-- the currently loaded modules.
getLeakIndicators :: HscEnv -> IO LeakIndicators
getLeakIndicators hsc_env =
fmap LeakIndicators $
forM (eltsUDFM (hsc_HPT hsc_env)) $ \hmi@HomeModInfo{..} -> do
leakMod <- mkWeakPtr hmi Nothing
leakIface <- mkWeakPtr hm_iface Nothing
leakDetails <- mkWeakPtr hm_details Nothing
leakLinkable <- mkWeakLinkables hm_linkable
return $ LeakModIndicators{..}
where
mkWeakLinkables :: HomeModLinkable -> IO [Maybe (Weak Linkable)]
mkWeakLinkables (HomeModLinkable mbc mo) =
mapM (\ln -> traverse (flip mkWeakPtr Nothing <=< evaluate) ln) [mbc, mo]
-- | Look at the LeakIndicators collected by an earlier call to
-- `getLeakIndicators`, and print messasges if any of them are still
-- alive.
checkLeakIndicators :: DynFlags -> LeakIndicators -> IO ()
checkLeakIndicators dflags (LeakIndicators leakmods) = do
performGC
forM_ leakmods $ \LeakModIndicators{..} -> do
deRefWeak leakMod >>= \case
Nothing -> return ()
Just hmi ->
report ("HomeModInfo for " ++
showSDoc dflags (ppr (mi_module (hm_iface hmi)))) (Just hmi)
deRefWeak leakIface >>= \case
Nothing -> return ()
Just miface -> report ("ModIface:" ++ moduleNameString (moduleName (mi_module miface))) (Just miface)
deRefWeak leakDetails >>= report "ModDetails"
forM_ leakLinkable $ \l -> forM_ l $ \l' -> deRefWeak l' >>= report "Linkable"
where
report :: String -> Maybe a -> IO ()
report _ Nothing = return ()
report msg (Just a) = do
addr <- anyToPtr a
putStrLn ("-fghci-leak-check: " ++ msg ++ " is still alive at " ++
show (maskTagBits addr))
tagBits
| target32Bit (targetPlatform dflags) = 2
| otherwise = 3
maskTagBits :: Ptr a -> Ptr a
maskTagBits p = intPtrToPtr (ptrToIntPtr p .&. complement (shiftL 1 tagBits - 1))
|
