[Git][ghc/ghc][wip/ghci-leaks-fix] Store dehydrated data structures in CgModBreaks

Matthew Pickering (@mpickering) gitlab at gitlab.haskell.org
Tue Jan 24 15:33:54 UTC 2023



Matthew Pickering pushed to branch wip/ghci-leaks-fix at Glasgow Haskell Compiler / GHC


Commits:
afea21b9 by Matthew Pickering at 2023-01-24T15:32:51+00:00
Store dehydrated data structures in CgModBreaks

This fixes a tricky leak in GHCi where we were retaining old copies of
HscEnvs when reloading. If not all modules were recompiled then these
hydrated fields in break points would retain a reference to the old
HscEnv which could double memory usage.

Fixes #22530

- - - - -


5 changed files:

- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/CoreToIface.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/StgToByteCode.hs


Changes:

=====================================
compiler/GHC/ByteCode/Types.hs
=====================================
@@ -14,7 +14,7 @@ module GHC.ByteCode.Types
   , ByteOff(..), WordOff(..)
   , UnlinkedBCO(..), BCOPtr(..), BCONPtr(..)
   , ItblEnv, ItblPtr(..)
-  , CgBreakInfo(..)
+  , DehydratedCgBreakInfo(..)
   , ModBreaks (..), BreakIndex, emptyModBreaks
   , CCostCentre
   ) where
@@ -23,12 +23,10 @@ import GHC.Prelude
 
 import GHC.Data.FastString
 import GHC.Data.SizedSeq
-import GHC.Types.Id
 import GHC.Types.Name
 import GHC.Types.Name.Env
 import GHC.Utils.Outputable
 import GHC.Builtin.PrimOps
-import GHC.Core.Type
 import GHC.Types.SrcLoc
 import GHCi.BreakArray
 import GHCi.RemoteTypes
@@ -41,10 +39,10 @@ import Data.Array.Base  ( UArray(..) )
 import Data.ByteString (ByteString)
 import Data.IntMap (IntMap)
 import qualified Data.IntMap as IntMap
-import Data.Maybe (catMaybes)
 import qualified GHC.Exts.Heap as Heap
 import GHC.Stack.CCS
 import GHC.Cmm.Expr ( GlobalRegSet, emptyRegSet, regSetToList )
+import GHC.Iface.Syntax
 
 -- -----------------------------------------------------------------------------
 -- Compiled Byte Code
@@ -174,18 +172,23 @@ instance NFData BCONPtr where
   rnf x = x `seq` ()
 
 -- | Information about a breakpoint that we know at code-generation time
-data CgBreakInfo
-   = CgBreakInfo
-   { cgb_vars   :: [Maybe (Id,Word16)]
-   , cgb_resty  :: Type
+-- In order to be used, this needs to be hydrated relative to the current HscEnv by
+-- 'hydrateCgBreakInfo'. Everything here can be fully forced and that's critical for
+-- prevening space leaks (see #22530)
+data DehydratedCgBreakInfo
+   = DehydratedCgBreakInfo
+   { cgb_tyvars :: !([IfaceTvBndr]) -- Type variables bound by breakpoint
+   , cgb_vars   :: !([Maybe (IfaceIdBndr, Word16)])
+   , cgb_resty  :: !IfaceType
    }
 -- See Note [Syncing breakpoint info] in GHC.Runtime.Eval
 
 -- Not a real NFData instance because we can't rnf Id or Type
-seqCgBreakInfo :: CgBreakInfo -> ()
-seqCgBreakInfo CgBreakInfo{..} =
-  rnf (map snd (catMaybes (cgb_vars))) `seq`
-  seqType cgb_resty
+seqCgBreakInfo :: DehydratedCgBreakInfo -> ()
+seqCgBreakInfo DehydratedCgBreakInfo{..} =
+    rnf cgb_tyvars `seq`
+    rnf cgb_vars `seq`
+    rnf cgb_resty
 
 instance Outputable UnlinkedBCO where
    ppr (UnlinkedBCO nm _arity _insns _bitmap lits ptrs)
@@ -193,7 +196,7 @@ instance Outputable UnlinkedBCO where
              ppr (sizeSS lits), text "lits",
              ppr (sizeSS ptrs), text "ptrs" ]
 
-instance Outputable CgBreakInfo where
+instance Outputable DehydratedCgBreakInfo where
    ppr info = text "CgBreakInfo" <+>
               parens (ppr (cgb_vars info) <+>
                       ppr (cgb_resty info))
@@ -222,7 +225,7 @@ data ModBreaks
         -- See Note [Field modBreaks_decls]
    , modBreaks_ccs :: !(Array BreakIndex (RemotePtr CostCentre))
         -- ^ Array pointing to cost centre for each breakpoint
-   , modBreaks_breakInfo :: IntMap CgBreakInfo
+   , modBreaks_breakInfo :: IntMap DehydratedCgBreakInfo
         -- ^ info about each breakpoint from the bytecode generator
    }
 


