Rodrigo Mesquita pushed to branch wip/romes/step-out-8 at Glasgow Haskell Compiler / GHC

Commits:

21 changed files:

Changes:

  • compiler/GHC/ByteCode/Asm.hs
    ... ... @@ -31,7 +31,6 @@ import GHC.ByteCode.Types
    31 31 
     import GHCi.RemoteTypes
    32 32 
     import GHC.Runtime.Heap.Layout ( fromStgWord, StgWord )
    33 33
    34 
    -import GHC.Types.Breakpoint
    35 34 
     import GHC.Types.Name
    36 35 
     import GHC.Types.Name.Set
    37 36 
     import GHC.Types.Literal
    ... ... @@ -74,6 +73,7 @@ import GHC.Float (castFloatToWord32, castDoubleToWord64)
    74 73
    75 74 
     import qualified Data.List as List ( any )
    76 75 
     import GHC.Exts
    76 
    +import GHC.HsToCore.Breakpoints (ModBreaks(..))
    77 77
    78 78
    79 79 
     -- -----------------------------------------------------------------------------
    ... ... @@ -111,7 +111,7 @@ assembleBCOs
    111 111 
       -> FlatBag (ProtoBCO Name)
    112 112 
       -> [TyCon]
    113 113 
       -> [(Name, ByteString)]
    114 
    -  -> Maybe ModBreaks
    114 
    +  -> Maybe (InternalModBreaks, ModBreaks)
    115 115 
       -> [SptEntry]
    116 116 
       -> IO CompiledByteCode
    117 117 
     assembleBCOs profile proto_bcos tycons top_strs modbreaks spt_entries = do

  • compiler/GHC/ByteCode/Breakpoints.hs
    1 
    +{-# LANGUAGE RecordWildCards #-}
    2 
    +
    3 
    +-- | Breakpoint information constructed during ByteCode generation.
    4 
    +--
    5 
    +-- Specifically, code-generation breakpoints are referred to as "internal
    6 
    +-- breakpoints", the internal breakpoint data for a module is stored in
    7 
    +-- 'InternalModBreaks', and is uniquely identified at runtime by an
    8 
    +-- 'InternalBreakpointId'.
    9 
    +--
    10 
    +-- See Note [ModBreaks vs InternalModBreaks] and Note [Breakpoint identifiers]
    11 
    +module GHC.ByteCode.Breakpoints
    12 
    +  ( -- * Internal Mod Breaks
    13 
    +    InternalModBreaks(imodBreaks_breakInfo), CgBreakInfo(..)
    14 
    +  , mkInternalModBreaks
    15 
    +
    16 
    +    -- ** Operations
    17 
    +  , getInternalBreak, addInternalBreak
    18 
    +
    19 
    +    -- ** Internal breakpoint identifier
    20 
    +  , InternalBreakpointId(..), BreakInfoIndex
    21 
    +
    22 
    +    -- * Utils
    23 
    +  , seqInternalModBreaks
    24 
    +
    25 
    +  )
    26 
    +  where
    27 
    +
    28 
    +import GHC.Prelude
    29 
    +import Control.DeepSeq
    30 
    +import Data.IntMap.Strict (IntMap)
    31 
    +import qualified Data.IntMap.Strict as IM
    32 
    +
    33 
    +import GHC.Iface.Syntax
    34 
    +import GHC.Types.Tickish
    35 
    +
    36 
    +import GHC.Unit.Module (Module)
    37 
    +import GHC.Utils.Outputable
    38 
    +import GHC.Utils.Panic
    39 
    +
    40 
    +{-
    41 
    +Note [ModBreaks vs InternalModBreaks]
    42 
    +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    43 
    +'ModBreaks' and 'BreakpointId's must not to be confused with
    44 
    +'InternalModBreaks' and 'InternalBreakId's.
    45 
    +
    46 
    +'ModBreaks' is constructed once during HsToCore from the information attached
    47 
    +to source-level breakpoint ticks and is never changed afterwards. A 'ModBreaks'
    48 
    +can be queried using 'BreakpointId's, which uniquely identifies a breakpoint
    49 
    +within the list of breakpoint information for a given module's 'ModBreaks'.
    50 
    +
    51 
    +'InternalModBreaks' are constructed during bytecode generation and are indexed
    52 
    +by a 'InternalBreakpointId'. They contain all the information relevant to a
    53 
    +breakpoint for code generation that can be accessed during runtime execution
    54 
    +(such as a 'BreakArray' for triggering breakpoints). 'InternalBreakpointId's
    55 
    +are used at runtime to trigger and inspect breakpoints -- a 'BRK_FUN'
    56 
    +instruction receives 'InternalBreakpointId' as an argument.
    57 
    +
    58 
    +We keep a mapping from 'InternalModBreaks' to a 'BreakpointId', which can then be used
    59 
    +to get source-level information about a breakpoint via the corresponding 'ModBreaks'.
    60 
    +
    61 
    +Notably, 'InternalModBreaks' can contain entries for so-called internal
    62 
    +breakpoints, which do not necessarily have a source-level location attached to
    63 
    +it (i.e. do not have a matching entry in 'ModBreaks'). We may leverage this to
    64 
    +introduce breakpoints during code generation for features such as stepping-out.
    65 
    +
    66 
    +Note [Breakpoint identifiers]
    67 
    +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    68 
    +Before optimization a breakpoint is identified uniquely with a tick module
    69 
    +and a tick index. See 'BreakpointId'. A tick module contains an array, indexed
    70 
    +with the tick indexes, which indicates breakpoint status.
    71 
    +
    72 
    +When we generate ByteCode, we collect information for every breakpoint at
    73 
    +their *occurrence sites* (see CgBreakInfo) and these info
    74 
    +are stored in the ModIface of the occurrence module. Because of inlining, we
    75 
    +can't reuse the tick index to uniquely identify an occurrence; because of
    76 
    +cross-module inlining, we can't assume that the occurrence module is the same
    77 
    +as the tick module (#24712).
    78 
    +
    79 
    +So every breakpoint occurrence gets assigned a module-unique *info index* and
    80 
    +we store it alongside the occurrence module (*info module*) in the
    81 
    +'InternalBreakpointId' datatype. This is the index that we use at runtime to
    82 
    +identify a breakpoint.
    83 
    +
    84 
    +When the internal breakpoint has a matching tick-level breakpoint we can fetch
    85 
    +the related tick-level information by first looking up a mapping
    86 
    +@'InternalBreakpointId' -> 'BreakpointId'@. See `internalBreakIdToBreakId`
    87 
    +-}
    88 
    +
    89 
    +--------------------------------------------------------------------------------
    90 
    +-- * Internal breakpoint identifiers
    91 
    +--------------------------------------------------------------------------------
    92 
    +
    93 
    +-- | Internal breakpoint info index
    94 
    +type BreakInfoIndex = Int
    95 
    +
    96 
    +-- | Internal breakpoint identifier
    97 
    +--
    98 
    +-- Indexes into the structures in the @'InternalModBreaks'@ produced during ByteCode generation.
    99 
    +-- See Note [Breakpoint identifiers]
    100 
    +data InternalBreakpointId = InternalBreakpointId
    101 
    +  { ibi_info_mod   :: !Module         -- ^ Breakpoint tick module
    102 
    +  , ibi_info_index :: !BreakInfoIndex -- ^ Breakpoint tick index
    103 
    +  }
    104 
    +  deriving (Eq, Ord)
    105 
    +
    106 
    +--------------------------------------------------------------------------------
    107 
    +-- * Internal Mod Breaks
    108 
    +--------------------------------------------------------------------------------
    109 
    +
    110 
    +-- | Internal mod breaks store the runtime-relevant information of breakpoints.
    111 
    +--
    112 
    +-- Importantly, it maps 'InternalBreakpointId's to 'CgBreakInfo'.
    113 
    +--
    114 
    +-- 'InternalModBreaks' are constructed during bytecode generation and stored in
    115 
    +-- 'CompiledByteCode' afterwards.
    116 
    +data InternalModBreaks = InternalModBreaks
    117 
    +      { imodBreaks_breakInfo :: IntMap CgBreakInfo
    118 
    +        -- ^ Access code-gen time information about a breakpoint, indexed by
    119 
    +        -- 'InternalBreakpointId'.
    120 
    +      , imodBreaks_module :: !Module
    121 
    +        -- ^ Cache the module corresponding to these 'InternalModBreaks' for
    122 
    +        -- sanity checks. Don't export it!
    123 
    +      }
    124 
    +
    125 
    +-- | Construct an 'InternalModBreaks'
    126 
    +mkInternalModBreaks :: Module -> IntMap CgBreakInfo -> InternalModBreaks
    127 
    +mkInternalModBreaks mod im = InternalModBreaks im mod
    128 
    +
    129 
    +-- | Information about a breakpoint that we know at code-generation time
    130 
    +-- In order to be used, this needs to be hydrated relative to the current HscEnv by
    131 
    +-- 'hydrateCgBreakInfo'. Everything here can be fully forced and that's critical for
    132 
    +-- preventing space leaks (see #22530)
    133 
    +data CgBreakInfo
    134 
    +   = CgBreakInfo
    135 
    +   { cgb_tyvars  :: ![IfaceTvBndr] -- ^ Type variables in scope at the breakpoint
    136 
    +   , cgb_vars    :: ![Maybe (IfaceIdBndr, Word)]
    137 
    +   , cgb_resty   :: !IfaceType
    138 
    +   , cgb_tick_id :: !BreakpointId
    139 
    +     -- ^ This field records the original breakpoint tick identifier for this
    140 
    +     -- internal breakpoint info. See Note [Breakpoint identifiers].
    141 
    +   }
    142 
    +-- See Note [Syncing breakpoint info] in GHC.Runtime.Eval
    143 
    +
    144 
    +-- | Get an internal breakpoint info by 'InternalBreakpointId'
    145 
    +getInternalBreak :: InternalBreakpointId -> InternalModBreaks -> CgBreakInfo
    146 
    +getInternalBreak (InternalBreakpointId mod ix) imbs =
    147 
    +  assert_modules_match mod (imodBreaks_module imbs) $
    148 
    +    imodBreaks_breakInfo imbs IM.! ix
    149 
    +
    150 
    +-- | Add a CgBreakInfo to an 'InternalModBreaks' at 'InternalBreakpointId'
    151 
    +addInternalBreak :: InternalBreakpointId -> CgBreakInfo -> InternalModBreaks -> InternalModBreaks
    152 
    +addInternalBreak (InternalBreakpointId mod ix) info imbs =
    153 
    +  assert_modules_match mod (imodBreaks_module imbs) $
    154 
    +    imbs{imodBreaks_breakInfo = IM.insert ix info (imodBreaks_breakInfo imbs)}
    155 
    +
    156 
    +-- | Assert that the module in the 'InternalBreakpointId' and in
    157 
    +-- 'InternalModBreaks' match.
    158 
    +assert_modules_match :: Module -> Module -> a -> a
    159 
    +assert_modules_match ibi_mod imbs_mod =
    160 
    +  assertPpr (ibi_mod == imbs_mod)
    161 
    +    (text "Tried to query the InternalModBreaks of module" <+> ppr imbs_mod
    162 
    +        <+> text "with an InternalBreakpointId for module" <+> ppr ibi_mod)
    163 
    +
    164 
    +-- TODO: See what Cheng has in .
    165 
    +-- mkCCSArray
    166 
    +--   :: Interp -> Module -> Int -> [Tick]
    167 
    +--   -> IO (Array BreakTickIndex (RemotePtr GHC.Stack.CCS.CostCentre))
    168 
    +-- mkCCSArray interp modul count entries
    169 
    +--   | interpreterProfiled interp = do
    170 
    +--       let module_str = moduleNameString (moduleName modul)
    171 
    +--       costcentres <- GHCi.mkCostCentres interp module_str (map mk_one entries)
    172 
    +--       return (listArray (0,count-1) costcentres)
    173 
    +--   | otherwise = return (listArray (0,-1) [])
    174 
    +--  where
    175 
    +--     mk_one t = (name, src)
    176 
    +--       where name = concat $ intersperse "." $ tick_path t
    177 
    +--             src = renderWithContext defaultSDocContext $ ppr $ tick_loc t
    178 
    +--   , modBreaks_ccs :: !(Array BreakTickIndex (RemotePtr CostCentre))
    179 
    +--        -- ^ Array pointing to cost centre for each breakpoint
    180 
    +--    ccs <- mkCCSArray interpProfiled mod count entries
    181 
    +
    182 
    +--------------------------------------------------------------------------------
    183 
    +-- Instances
    184 
    +--------------------------------------------------------------------------------
    185 
    +
    186 
    +-- | Fully force an 'InternalModBreaks' value
    187 
    +seqInternalModBreaks :: InternalModBreaks -> ()
    188 
    +seqInternalModBreaks InternalModBreaks{..} =
    189 
    +    rnf (fmap seqCgBreakInfo imodBreaks_breakInfo)
    190 
    +  where
    191 
    +    seqCgBreakInfo :: CgBreakInfo -> ()
    192 
    +    seqCgBreakInfo CgBreakInfo{..} =
    193 
    +        rnf cgb_tyvars `seq`
    194 
    +        rnf cgb_vars `seq`
    195 
    +        rnf cgb_resty `seq`
    196 
    +        rnf cgb_tick_id
    197 
    +
    198 
    +instance Outputable InternalBreakpointId where
    199 
    +  ppr InternalBreakpointId{..} =
    200 
    +    text "InternalBreakpointId" <+> ppr ibi_info_mod <+> ppr ibi_info_index
    201 
    +
    202 
    +instance NFData InternalBreakpointId where
    203 
    +  rnf InternalBreakpointId{..} =
    204 
    +    rnf ibi_info_mod `seq` rnf ibi_info_index
    205 
    +
    206 
    +instance Outputable CgBreakInfo where
    207 
    +   ppr info = text "CgBreakInfo" <+>
    208 
    +              parens (ppr (cgb_vars info) <+>
    209 
    +                      ppr (cgb_resty info) <+>
    210 
    +                      ppr (cgb_tick_id info))

  • compiler/GHC/ByteCode/Instr.hs
    ... ... @@ -36,7 +36,6 @@ import GHC.Stack.CCS (CostCentre)
    36 36
    37 37 
     import GHC.Stg.Syntax
    38 38 
     import GHCi.BreakArray (BreakArray)
    39 
    -import GHC.Types.Breakpoint
    40 39
    41 40 
     -- ----------------------------------------------------------------------------
    42 41 
     -- Bytecode instructions

  • compiler/GHC/ByteCode/Types.hs
    ... ... @@ -18,15 +18,17 @@ module GHC.ByteCode.Types
    18 18 
       , UnlinkedBCO(..), BCOPtr(..), BCONPtr(..)
    19 19 
       , ItblEnv, ItblPtr(..)
    20 20 
       , AddrEnv, AddrPtr(..)
    21 
    -  , CgBreakInfo(..)
    22 
    -  , ModBreaks (..)
    23 
    -  , CCostCentre
    24 21 
       , FlatBag, sizeFlatBag, fromSmallArray, elemsFlatBag
    22 
    +
    23 
    +  -- * Internal Mod Breaks
    24 
    +  , InternalModBreaks(..), CgBreakInfo(..), seqInternalModBreaks
    25 
    +  -- ** Internal breakpoint identifier
    26 
    +  , InternalBreakpointId(..), BreakInfoIndex
    25 27 
       ) where
    26 28
    27 29 
     import GHC.Prelude
    28 30
    29 
    -import GHC.Types.Breakpoint
    31 
    +import GHC.ByteCode.Breakpoints
    30 32 
     import GHC.Data.FastString
    31 33 
     import GHC.Data.FlatBag
    32 34 
     import GHC.Types.Name
    ... ... @@ -34,7 +36,6 @@ import GHC.Types.Name.Env
    34 36 
     import GHC.Utils.Outputable
    35 37 
     import GHC.Builtin.PrimOps
    36 38 
     import GHC.Types.SptEntry
    37 
    -import GHC.Types.SrcLoc
    38 39 
     import GHCi.BreakArray
    39 40 
     import GHCi.Message
    40 41 
     import GHCi.RemoteTypes
    ... ... @@ -43,14 +44,10 @@ import Control.DeepSeq
    43 44 
     import GHCi.ResolvedBCO ( BCOByteArray(..), mkBCOByteArray )
    44 45
    45 46 
     import Foreign
    46 
    -import Data.Array
    47 47 
     import Data.ByteString (ByteString)
    48 
    -import Data.IntMap (IntMap)
    49 48 
     import qualified GHC.Exts.Heap as Heap
    50 
    -import GHC.Stack.CCS
    51 49 
     import GHC.Cmm.Expr ( GlobalRegSet, emptyRegSet, regSetToList )
    52 
    -import GHC.Iface.Syntax
    53 
    -import GHC.Unit.Module (Module)
    50 
    +import GHC.HsToCore.Breakpoints (ModBreaks)
    54 51
    55 52 
     -- -----------------------------------------------------------------------------
    56 53 
     -- Compiled Byte Code
    ... ... @@ -65,8 +62,12 @@ data CompiledByteCode = CompiledByteCode
    65 62 
       , bc_strs   :: [(Name, ByteString)]
    66 63 
         -- ^ top-level strings (heap allocated)
    67 64
    68 
    -  , bc_breaks :: Maybe ModBreaks
    69 
    -    -- ^ breakpoint info (Nothing if breakpoints are disabled)
    65 
    +  , bc_breaks :: (Maybe (InternalModBreaks, ModBreaks))
    66 
    +    -- ^ internal breakpoint info (no tick-level 'ModBreaks' if breakpoints are disabled)
    67 
    +    --
    68 
    +    -- TODO: If ModBreaks is serialized and reconstructed as part of ModDetails
    69 
    +    -- we don't need to keep it here as it can be fetched from the
    70 
    +    -- 'HomeModInfo' directly.
    70 71
    71 72 
       , bc_spt_entries :: ![SptEntry]
    72 73 
         -- ^ Static pointer table entries which should be loaded along with the
    ... ... @@ -87,8 +88,8 @@ seqCompiledByteCode :: CompiledByteCode -> ()
    87 88 
     seqCompiledByteCode CompiledByteCode{..} =
    88 89 
       rnf bc_bcos `seq`
    89 90 
       rnf bc_itbls `seq`
    90 
    -  rnf bc_strs `seq`
    91 
    -  rnf (fmap seqModBreaks bc_breaks)
    91 
    +  rnf bc_strs
    92 
    +  -- TODO: Add here something if new.
    92 93
    93 94 
     newtype ByteOff = ByteOff Int
    94 95 
         deriving (Enum, Eq, Show, Integral, Num, Ord, Real, Outputable)
    ... ... @@ -282,82 +283,9 @@ data BCONPtr
    282 283 
     instance NFData BCONPtr where
    283 284 
       rnf x = x `seq` ()
    284 285
    285 
    --- | Information about a breakpoint that we know at code-generation time
    286 
    --- In order to be used, this needs to be hydrated relative to the current HscEnv by
    287 
    --- 'hydrateCgBreakInfo'. Everything here can be fully forced and that's critical for
    288 
    --- preventing space leaks (see #22530)
    289 
    -data CgBreakInfo
    290 
    -   = CgBreakInfo
    291 
    -   { cgb_tyvars  :: ![IfaceTvBndr] -- ^ Type variables in scope at the breakpoint
    292 
    -   , cgb_vars    :: ![Maybe (IfaceIdBndr, Word)]
    293 
    -   , cgb_resty   :: !IfaceType
    294 
    -   , cgb_tick_id :: !BreakpointId
    295 
    -     -- ^ This field records the original breakpoint tick identifier for this
    296 
    -     -- internal breakpoint info. See Note [Breakpoint identifiers].
    297 
    -   }
    298 
    --- See Note [Syncing breakpoint info] in GHC.Runtime.Eval
    299 
    -
    300 
    -seqCgBreakInfo :: CgBreakInfo -> ()
    301 
    -seqCgBreakInfo CgBreakInfo{..} =
    302 
    -    rnf cgb_tyvars `seq`
    303 
    -    rnf cgb_vars `seq`
    304 
    -    rnf cgb_resty `seq`
    305 
    -    rnf cgb_tick_id
    306 
    -
    307 286 
     instance Outputable UnlinkedBCO where
    308 287 
        ppr (UnlinkedBCO nm _arity _insns _bitmap lits ptrs)
    309 288 
           = sep [text "BCO", ppr nm, text "with",
    310 289 
                  ppr (sizeFlatBag lits), text "lits",
    311 290 
                  ppr (sizeFlatBag ptrs), text "ptrs" ]
    312 291
    313 
    -instance Outputable CgBreakInfo where
    314 
    -   ppr info = text "CgBreakInfo" <+>
    315 
    -              parens (ppr (cgb_vars info) <+>
    316 
    -                      ppr (cgb_resty info) <+>
    317 
    -                      ppr (cgb_tick_id info))
    318 
    -
    319 
    --- -----------------------------------------------------------------------------
    320 
    --- Breakpoints
    321 
    -
    322 
    --- | C CostCentre type
    323 
    -data CCostCentre
    324 
    -
    325 
    --- | All the information about the breakpoints for a module
    326 
    -data ModBreaks
    327 
    -   = ModBreaks
    328 
    -   { modBreaks_flags :: !(ForeignRef BreakArray)
    329 
    -        -- ^ The array of flags, one per breakpoint,
    330 
    -        -- indicating which breakpoints are enabled.
    331 
    -   , modBreaks_locs :: !(Array BreakTickIndex SrcSpan)
    332 
    -        -- ^ An array giving the source span of each breakpoint.
    333 
    -   , modBreaks_vars :: !(Array BreakTickIndex [OccName])
    334 
    -        -- ^ An array giving the names of the free variables at each breakpoint.
    335 
    -   , modBreaks_decls :: !(Array BreakTickIndex [String])
    336 
    -        -- ^ An array giving the names of the declarations enclosing each breakpoint.
    337 
    -        -- See Note [Field modBreaks_decls]
    338 
    -   , modBreaks_ccs :: !(Array BreakTickIndex (RemotePtr CostCentre))
    339 
    -        -- ^ Array pointing to cost centre for each breakpoint
    340 
    -   , modBreaks_breakInfo :: IntMap CgBreakInfo
    341 
    -        -- ^ info about each breakpoint from the bytecode generator
    342 
    -   , modBreaks_module :: !Module
    343 
    -        -- ^ info about the module in which we are setting the breakpoint
    344 
    -   }
    345 
    -
    346 
    -seqModBreaks :: ModBreaks -> ()
    347 
    -seqModBreaks ModBreaks{..} =
    348 
    -  rnf modBreaks_flags `seq`
    349 
    -  rnf modBreaks_locs `seq`
    350 
    -  rnf modBreaks_vars `seq`
    351 
    -  rnf modBreaks_decls `seq`
    352 
    -  rnf modBreaks_ccs `seq`
    353 
    -  rnf (fmap seqCgBreakInfo modBreaks_breakInfo) `seq`
    354 
    -  rnf modBreaks_module
    355 
    -
    356 
    -{-
    357 
    -Note [Field modBreaks_decls]
    358 
    -~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    359 
    -A value of eg ["foo", "bar", "baz"] in a `modBreaks_decls` field means:
    360 
    -The breakpoint is in the function called "baz" that is declared in a `let`
    361 
    -or `where` clause of a declaration called "bar", which itself is declared
    362 
    -in a `let` or `where` clause of the top-level function called "foo".
    363 
    --}

  • compiler/GHC/Core/Ppr.hs
    ... ... @@ -31,7 +31,6 @@ import GHC.Prelude
    31 31
    32 32 
     import GHC.Core
    33 33 
     import GHC.Core.Stats (exprStats)
    34 
    -import GHC.Types.Breakpoint
    35 34 
     import GHC.Types.Fixity (LexicalFixity(..))
    36 35 
     import GHC.Types.Literal( pprLiteral )
    37 36 
     import GHC.Types.Name( pprInfixName, pprPrefixName )

  • compiler/GHC/CoreToIface.hs
    ... ... @@ -72,7 +72,6 @@ import GHC.Iface.Syntax
    72 72 
     import GHC.Data.FastString
    73 73 
     import GHC.Data.BooleanFormula qualified as BF(BooleanFormula(..))
    74 74
    75 
    -import GHC.Types.Breakpoint
    76 75 
     import GHC.Types.Id
    77 76 
     import GHC.Types.Id.Info
    78 77 
     import GHC.Types.Id.Make ( noinlineIdName, noinlineConstraintIdName )

  • compiler/GHC/HsToCore.hs
    ... ... @@ -97,7 +97,6 @@ import GHC.Unit.Module.Deps
    97 97
    98 98 
     import Data.List (partition)
    99 99 
     import Data.IORef
    100 
    -import Data.Traversable (for)
    101 100 
     import GHC.Iface.Make (mkRecompUsageInfo)
    102 101
    103 102 
     {-
    ... ... @@ -162,13 +161,12 @@ deSugar hsc_env
    162 161 
                                            mod mod_loc
    163 162 
                                            export_set (typeEnvTyCons type_env) binds
    164 163 
                                   else return (binds, Nothing)
    165 
    -        ; modBreaks <- for
    166 
    -           [ (i, s)
    167 
    -           | i <- hsc_interp hsc_env
    168 
    -           , (_, s) <- m_tickInfo
    169 
    -           , breakpointsAllowed dflags
    170 
    -           ]
    171 
    -           $ \(interp, specs) -> mkModBreaks interp mod specs
    164 
    +        ; let modBreaks
    165 
    +                | Just (_, specs) <- m_tickInfo
    166 
    +                , breakpointsAllowed dflags
    167 
    +                = Just $ mkModBreaks mod specs
    168 
    +                | otherwise
    169 
    +                = Nothing
    172 170
    173 171 
             ; ds_hpc_info <- case m_tickInfo of
    174 172 
                 Just (orig_file2, ticks)

  • compiler/GHC/HsToCore/Breakpoints.hs
    1 
    +-- | Information attached to Breakpoints generated from Ticks
    2 
    +--
    3 
    +-- The breakpoint information stored in 'ModBreaks' is generated during
    4 
    +-- desugaring from the ticks annotating the source expressions.
    5 
    +--
    6 
    +-- This information can be queried per-breakpoint using the 'BreakpointId'
    7 
    +-- datatype, which indexes tick-level breakpoint information.
    8 
    +--
    9 
    +-- 'ModBreaks' and 'BreakpointId's are not to be confused with
    10 
    +-- 'InternalModBreaks' and 'InternalBreakId's. The latter are constructed
    11 
    +-- during bytecode generation and can be found in 'GHC.ByteCode.Breakpoints'.
    12 
    +--
    13 
    +-- See Note [ModBreaks vs InternalModBreaks] and Note [Breakpoint identifiers]
    1 14 
     module GHC.HsToCore.Breakpoints
    2 
    -  ( mkModBreaks
    15 
    +  ( -- * ModBreaks
    16 
    +    mkModBreaks, ModBreaks(modBreaks_locs, modBreaks_vars, modBreaks_decls)
    17 
    +
    18 
    +    -- ** Queries
    19 
    +  , getBreakLoc, getBreakVars, getBreakDecls
    20 
    +
    21 
    +    -- ** Re-exports BreakpointId
    22 
    +  , BreakpointId(..), BreakTickIndex
    3 23 
       ) where
    4 24
    5 25 
     import GHC.Prelude
    6 
    -
    7 
    -import qualified GHC.Runtime.Interpreter as GHCi
    8 
    -import GHC.Runtime.Interpreter.Types
    9 
    -import GHCi.RemoteTypes
    10 
    -import GHC.ByteCode.Types
    11 
    -import GHC.Stack.CCS
    12 
    -import GHC.Unit
    26 
    +import Data.Array
    13 27
    14 28 
     import GHC.HsToCore.Ticks (Tick (..))
    15 
    -
    16 29 
     import GHC.Data.SizedSeq
    17 
    -import GHC.Utils.Outputable as Outputable
    30 
    +import GHC.Types.SrcLoc (SrcSpan)
    31 
    +import GHC.Types.Name (OccName)
    32 
    +import GHC.Types.Tickish (BreakTickIndex, BreakpointId(..))
    33 
    +import GHC.Unit.Module (Module)
    34 
    +import GHC.Utils.Outputable
    35 
    +import GHC.Utils.Panic
    18 36
    19 
    -import Data.List (intersperse)
    20 
    -import Data.Array
    21 
    -import qualified Data.IntMap as IntMap
    22 
    -import GHC.Types.Breakpoint
    37 
    +--------------------------------------------------------------------------------
    38 
    +-- ModBreaks
    39 
    +--------------------------------------------------------------------------------
    40 
    +
    41 
    +-- | All the information about the source-relevant breakpoints for a module
    42 
    +--
    43 
    +-- This information is constructed once during desugaring (with `mkModBreaks`)
    44 
    +-- from breakpoint ticks and fixed/unchanged from there on forward. It could be
    45 
    +-- exported as an abstract datatype because it should never be updated after
    46 
    +-- construction, only queried.
    47 
    +--
    48 
    +-- The arrays can be indexed using the int in the corresponding 'BreakpointId'
    49 
    +-- (i.e. the 'BreakpointId' whose 'Module' matches the 'Module' corresponding
    50 
    +-- to these 'ModBreaks') with the accessors 'modBreaks_locs', 'modBreaks_vars',
    51 
    +-- and 'modBreaks_decls'.
    52 
    +data ModBreaks
    53 
    +   = ModBreaks
    54 
    +   { modBreaks_locs :: !(Array BreakTickIndex SrcSpan)
    55 
    +        -- ^ An array giving the source span of each breakpoint.
    56 
    +   , modBreaks_vars :: !(Array BreakTickIndex [OccName])
    57 
    +        -- ^ An array giving the names of the free variables at each breakpoint.
    58 
    +   , modBreaks_decls :: !(Array BreakTickIndex [String])
    59 
    +        -- ^ An array giving the names of the declarations enclosing each breakpoint.
    60 
    +        -- See Note [Field modBreaks_decls]
    61 
    +   , modBreaks_module :: !Module
    62 
    +        -- ^ The module to which this ModBreaks is associated.
    63 
    +        -- We cache this here for internal sanity checks (don't export it!).
    64 
    +   }
    23 65
    24 66 
     -- | Initialize memory for breakpoint data that is shared between the bytecode
    25 67 
     -- generator and the interpreter.
    ... ... @@ -28,38 +70,48 @@ import GHC.Types.Breakpoint
    28 70 
     -- generator needs to encode this information for each expression, the data is
    29 71 
     -- allocated remotely in GHCi's address space and passed to the codegen as
    30 72 
     -- foreign pointers.
    31 
    -mkModBreaks :: Interp -> Module -> SizedSeq Tick -> IO ModBreaks
    32 
    -mkModBreaks interp mod extendedMixEntries
    33 
    -  = do
    34 
    -    let count = fromIntegral $ sizeSS extendedMixEntries
    73 
    +mkModBreaks :: Module -> SizedSeq Tick -> ModBreaks
    74 
    +mkModBreaks modl extendedMixEntries
    75 
    +  = let count = fromIntegral $ sizeSS extendedMixEntries
    35 76 
             entries = ssElts extendedMixEntries
    36 
    -
    37 
    -    breakArray <- GHCi.newBreakArray interp count
    38 
    -    ccs <- mkCCSArray interp mod count entries
    39 
    -    let
    40 
    -           locsTicks  = listArray (0,count-1) [ tick_loc  t | t <- entries ]
    41 
    -           varsTicks  = listArray (0,count-1) [ tick_ids  t | t <- entries ]
    42 
    -           declsTicks = listArray (0,count-1) [ tick_path t | t <- entries ]
    43 
    -    return $ ModBreaks
    44 
    -      { modBreaks_flags  = breakArray
    45 
    -      , modBreaks_locs   = locsTicks
    77 
    +        locsTicks  = listArray (0,count-1) [ tick_loc  t | t <- entries ]
    78 
    +        varsTicks  = listArray (0,count-1) [ tick_ids  t | t <- entries ]
    79 
    +        declsTicks = listArray (0,count-1) [ tick_path t | t <- entries ]
    80 
    +     in ModBreaks
    81 
    +      { modBreaks_locs   = locsTicks
    46 82 
           , modBreaks_vars   = varsTicks
    47 83 
           , modBreaks_decls  = declsTicks
    48 
    -      , modBreaks_ccs    = ccs
    49 
    -      , modBreaks_breakInfo = IntMap.empty
    50 
    -      , modBreaks_module = mod
    84 
    +      , modBreaks_module = modl
    51 85 
           }
    52 86
    53 
    -mkCCSArray
    54 
    -  :: Interp -> Module -> Int -> [Tick]
    55 
    -  -> IO (Array BreakTickIndex (RemotePtr GHC.Stack.CCS.CostCentre))
    56 
    -mkCCSArray interp modul count entries
    57 
    -  | GHCi.interpreterProfiled interp = do
    58 
    -      let module_str = moduleNameString (moduleName modul)
    59 
    -      costcentres <- GHCi.mkCostCentres interp module_str (map mk_one entries)
    60 
    -      return (listArray (0,count-1) costcentres)
    61 
    -  | otherwise = return (listArray (0,-1) [])
    62 
    - where
    63 
    -    mk_one t = (name, src)
    64 
    -      where name = concat $ intersperse "." $ tick_path t
    65 
    -            src = renderWithContext defaultSDocContext $ ppr $ tick_loc t
    87 
    +-- | Get the source span for this breakpoint
    88 
    +getBreakLoc  :: BreakpointId -> ModBreaks -> SrcSpan
    89 
    +getBreakLoc (BreakpointId bid_mod ix) mbs =
    90 
    +  assert_modules_match bid_mod (modBreaks_module mbs) $ modBreaks_locs mbs ! ix
    91 
    +
    92 
    +-- | Get the vars for this breakpoint
    93 
    +getBreakVars  :: BreakpointId -> ModBreaks -> [OccName]
    94 
    +getBreakVars (BreakpointId bid_mod ix) mbs =
    95 
    +  assert_modules_match bid_mod (modBreaks_module mbs) $ modBreaks_vars mbs ! ix
    96 
    +
    97 
    +-- | Get the decls for this breakpoint
    98 
    +getBreakDecls :: BreakpointId -> ModBreaks -> [String]
    99 
    +getBreakDecls (BreakpointId bid_mod ix) mbs =
    100 
    +  assert_modules_match bid_mod (modBreaks_module mbs) $ modBreaks_decls mbs ! ix
    101 
    +
    102 
    +-- | Assert that the module in the 'BreakpointId' and in 'ModBreaks' match.
    103 
    +assert_modules_match :: Module -> Module -> a -> a
    104 
    +assert_modules_match bid_mod mbs_mod =
    105 
    +  assertPpr (bid_mod == mbs_mod)
    106 
    +    (text "Tried to query the ModBreaks of module" <+> ppr mbs_mod
    107 
    +        <+> text "with a BreakpointId for module" <+> ppr bid_mod)
    108 
    +
    109 
    +{-
    110 
    +Note [Field modBreaks_decls]
    111 
    +~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    112 
    +A value of eg ["foo", "bar", "baz"] in a `modBreaks_decls` field means:
    113 
    +The breakpoint is in the function called "baz" that is declared in a `let`
    114 
    +or `where` clause of a declaration called "bar", which itself is declared
    115 
    +in a `let` or `where` clause of the top-level function called "foo".
    116 
    +-}
    117 
    +

  • compiler/GHC/HsToCore/Ticks.hs
    ... ... @@ -55,7 +55,6 @@ import Data.Bifunctor (second)
    55 55 
     import Data.List.NonEmpty (NonEmpty (..))
    56 56 
     import Data.Set (Set)
    57 57 
     import qualified Data.Set as Set
    58 
    -import GHC.Types.Breakpoint (BreakpointId(..))
    59 58
    60 59 
     {-
    61 60 
     ************************************************************************

  • compiler/GHC/Iface/Syntax.hs
    ... ... @@ -56,7 +56,6 @@ import GHC.Data.BooleanFormula (pprBooleanFormula, isTrue)
    56 56
    57 57 
     import GHC.Builtin.Names ( unrestrictedFunTyConKey, liftedTypeKindTyConKey,
    58 58 
                                constraintKindTyConKey )
    59 
    -import GHC.Types.Breakpoint
    60 59 
     import GHC.Types.Unique ( hasKey )
    61 60 
     import GHC.Iface.Type
    62 61 
     import GHC.Iface.Recomp.Binary
    ... ... @@ -75,6 +74,7 @@ import GHC.Types.Avail
    75 74 
     import GHC.Types.ForeignCall
    76 75 
     import GHC.Types.Annotations( AnnPayload, AnnTarget )
    77 76 
     import GHC.Types.Basic
    77 
    +import GHC.Types.Tickish
    78 78 
     import GHC.Unit.Module
    79 79 
     import GHC.Unit.Module.Warnings
    80 80 
     import GHC.Types.SrcLoc

  • compiler/GHC/Runtime/Debugger/Breakpoints.hs
    ... ... @@ -22,7 +22,6 @@ import GHC.Driver.Monad
    22 22 
     import GHC.Driver.Session.Inspect
    23 23 
     import GHC.Runtime.Eval
    24 24 
     import GHC.Runtime.Eval.Utils
    25 
    -import GHC.Types.Breakpoint
    26 25 
     import GHC.Types.Name
    27 26 
     import GHC.Types.SrcLoc
    28 27 
     import GHC.Unit.Module

  • compiler/GHC/Runtime/Eval.hs
    ... ... @@ -705,6 +705,7 @@ pushResume hsc_env resume = hsc_env { hsc_IC = ictxt1 }
    705 705 
       {-
    706 706 
       Note [Syncing breakpoint info]
    707 707 
       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    708 
    +  ROMES:TODO: Update
    708 709 
       To display the values of the free variables for a single breakpoint, the
    709 710 
       function `GHC.Runtime.Eval.bindLocalsAtBreakpoint` pulls
    710 711 
       out the information from the fields `modBreaks_breakInfo` and

  • compiler/GHC/Runtime/Eval/Types.hs
    ... ... @@ -17,17 +17,18 @@ import GHC.Prelude
    17 17
    18 18 
     import GHCi.RemoteTypes
    19 19 
     import GHCi.Message (EvalExpr, ResumeContext)
    20 
    +import GHC.ByteCode.Types (InternalBreakpointId(..))
    20 21 
     import GHC.Driver.Config (EvalStep(..))
    21 22 
     import GHC.Types.Id
    22 23 
     import GHC.Types.Name
    23 24 
     import GHC.Types.TyThing
    24 
    -import GHC.Types.Breakpoint
    25 25 
     import GHC.Types.Name.Reader
    26 26 
     import GHC.Types.SrcLoc
    27 27 
     import GHC.Utils.Exception
    28 28
    29 29 
     import Data.Word
    30 30 
     import GHC.Stack.CCS
    31 
    +import GHC.Types.Tickish (BreakpointId)
    31 32
    32 33 
     data ExecOptions
    33 34 
      = ExecOptions

  • compiler/GHC/Runtime/Interpreter.hs
    ... ... @@ -28,11 +28,10 @@ module GHC.Runtime.Interpreter
    28 28 
       , whereFrom
    29 29 
       , getModBreaks
    30 30 
       , readModBreaks
    31 
    +  , readModBreaksMaybe
    31 32 
       , seqHValue
    32 33 
       , evalBreakpointToId
    33 34 
       , internalBreakIdToBreakId
    34 
    -  , interpreterDynamic
    35 
    -  , interpreterProfiled
    36 35
    37 36 
       -- * The object-code linker
    38 37 
       , initObjLinker
    ... ... @@ -77,9 +76,10 @@ import GHCi.Message
    77 76 
     import GHCi.RemoteTypes
    78 77 
     import GHCi.ResolvedBCO
    79 78 
     import GHCi.BreakArray (BreakArray)
    80 
    -import GHC.Types.Breakpoint
    81 
    -import GHC.ByteCode.Types
    79 
    +import GHC.HsToCore.Breakpoints
    80 
    +import GHC.ByteCode.Breakpoints
    82 81
    82 
    +import GHC.ByteCode.Types
    83 83 
     import GHC.Linker.Types
    84 84
    85 85 
     import GHC.Data.Maybe
    ... ... @@ -123,7 +123,6 @@ import qualified GHC.Unit.Home.Graph as HUG
    123 123
    124 124 
     -- Standard libraries
    125 125 
     import GHC.Exts
    126 
    -import qualified Data.IntMap as IntMap
    127 126
    128 127 
     {- Note [Remote GHCi]
    129 128 
        ~~~~~~~~~~~~~~~~~~
    ... ... @@ -434,9 +433,8 @@ evalBreakpointToId eval_break =
    434 433 
     -- See also Note [Breakpoint identifiers]
    435 434 
     internalBreakIdToBreakId :: HomeUnitGraph -> InternalBreakpointId -> IO BreakpointId
    436 435 
     internalBreakIdToBreakId hug ibi = do
    437 
    -  ModBreaks{modBreaks_breakInfo} <- readModBreaks hug (ibi_info_mod ibi)
    438 
    -  let CgBreakInfo{cgb_tick_id} = expectJust $
    439 
    -        IntMap.lookup (ibi_info_index ibi) modBreaks_breakInfo
    436 
    +  (imbs, _) <- readModBreaks hug (ibi_info_mod ibi)
    437 
    +  let CgBreakInfo{cgb_tick_id} = getInternalBreak ibi imbs
    440 438 
       return cgb_tick_id
    441 439
    442 440 
     -- | Process the result of a Seq or ResumeSeq message.             #2950
    ... ... @@ -467,7 +465,7 @@ handleSeqHValueStatus interp unit_env eval_status =
    467 465 
                 -- Nothing case - should not occur! We should have the appropriate
    468 466 
                 -- breakpoint information
    469 467 
                 Nothing -> nothing_case
    470 
    -            Just modbreaks -> put $ brackets . ppr $ (modBreaks_locs modbreaks) ! bi_tick_index bi
    468 
    +            Just (_, modbreaks) -> put $ brackets . ppr $ (modBreaks_locs modbreaks) ! bi_tick_index bi
    471 469
    472 470 
           -- resume the seq (:force) processing in the iserv process
    473 471 
           withForeignRef resume_ctxt_fhv $ \hval -> do
    ... ... @@ -747,10 +745,13 @@ wormholeRef interp _r = case interpInstance interp of
    747 745 
       ExternalInterp {}
    748 746 
         -> throwIO (InstallationError "this operation requires -fno-external-interpreter")
    749 747
    750 
    --- -----------------------------------------------------------------------------
    751 
    --- Misc utils
    748 
    +--------------------------------------------------------------------------------
    749 
    +-- * Finding breakpoint information
    750 
    +--------------------------------------------------------------------------------
    752 751
    753 
    -getModBreaks :: HomeModInfo -> Maybe ModBreaks
    752 
    +-- | Get the breakpoint information from the ByteCode object associated to this
    753 
    +-- 'HomeModInfo'.
    754 
    +getModBreaks :: HomeModInfo -> Maybe (InternalModBreaks, ModBreaks)
    754 755 
     getModBreaks hmi
    755 756 
       | Just linkable <- homeModInfoByteCode hmi,
    756 757 
         -- The linkable may have 'DotO's as well; only consider BCOs. See #20570.
    ... ... @@ -759,33 +760,18 @@ getModBreaks hmi
    759 760 
       | otherwise
    760 761 
       = Nothing -- probably object code
    761 762
    762 
    --- | Read the 'ModBreaks' of the given home 'Module' from the 'HomeUnitGraph'.
    763 
    -readModBreaks :: HomeUnitGraph -> Module -> IO ModBreaks
    764 
    -readModBreaks hug mod =
    765 
    -  expectJust . getModBreaks . expectJust <$> HUG.lookupHugByModule mod hug
    763 
    +-- | Read the 'InternalModBreaks' and 'ModBreaks' of the given home 'Module'
    764 
    +-- from the 'HomeUnitGraph'.
    765 
    +readModBreaks :: HomeUnitGraph -> Module -> IO (InternalModBreaks, ModBreaks)
    766 
    +readModBreaks hug mod = expectJust <$> readModBreaksMaybe hug mod
    767 
    +
    768 
    +readModBreaksMaybe :: HomeUnitGraph -> Module -> IO (Maybe (InternalModBreaks, ModBreaks))
    769 
    +readModBreaksMaybe hug mod = getModBreaks . expectJust <$> HUG.lookupHugByModule mod hug
    770 
    +
    771 
    +-- -----------------------------------------------------------------------------
    772 
    +-- Misc utils
    766 773
    767 774 
     fromEvalResult :: EvalResult a -> IO a
    768 775 
     fromEvalResult (EvalException e) = throwIO (fromSerializableException e)
    769 776 
     fromEvalResult (EvalSuccess a) = return a
    770 777
    771 
    --- | Interpreter uses Profiling way
    772 
    -interpreterProfiled :: Interp -> Bool
    773 
    -interpreterProfiled interp = case interpInstance interp of
    774 
    -#if defined(HAVE_INTERNAL_INTERPRETER)
    775 
    -  InternalInterp     -> hostIsProfiled
    776 
    -#endif
    777 
    -  ExternalInterp ext -> case ext of
    778 
    -    ExtIServ i -> iservConfProfiled (interpConfig i)
    779 
    -    ExtJS {}   -> False -- we don't support profiling yet in the JS backend
    780 
    -    ExtWasm i -> wasmInterpProfiled $ interpConfig i
    781 
    -
    782 
    --- | Interpreter uses Dynamic way
    783 
    -interpreterDynamic :: Interp -> Bool
    784 
    -interpreterDynamic interp = case interpInstance interp of
    785 
    -#if defined(HAVE_INTERNAL_INTERPRETER)
    786 
    -  InternalInterp     -> hostIsDynamic
    787 
    -#endif
    788 
    -  ExternalInterp ext -> case ext of
    789 
    -    ExtIServ i -> iservConfDynamic (interpConfig i)
    790 
    -    ExtJS {}   -> False -- dynamic doesn't make sense for JS
    791 
    -    ExtWasm {} -> True  -- wasm dyld can only load dynamic code

  • compiler/GHC/Runtime/Interpreter/Types.hs
    ... ... @@ -24,7 +24,8 @@ module GHC.Runtime.Interpreter.Types
    24 24 
        , interpSymbolSuffix
    25 25 
        , eliminateInterpSymbol
    26 26 
        , interpretedInterpSymbol
    27 
    -
    27 
    +   , interpreterProfiled
    28 
    +   , interpreterDynamic
    28 29
    29 30 
        -- * IServ
    30 31 
        , IServ
    ... ... @@ -136,6 +137,28 @@ data ExtInterpInstance c = ExtInterpInstance
    136 137 
           -- ^ Instance specific extra fields
    137 138 
       }
    138 139
    140 
    +-- | Interpreter uses Profiling way
    141 
    +interpreterProfiled :: Interp -> Bool
    142 
    +interpreterProfiled interp = case interpInstance interp of
    143 
    +#if defined(HAVE_INTERNAL_INTERPRETER)
    144 
    +  InternalInterp     -> hostIsProfiled
    145 
    +#endif
    146 
    +  ExternalInterp ext -> case ext of
    147 
    +    ExtIServ i -> iservConfProfiled (interpConfig i)
    148 
    +    ExtJS {}   -> False -- we don't support profiling yet in the JS backend
    149 
    +    ExtWasm i -> wasmInterpProfiled $ interpConfig i
    150 
    +
    151 
    +-- | Interpreter uses Dynamic way
    152 
    +interpreterDynamic :: Interp -> Bool
    153 
    +interpreterDynamic interp = case interpInstance interp of
    154 
    +#if defined(HAVE_INTERNAL_INTERPRETER)
    155 
    +  InternalInterp     -> hostIsDynamic
    156 
    +#endif
    157 
    +  ExternalInterp ext -> case ext of
    158 
    +    ExtIServ i -> iservConfDynamic (interpConfig i)
    159 
    +    ExtJS {}   -> False -- dynamic doesn't make sense for JS
    160 
    +    ExtWasm {} -> True  -- wasm dyld can only load dynamic code
    161 
    +
    139 162 
     ------------------------
    140 163 
     -- JS Stuff
    141 164 
     ------------------------

  • compiler/GHC/StgToByteCode.hs
    ... ... @@ -4,13 +4,14 @@
    4 4 
     {-# LANGUAGE LambdaCase                 #-}
    5 5 
     {-# LANGUAGE RecordWildCards            #-}
    6 6 
     {-# LANGUAGE FlexibleContexts           #-}
    7 
    +{-# LANGUAGE DerivingVia #-}
    7 8
    8 9 
     --
    9 10 
     --  (c) The University of Glasgow 2002-2006
    10 11 
     --
    11 12
    12 13 
     -- | GHC.StgToByteCode: Generate bytecode from STG
    13 
    -module GHC.StgToByteCode ( UnlinkedBCO, byteCodeGen) where
    14 
    +module GHC.StgToByteCode ( UnlinkedBCO, byteCodeGen ) where
    14 15
    15 16 
     import GHC.Prelude
    16 17
    ... ... @@ -70,7 +71,8 @@ import GHC.Data.OrdList
    70 71 
     import GHC.Data.Maybe
    71 72 
     import GHC.Types.Tickish
    72 73 
     import GHC.Types.SptEntry
    73 
    -import GHC.Types.Breakpoint
    74 
    +import GHC.HsToCore.Breakpoints
    75 
    +import GHC.ByteCode.Breakpoints
    74 76
    75 77 
     import Data.List ( genericReplicate, intersperse
    76 78 
                      , partition, scanl', sortBy, zip4, zip6 )
    ... ... @@ -98,6 +100,10 @@ import GHC.Stg.Syntax
    98 100 
     import qualified Data.IntSet as IntSet
    99 101 
     import GHC.CoreToIface
    100 102
    103 
    +import Control.Monad.IO.Class
    104 
    +import Control.Monad.Trans.Reader (ReaderT)
    105 
    +import Control.Monad.Trans.State  (StateT)
    106 
    +
    101 107 
     -- -----------------------------------------------------------------------------
    102 108 
     -- Generating byte code for a complete module
    103 109
    ... ... @@ -131,9 +137,15 @@ byteCodeGen hsc_env this_mod binds tycs mb_modBreaks spt_entries
    131 137 
                "Proto-BCOs" FormatByteCode
    132 138 
                (vcat (intersperse (char ' ') (map ppr $ elemsFlatBag proto_bcos)))
    133 139
    134 
    -        let mod_breaks = case modBreaks of
    135 
    -             Nothing -> Nothing
    136 
    -             Just mb -> Just mb{ modBreaks_breakInfo = breakInfo }
    140 
    +        let all_mod_breaks = case mb_modBreaks of
    141 
    +             Just modBreaks -> Just (modBreaks, internalBreaks)
    142 
    +             Nothing        -> Nothing
    143 
    +             -- no modBreaks, thus drop all
    144 
    +             -- internalBreaks? Will we ever want to have internal breakpoints in
    145 
    +             -- a module for which we're not doing breakpoints at all? probably
    146 
    +             -- not?
    147 
    +             -- TODO: Consider always returning InternalBreaks;
    148 
    +             -- TODO: Consider making ModBreaks a SUM that can be empty instead of using Maybe.
    137 149 
             cbc <- assembleBCOs profile proto_bcos tycs strings mod_breaks spt_entries
    138 150
    139 151 
             -- Squash space leaks in the CompiledByteCode.  This is really
    ... ... @@ -314,7 +326,7 @@ schemeTopBind (id, rhs)
    314 326 
             -- because mkConAppCode treats nullary constructor applications
    315 327 
             -- by just re-using the single top-level definition.  So
    316 328 
             -- for the worker itself, we must allocate it directly.
    317 
    -    -- ioToBc (putStrLn $ "top level BCO")
    329 
    +    -- liftIO (putStrLn $ "top level BCO")
    318 330 
         pure (mkProtoBCO platform add_bco_name
    319 331 
                            (getName id) (toOL [PACK data_con 0, RETURN P])
    320 332 
                            (Right rhs) 0 0 [{-no bitmap-}] False{-not alts-})
    ... ... @@ -395,32 +407,27 @@ schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_id fvs) rhs) = do
    395 407 
       code <- schemeE d 0 p rhs
    396 408 
       hsc_env <- getHscEnv
    397 409 
       current_mod <- getCurrentModule
    398 
    -  mb_current_mod_breaks <- getCurrentModBreaks
    399 
    -  case mb_current_mod_breaks of
    400 
    -    -- if we're not generating ModBreaks for this module for some reason, we
    401 
    -    -- can't store breakpoint occurrence information.
    410 
    +  liftIO (readModBreaksMaybe (hsc_HUG hsc_env) current_mod) >>= \case
    402 411 
         Nothing -> pure code
    403 
    -    Just current_mod_breaks -> break_info hsc_env (bi_tick_mod tick_id) current_mod mb_current_mod_breaks >>= \case
    404 
    -      Nothing -> pure code
    405 
    -      Just ModBreaks {modBreaks_flags = breaks, modBreaks_module = _tick_mod, modBreaks_ccs = cc_arr} -> do
    406 
    -        platform <- profilePlatform <$> getProfile
    407 
    -        let idOffSets = getVarOffSets platform d p fvs
    408 
    -            ty_vars   = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
    409 
    -            toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
    410 
    -            toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
    411 
    -            breakInfo  = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty tick_id
    412 
    +    Just ModBreaks {modBreaks_flags = breaks, modBreaks_ccs = cc_arr} -> do
    413 
    +      platform <- profilePlatform <$> getProfile
    414 
    +      let idOffSets = getVarOffSets platform d p fvs
    415 
    +          ty_vars   = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
    416 
    +          toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
    417 
    +          toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
    418 
    +          breakInfo  = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty tick_id
    412 419
    413 
    -        let info_mod = modBreaks_module current_mod_breaks
    414 
    -        infox <- newBreakInfo breakInfo
    420 
    +      let info_mod = current_mod
    421 
    +      infox <- newBreakInfo breakInfo
    415 422
    416 
    -        let cc | Just interp <- hsc_interp hsc_env
    417 
    -              , interpreterProfiled interp
    418 
    -              = cc_arr ! bi_tick_index tick_id
    419 
    -              | otherwise = toRemotePtr nullPtr
    423 
    +      let cc | Just interp <- hsc_interp hsc_env
    424 
    +             , interpreterProfiled interp
    425 
    +             = cc_arr ! bi_tick_index tick_id
    426 
    +             | otherwise = toRemotePtr nullPtr
    420 427
    421 
    -            breakInstr = BRK_FUN breaks (InternalBreakpointId info_mod infox) cc
    428 
    +          breakInstr = BRK_FUN breaks (InternalBreakpointId info_mod infox) cc
    422 429
    423 
    -        return $ breakInstr `consOL` code
    430 
    +      return $ breakInstr `consOL` code
    424 431 
     schemeER_wrk d p rhs = schemeE d 0 p rhs
    425 432
    426 433 
     -- | Determine the GHCi-allocated 'BreakArray' and module pointer for the module
    ... ... @@ -452,7 +459,7 @@ break_info hsc_env mod current_mod current_mod_breaks
    452 459 
       | mod == current_mod
    453 460 
       = pure current_mod_breaks
    454 461 
       | otherwise
    455 
    -  = ioToBc (HUG.lookupHugByModule mod (hsc_HUG hsc_env)) >>= \case
    462 
    +  = liftIO (HUG.lookupHugByModule mod (hsc_HUG hsc_env)) >>= \case
    456 463 
           Just hp -> pure $ getModBreaks hp
    457 464 
           Nothing -> pure Nothing
    458 465
    ... ... @@ -2630,57 +2637,33 @@ typeArgReps platform = map (toArgRep platform) . typePrimRep
    2630 2637 
     -- -----------------------------------------------------------------------------
    2631 2638 
     -- The bytecode generator's monad
    2632 2639
    2640 
    +-- | Read only environment for generating ByteCode
    2641 
    +data BcM_Env
    2642 
    +   = BcM_Env
    2643 
    +        { bcm_hsc_env    :: HscEnv
    2644 
    +        , bcm_module     :: Module -- current module (for breakpoints)
    2645 
    +        , bcm_mod_breaks :: Maybe ModBreaks -- this module's ModBreaks
    2646 
    +        }
    2647 
    +
    2633 2648 
     data BcM_State
    2634 2649 
        = BcM_State
    2635 
    -        { bcm_hsc_env :: HscEnv
    2636 
    -        , thisModule  :: Module          -- current module (for breakpoints)
    2637 
    -        , nextlabel   :: Word32          -- for generating local labels
    2638 
    -        , modBreaks   :: Maybe ModBreaks -- info about breakpoints
    2639 
    -
    2640 
    -        , breakInfo   :: IntMap CgBreakInfo -- ^ Info at breakpoint occurrence.
    2641 
    -                                            -- Indexed with breakpoint *info* index.
    2642 
    -                                            -- See Note [Breakpoint identifiers]
    2643 
    -                                            -- in GHC.Types.Breakpoint
    2644 
    -        , breakInfoIdx :: !Int              -- ^ Next index for breakInfo array
    2650 
    +        { nextlabel      :: !Word32 -- ^ For generating local labels
    2651 
    +        , breakInfoIdx   :: !Int    -- ^ Next index for breakInfo array
    2652 
    +        , internalBreaks :: InternalModBreaks
    2653 
    +          -- ^ Info at breakpoints occurrences. Indexed with
    2654 
    +          -- 'InternalBreakpointId'. See Note [Breakpoint identifiers] in
    2655 
    +          -- GHC.ByteCode.Breakpoints.
    2645 2656 
             }
    2646 2657
    2647 
    -newtype BcM r = BcM (BcM_State -> IO (BcM_State, r)) deriving (Functor)
    2648 
    -
    2649 
    -ioToBc :: IO a -> BcM a
    2650 
    -ioToBc io = BcM $ \st -> do
    2651 
    -  x <- io
    2652 
    -  return (st, x)
    2658 
    +newtype BcM r = BcM (BcM_Env -> BcM_State -> IO (BcM_State, r))
    2659 
    +  deriving (Functor, Applicative, Monad, MonadIO)
    2660 
    +    via (ReaderT BcM_Env (StateT BcM_State IO))
    2653 2661
    2654 2662 
     runBc :: HscEnv -> Module -> Maybe ModBreaks
    2655 2663 
           -> BcM r
    2656 2664 
           -> IO (BcM_State, r)
    2657 2665 
     runBc hsc_env this_mod modBreaks (BcM m)
    2658 
    -   = m (BcM_State hsc_env this_mod 0 modBreaks IntMap.empty 0)
    2659 
    -
    2660 
    -thenBc :: BcM a -> (a -> BcM b) -> BcM b
    2661 
    -thenBc (BcM expr) cont = BcM $ \st0 -> do
    2662 
    -  (st1, q) <- expr st0
    2663 
    -  let BcM k = cont q
    2664 
    -  (st2, r) <- k st1
    2665 
    -  return (st2, r)
    2666 
    -
    2667 
    -thenBc_ :: BcM a -> BcM b -> BcM b
    2668 
    -thenBc_ (BcM expr) (BcM cont) = BcM $ \st0 -> do
    2669 
    -  (st1, _) <- expr st0
    2670 
    -  (st2, r) <- cont st1
    2671 
    -  return (st2, r)
    2672 
    -
    2673 
    -returnBc :: a -> BcM a
    2674 
    -returnBc result = BcM $ \st -> (return (st, result))
    2675 
    -
    2676 
    -instance Applicative BcM where
    2677 
    -    pure = returnBc
    2678 
    -    (<*>) = ap
    2679 
    -    (*>) = thenBc_
    2680 
    -
    2681 
    -instance Monad BcM where
    2682 
    -  (>>=) = thenBc
    2683 
    -  (>>)  = (*>)
    2666 
    +   = m (BcM_Env hsc_env this_mod modBreaks) (BcM_State 0 0 (mkInternalModBreaks this_mod mempty))
    2684 2667
    2685 2668 
     instance HasDynFlags BcM where
    2686 2669 
         getDynFlags = BcM $ \st -> return (st, hsc_dflags (bcm_hsc_env st))
    ... ... @@ -2710,20 +2693,18 @@ getLabelsBc n
    2710 2693 
       = BcM $ \st -> let ctr = nextlabel st
    2711 2694 
                      in return (st{nextlabel = ctr+n}, coerce [ctr .. ctr+n-1])
    2712 2695
    2713 
    -newBreakInfo :: CgBreakInfo -> BcM Int
    2714 
    -newBreakInfo info = BcM $ \st ->
    2696 
    +newBreakInfo :: CgBreakInfo -> BcM InternalBreakpointId
    2697 
    +newBreakInfo info = BcM $ \env st ->
    2715 2698 
       let ix = breakInfoIdx st
    2699 
    +      ibi = InternalBreakpointId (bcm_module env) ix
    2716 2700 
           st' = st
    2717 
    -              { breakInfo = IntMap.insert ix info (breakInfo st)
    2718 
    -              , breakInfoIdx = ix + 1
    2719 
    -              }
    2720 
    -  in return (st', ix)
    2701 
    +        { internalBreaks = addInternalBreak ibi info (internalBreaks st)
    2702 
    +        , breakInfoIdx = ix + 1
    2703 
    +        }
    2704 
    +  in return (st', ibi)
    2721 2705
    2722 2706 
     getCurrentModule :: BcM Module
    2723 2707 
     getCurrentModule = BcM $ \st -> return (st, thisModule st)
    2724 2708
    2725 
    -getCurrentModBreaks :: BcM (Maybe ModBreaks)
    2726 
    -getCurrentModBreaks = BcM $ \st -> return (st, modBreaks st)
    2727 
    -
    2728 2709 
     tickFS :: FastString
    2729 2710 
     tickFS = fsLit "ticked"

  • compiler/GHC/Types/Breakpoint.hs deleted
    1 
    -{-# LANGUAGE RecordWildCards #-}
    2 
    -
    3 
    --- | Breakpoint related types
    4 
    -module GHC.Types.Breakpoint
    5 
    -  ( BreakpointId (..)
    6 
    -  , InternalBreakpointId (..)
    7 
    -  , BreakTickIndex, BreakInfoIndex
    8 
    -  )
    9 
    -where
    10 
    -
    11 
    -import Control.DeepSeq
    12 
    -import GHC.Prelude
    13 
    -import GHC.Unit.Module
    14 
    -import GHC.Utils.Outputable
    15 
    -import Data.Data (Data)
    16 
    -
    17 
    --- | Breakpoint tick index
    18 
    -type BreakTickIndex = Int
    19 
    -
    20 
    --- | Internal breakpoint info index
    21 
    -type BreakInfoIndex = Int
    22 
    -
    23 
    --- | Breakpoint identifier.
    24 
    ---
    25 
    --- See Note [Breakpoint identifiers]
    26 
    -data BreakpointId = BreakpointId
    27 
    -  { bi_tick_mod   :: !Module         -- ^ Breakpoint tick module
    28 
    -  , bi_tick_index :: !BreakTickIndex -- ^ Breakpoint tick index
    29 
    -  }
    30 
    -  deriving (Eq, Ord, Data)
    31 
    -
    32 
    --- | Internal breakpoint identifier
    33 
    ---
    34 
    --- See Note [Breakpoint identifiers]
    35 
    -data InternalBreakpointId = InternalBreakpointId
    36 
    -  { ibi_info_mod   :: !Module         -- ^ Breakpoint tick module
    37 
    -  , ibi_info_index :: !BreakInfoIndex -- ^ Breakpoint tick index
    38 
    -  }
    39 
    -  deriving (Eq, Ord)
    40 
    -
    41 
    --- Note [Breakpoint identifiers]
    42 
    --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    43 
    --- ROMES:TODO: UPDATE NOTE
    44 
    --- Before optimization a breakpoint is identified uniquely with a tick module
    45 
    --- and a tick index. See BreakpointId. A tick module contains an array, indexed
    46 
    --- with the tick indexes, which indicates breakpoint status.
    47 
    ---
    48 
    --- When we generate ByteCode, we collect information for every breakpoint at
    49 
    --- their *occurrence sites* (see CgBreakInfo in GHC.ByteCode.Types) and these info
    50 
    --- are stored in the ModIface of the occurrence module. Because of inlining, we
    51 
    --- can't reuse the tick index to uniquely identify an occurrence; because of
    52 
    --- cross-module inlining, we can't assume that the occurrence module is the same
    53 
    --- as the tick module (#24712).
    54 
    ---
    55 
    --- So every breakpoint occurrence gets assigned a module-unique *info index* and
    56 
    --- we store it alongside the occurrence module (*info module*) in the
    57 
    --- InternalBreakpointId datatype.
    58 
    -
    59 
    ---------------------------------------------------------------------------------
    60 
    --- Instances
    61 
    ---------------------------------------------------------------------------------
    62 
    -
    63 
    -instance Outputable BreakpointId where
    64 
    -  ppr BreakpointId{..} =
    65 
    -    text "BreakpointId" <+> ppr bi_tick_mod <+> ppr bi_tick_index
    66 
    -
    67 
    -instance Outputable InternalBreakpointId where
    68 
    -  ppr InternalBreakpointId{..} =
    69 
    -    text "InternalBreakpointId" <+> ppr ibi_info_mod <+> ppr ibi_info_index
    70 
    -
    71 
    -instance NFData BreakpointId where
    72 
    -  rnf BreakpointId{..} =
    73 
    -    rnf bi_tick_mod `seq` rnf bi_tick_index
    74 
    -
    75 
    -instance NFData InternalBreakpointId where
    76 
    -  rnf InternalBreakpointId{..} =
    77 
    -    rnf ibi_info_mod `seq` rnf ibi_info_index

  • compiler/GHC/Types/Tickish.hs
    ... ... @@ -21,11 +21,15 @@ module GHC.Types.Tickish (
    21 21 
       isProfTick,
    22 22 
       TickishPlacement(..),
    23 23 
       tickishPlace,
    24 
    -  tickishContains
    24 
    +  tickishContains,
    25 
    +
    26 
    +  -- * Breakpoint tick identifiers
    27 
    +  BreakpointId(..), BreakTickIndex
    25 28 
     ) where
    26 29
    27 30 
     import GHC.Prelude
    28 31 
     import GHC.Data.FastString
    32 
    +import Control.DeepSeq
    29 33
    30 34 
     import GHC.Core.Type
    31 35
    ... ... @@ -40,8 +44,7 @@ import GHC.Utils.Panic
    40 44 
     import Language.Haskell.Syntax.Extension ( NoExtField )
    41 45
    42 46 
     import Data.Data
    43 
    -import GHC.Utils.Outputable (Outputable (ppr), text)
    44 
    -import GHC.Types.Breakpoint
    47 
    +import GHC.Utils.Outputable (Outputable (ppr), text, (<+>))
    45 48
    46 49 
     {- *********************************************************************
    47 50 
     *                                                                      *
    ... ... @@ -171,6 +174,33 @@ deriving instance Eq (GenTickish 'TickishPassCmm)
    171 174 
     deriving instance Ord (GenTickish 'TickishPassCmm)
    172 175 
     deriving instance Data (GenTickish 'TickishPassCmm)
    173 176
    177 
    +--------------------------------------------------------------------------------
    178 
    +-- Tick breakpoint index
    179 
    +--------------------------------------------------------------------------------
    180 
    +
    181 
    +-- | Breakpoint tick index
    182 
    +type BreakTickIndex = Int
    183 
    +
    184 
    +-- | Breakpoint identifier.
    185 
    +--
    186 
    +-- Indexes into the structures in the @'ModBreaks'@ created during desugaring
    187 
    +-- (after inserting the breakpoint ticks in the expressions).
    188 
    +-- See Note [Breakpoint identifiers]
    189 
    +data BreakpointId = BreakpointId
    190 
    +  { bi_tick_mod   :: !Module         -- ^ Breakpoint tick module
    191 
    +  , bi_tick_index :: !BreakTickIndex -- ^ Breakpoint tick index
    192 
    +  }
    193 
    +  deriving (Eq, Ord, Data)
    194 
    +
    195 
    +instance Outputable BreakpointId where
    196 
    +  ppr BreakpointId{bi_tick_mod, bi_tick_index} =
    197 
    +    text "BreakpointId" <+> ppr bi_tick_mod <+> ppr bi_tick_index
    198 
    +
    199 
    +instance NFData BreakpointId where
    200 
    +  rnf BreakpointId{bi_tick_mod, bi_tick_index} =
    201 
    +    rnf bi_tick_mod `seq` rnf bi_tick_index
    202 
    +
    203 
    +--------------------------------------------------------------------------------
    174 204
    175 205 
     -- | A "counting tick" (where tickishCounts is True) is one that
    176 206 
     -- counts evaluations in some way.  We cannot discard a counting tick,

  • compiler/GHC/Unit/External.hs
    ... ... @@ -24,7 +24,7 @@ import GHC.Unit.Module.ModIface
    24 24 
     import GHC.Core.FamInstEnv
    25 25 
     import GHC.Core.InstEnv ( InstEnv, emptyInstEnv )
    26 26 
     import GHC.Core.Opt.ConstantFold
    27 
    -import GHC.Core.Rules ( RuleBase, mkRuleBase)
    27 
    +import GHC.Core.Rules ( RuleBase, mkRuleBase )
    28 28
    29 29 
     import GHC.Types.Annotations ( AnnEnv, emptyAnnEnv )
    30 30 
     import GHC.Types.CompleteMatch

  • compiler/GHC/Unit/Module/ModGuts.hs
    ... ... @@ -7,7 +7,7 @@ where
    7 7
    8 8 
     import GHC.Prelude
    9 9
    10 
    -import GHC.ByteCode.Types
    10 
    +import GHC.HsToCore.Breakpoints
    11 11 
     import GHC.ForeignSrcLang
    12 12
    13 13 
     import GHC.Hs

  • compiler/ghc.cabal.in
    ... ... @@ -223,6 +223,7 @@ Library
    223 223 
             GHC.Builtin.Uniques
    224 224 
             GHC.Builtin.Utils
    225 225 
             GHC.ByteCode.Asm
    226 
    +        GHC.ByteCode.Breakpoints
    226 227 
             GHC.ByteCode.InfoTable
    227 228 
             GHC.ByteCode.Instr
    228 229 
             GHC.ByteCode.Linker
    ... ... @@ -892,7 +893,6 @@ Library
    892 893 
             GHC.Types.Annotations
    893 894 
             GHC.Types.Avail
    894 895 
             GHC.Types.Basic
    895 
    -        GHC.Types.Breakpoint
    896 896 
             GHC.Types.CompleteMatch
    897 897 
             GHC.Types.CostCentre
    898 898 
             GHC.Types.CostCentre.State

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help