=====================================
compiler/GHC/CoreToIface.hs
=====================================
@@ -43,12 +43,18 @@ module GHC.CoreToIface
     , toIfaceVar
       -- * Other stuff
     , toIfaceLFInfo
+      -- * CgBreakInfo
+    , dehydrateCgBreakInfo
     ) where
 
 import GHC.Prelude
 
+import Data.Word
+
 import GHC.StgToCmm.Types
 
+import GHC.ByteCode.Types
+
 import GHC.Core
 import GHC.Core.TyCon hiding ( pprPromotionQuote )
 import GHC.Core.Coercion.Axiom
@@ -685,6 +691,16 @@ toIfaceLFInfo nm lfi = case lfi of
     LFLetNoEscape ->
       panic "toIfaceLFInfo: LFLetNoEscape"
 
+-- Dehydrating CgBreakInfo
+
+dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word16)] -> Type -> DehydratedCgBreakInfo
+dehydrateCgBreakInfo ty_vars idOffSets tick_ty =
+          DehydratedCgBreakInfo
+            { cgb_tyvars = map toIfaceTvBndr ty_vars
+            , cgb_vars = map (fmap (\(i, offset) -> (toIfaceIdBndr i, offset))) idOffSets
+            , cgb_resty = toIfaceType tick_ty
+            }
+
 {- Note [Inlining and hs-boot files]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider this example (#10083, #12789):


=====================================
compiler/GHC/IfaceToCore.hs
=====================================
@@ -12,6 +12,7 @@ Type checking of type signatures in interface files
 
 {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
 {-# LANGUAGE TupleSections #-}
+{-# LANGUAGE RecordWildCards #-}
 
 module GHC.IfaceToCore (
         tcLookupImported_maybe,
@@ -25,10 +26,15 @@ module GHC.IfaceToCore (
         tcIfaceExpr,    -- Desired by HERMIT (#7683)
         tcIfaceGlobal,
         tcIfaceOneShot, tcTopIfaceBindings,
+        hydrateCgBreakInfo
  ) where
 
 import GHC.Prelude
 
+import GHC.ByteCode.Types
+
+import Data.Word
+
 import GHC.Driver.Env
 import GHC.Driver.Session
 import GHC.Driver.Config.Core.Lint ( initLintConfig )
@@ -2166,3 +2172,12 @@ bindIfaceTyConBinderX :: (IfaceBndr -> (TyCoVar -> IfL a) -> IfL a)
 bindIfaceTyConBinderX bind_tv (Bndr tv vis) thing_inside
   = bind_tv tv $ \tv' ->
     thing_inside (Bndr tv' vis)
+
+-- CgBreakInfo
+
+hydrateCgBreakInfo :: DehydratedCgBreakInfo -> IfL ([Maybe (Id, Word16)], Type)
+hydrateCgBreakInfo DehydratedCgBreakInfo{..} = do
+  bindIfaceTyVars cgb_tyvars $ \_ -> do
+    result_ty <- tcIfaceType cgb_resty
+    mbVars <- mapM (traverse (\(if_gbl, offset) -> (,offset) <$> bindIfaceId if_gbl return)) cgb_vars
+    return (mbVars, result_ty)


=====================================
compiler/GHC/Runtime/Eval.hs
=====================================
@@ -136,6 +136,7 @@ import GHC.Tc.Solver (simplifyWantedsTcM)
 import GHC.Tc.Utils.Monad
 import GHC.Core.Class (classTyCon)
 import GHC.Unit.Env
+import GHC.IfaceToCore
 
 -- -----------------------------------------------------------------------------
 -- running a statement interactively
@@ -562,18 +563,27 @@ bindLocalsAtBreakpoint hsc_env apStack_fhv (Just BreakInfo{..}) = do
        breaks    = getModBreaks hmi
        info      = expectJust "bindLocalsAtBreakpoint2" $
                      IntMap.lookup breakInfo_number (modBreaks_breakInfo breaks)
-       mbVars    = cgb_vars info
-       result_ty = cgb_resty info
        occs      = modBreaks_vars breaks ! breakInfo_number
        span      = modBreaks_locs breaks ! breakInfo_number
        decl      = intercalate "." $ modBreaks_decls breaks ! breakInfo_number
 
+  -- Rehydrate to understand the breakpoint info relative to the current environemnt.
+  -- This design is critical to preventing leaks (#22530)
+   (mbVars, result_ty) <- initIfaceLoad hsc_env
+                            $ initIfaceLcl breakInfo_module (text "debugger") NotBoot
+                            $ hydrateCgBreakInfo info
+
+
+   let
+
            -- Filter out any unboxed ids by changing them to Nothings;
            -- we can't bind these at the prompt
        mbPointers = nullUnboxed <$> mbVars
 
        (ids, offsets, occs') = syncOccs mbPointers occs
 
+
+
        free_tvs = tyCoVarsOfTypesWellScoped (result_ty:map idType ids)
 
    -- It might be that getIdValFromApStack fails, because the AP_STACK


=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -89,6 +89,7 @@ import Data.Either ( partitionEithers )
 
 import GHC.Stg.Syntax
 import qualified Data.IntSet as IntSet
+import GHC.CoreToIface
 
 -- -----------------------------------------------------------------------------
 -- Generating byte code for a complete module
@@ -370,10 +371,8 @@ schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_no fvs) rhs)
         this_mod <- moduleName <$> getCurrentModule
         platform <- profilePlatform <$> getProfile
         let idOffSets = getVarOffSets platform d p fvs
-        let breakInfo = CgBreakInfo
-                        { cgb_vars = idOffSets
-                        , cgb_resty = tick_ty
-                        }
+            ty_vars   = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
+        let breakInfo = dehydrateCgBreakInfo ty_vars idOffSets tick_ty
         newBreakInfo tick_no breakInfo
         hsc_env <- getHscEnv
         let cc | Just interp <- hsc_interp hsc_env
@@ -2165,7 +2164,7 @@ data BcM_State
         , ffis        :: [FFIInfo]       -- ffi info blocks, to free later
                                          -- Should be free()d when it is GCd
         , modBreaks   :: Maybe ModBreaks -- info about breakpoints
-        , breakInfo   :: IntMap CgBreakInfo
+        , breakInfo   :: IntMap DehydratedCgBreakInfo
         , topStrings  :: IdEnv (RemotePtr ()) -- top-level string literals
           -- See Note [generating code for top-level string literal bindings].
         }
@@ -2244,7 +2243,7 @@ getCCArray = BcM $ \st ->
   return (st, modBreaks_ccs breaks)
 
 
-newBreakInfo :: BreakIndex -> CgBreakInfo -> BcM ()
+newBreakInfo :: BreakIndex -> DehydratedCgBreakInfo -> BcM ()
 newBreakInfo ix info = BcM $ \st ->
   return (st{breakInfo = IntMap.insert ix info (breakInfo st)}, ())
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/afea21b94286d59fac9581d6246d64d8d9c4a489

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/afea21b94286d59fac9581d6246d64d8d9c4a489
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230124/2b58e4a4/attachment-0001.html>


More information about the ghc-commits mailing list