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

Commits:

26 changed files:

Changes:

  • compiler/GHC.hs
    ... ... @@ -201,7 +201,7 @@ module GHC (
    201 201 
             getResumeContext,
    202 202 
             GHC.obtainTermFromId, GHC.obtainTermFromVal, reconstructType,
    203 203 
             modInfoModBreaks,
    204 
    -        ModBreaks(..), BreakIndex,
    204 
    +        ModBreaks(..), BreakTickIndex,
    205 205 
             BreakpointId(..), InternalBreakpointId(..),
    206 206 
             GHC.Runtime.Eval.back,
    207 207 
             GHC.Runtime.Eval.forward,
    ... ... @@ -427,7 +427,6 @@ import GHC.Types.Basic
    427 427 
     import GHC.Types.TyThing
    428 428 
     import GHC.Types.Name.Env
    429 429 
     import GHC.Types.TypeEnv
    430 
    -import GHC.Types.Breakpoint
    431 430 
     import GHC.Types.PkgQual
    432 431
    433 432 
     import GHC.Unit

  • compiler/GHC/ByteCode/Asm.hs
    ... ... @@ -109,7 +109,7 @@ assembleBCOs
    109 109 
       -> FlatBag (ProtoBCO Name)
    110 110 
       -> [TyCon]
    111 111 
       -> [(Name, ByteString)]
    112 
    -  -> Maybe ModBreaks
    112 
    +  -> Maybe InternalModBreaks
    113 113 
       -> [SptEntry]
    114 114 
       -> IO CompiledByteCode
    115 115 
     assembleBCOs profile proto_bcos tycons top_strs modbreaks spt_entries = do
    ... ... @@ -841,19 +841,24 @@ assembleI platform i = case i of
    841 841 
         W8                   -> emit_ bci_OP_INDEX_ADDR_08 []
    842 842 
         _                    -> unsupported_width
    843 843
    844 
    -  BRK_FUN tick_mod tickx info_mod infox ->
    845 
    -                              do p1 <- ptr $ BCOPtrBreakArray tick_mod
    846 
    -                                 tick_addr <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName tick_mod
    847 
    -                                 info_addr <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName info_mod
    848 
    -                                 tick_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS $ moduleUnitId $ tick_mod
    849 
    -                                 info_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS $ moduleUnitId $ info_mod
    850 
    -                                 np <- lit1 $ BCONPtrCostCentre tick_mod $ fromIntegral tickx
    851 
    -                                 emit_ bci_BRK_FUN [ Op p1
    852 
    -                                                  , Op tick_addr, Op info_addr
    853 
    -                                                  , Op tick_unitid_addr, Op info_unitid_addr
    854 
    -                                                  , SmallOp tickx, SmallOp infox
    855 
    -                                                  , Op np
    856 
    -                                                  ]
    844 
    +  BRK_FUN (InternalBreakpointId tick_mod tickx info_mod infox) -> do
    845 
    +    let -- cast that checks that round-tripping through Word16 doesn't change the value
    846 
    +        toW16 x = let r = fromIntegral x :: Word16
    847 
    +                  in if fromIntegral r == x
    848 
    +                    then r
    849 
    +                    else pprPanic "schemeER_wrk: breakpoint tick/info index too large!" (ppr x)
    850 
    +    p1 <- ptr $ BCOPtrBreakArray tick_mod
    851 
    +    tick_addr <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName tick_mod
    852 
    +    info_addr <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName info_mod
    853 
    +    tick_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS $ moduleUnitId $ tick_mod
    854 
    +    info_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS $ moduleUnitId $ info_mod
    855 
    +    np <- lit1 $ BCONPtrCostCentre (BreakpointId tick_mod tickx)
    856 
    +    emit_ bci_BRK_FUN [ Op p1
    857 
    +                     , Op tick_addr, Op info_addr
    858 
    +                     , Op tick_unitid_addr, Op info_unitid_addr
    859 
    +                     , SmallOp (toW16 tickx), SmallOp (toW16 infox)
    860 
    +                     , Op np
    861 
    +                     ]
    857 862
    858 863 
       BRK_ALTS active -> emit_ bci_BRK_ALTS [SmallOp (if active then 1 else 0)]
    859 864

  • 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 [Breakpoint identifiers]
    11 
    +module GHC.ByteCode.Breakpoints
    12 
    +  ( -- * Internal Mod Breaks
    13 
    +    InternalModBreaks(..), CgBreakInfo(..)
    14 
    +  , mkInternalModBreaks
    15 
    +
    16 
    +    -- ** Internal breakpoint identifier
    17 
    +  , InternalBreakpointId(..), BreakInfoIndex
    18 
    +
    19 
    +    -- * Operations
    20 
    +  , toBreakpointId
    21 
    +
    22 
    +    -- ** Internal-level operations
    23 
    +  , getInternalBreak, addInternalBreak
    24 
    +
    25 
    +    -- ** Source-level information operations
    26 
    +  , getBreakLoc, getBreakVars, getBreakDecls, getBreakCCS
    27 
    +
    28 
    +    -- * Utils
    29 
    +  , seqInternalModBreaks
    30 
    +
    31 
    +  )
    32 
    +  where
    33 
    +
    34 
    +import GHC.Prelude
    35 
    +import GHC.Types.SrcLoc
    36 
    +import GHC.Types.Name.Occurrence
    37 
    +import Control.DeepSeq
    38 
    +import Data.IntMap.Strict (IntMap)
    39 
    +import qualified Data.IntMap.Strict as IM
    40 
    +
    41 
    +import GHC.HsToCore.Breakpoints
    42 
    +import GHC.Iface.Syntax
    43 
    +
    44 
    +import GHC.Unit.Module (Module)
    45 
    +import GHC.Utils.Outputable
    46 
    +import GHC.Utils.Panic
    47 
    +import Data.Array
    48 
    +
    49 
    +{-
    50 
    +Note [Breakpoint identifiers]
    51 
    +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    52 
    +Before optimization a breakpoint is identified uniquely with a tick module
    53 
    +and a tick index. See 'BreakpointId'. A tick module contains an array, indexed
    54 
    +with the tick indexes, which indicates breakpoint status.
    55 
    +
    56 
    +When we generate ByteCode, we collect information for every breakpoint at
    57 
    +their *occurrence sites* (see CgBreakInfo) and these info
    58 
    +are stored in the ModIface of the occurrence module. Because of inlining, we
    59 
    +can't reuse the tick index to uniquely identify an occurrence; because of
    60 
    +cross-module inlining, we can't assume that the occurrence module is the same
    61 
    +as the tick module (#24712).
    62 
    +
    63 
    +So every breakpoint occurrence gets assigned a module-unique *info index* and
    64 
    +we store it alongside the occurrence module (*info module*) in the
    65 
    +'InternalBreakpointId' datatype. This is the index that we use at runtime to
    66 
    +identify a breakpoint.
    67 
    +-}
    68 
    +
    69 
    +--------------------------------------------------------------------------------
    70 
    +-- * Internal breakpoint identifiers
    71 
    +--------------------------------------------------------------------------------
    72 
    +
    73 
    +-- | Internal breakpoint info index
    74 
    +type BreakInfoIndex = Int
    75 
    +
    76 
    +-- | Internal breakpoint identifier
    77 
    +--
    78 
    +-- Indexes into the structures in the @'InternalModBreaks'@ produced during ByteCode generation.
    79 
    +-- See Note [Breakpoint identifiers]
    80 
    +data InternalBreakpointId = InternalBreakpointId
    81 
    +  { ibi_tick_mod   :: !Module         -- ^ Breakpoint tick module
    82 
    +  , ibi_tick_index :: !Int            -- ^ Breakpoint tick index
    83 
    +  , ibi_info_mod   :: !Module         -- ^ Breakpoint tick module
    84 
    +  , ibi_info_index :: !BreakInfoIndex -- ^ Breakpoint tick index
    85 
    +  }
    86 
    +  deriving (Eq, Ord)
    87 
    +
    88 
    +toBreakpointId :: InternalBreakpointId -> BreakpointId
    89 
    +toBreakpointId ibi = BreakpointId
    90 
    +  { bi_tick_mod   = ibi_tick_mod ibi
    91 
    +  , bi_tick_index = ibi_tick_index ibi
    92 
    +  }
    93 
    +
    94 
    +--------------------------------------------------------------------------------
    95 
    +-- * Internal Mod Breaks
    96 
    +--------------------------------------------------------------------------------
    97 
    +
    98 
    +-- | Internal mod breaks store the runtime-relevant information of breakpoints.
    99 
    +--
    100 
    +-- Importantly, it maps 'InternalBreakpointId's to 'CgBreakInfo'.
    101 
    +--
    102 
    +-- 'InternalModBreaks' are constructed during bytecode generation and stored in
    103 
    +-- 'CompiledByteCode' afterwards.
    104 
    +data InternalModBreaks = InternalModBreaks
    105 
    +      { imodBreaks_breakInfo :: !(IntMap CgBreakInfo)
    106 
    +        -- ^ Access code-gen time information about a breakpoint, indexed by
    107 
    +        -- 'InternalBreakpointId'.
    108 
    +
    109 
    +      , imodBreaks_modBreaks :: !ModBreaks
    110 
    +        -- ^ Store the original ModBreaks for this module, unchanged.
    111 
    +        -- Allows us to query about source-level breakpoint information using
    112 
    +        -- an internal breakpoint id.
    113 
    +      }
    114 
    +
    115 
    +-- | Construct an 'InternalModBreaks'
    116 
    +mkInternalModBreaks :: Module -> IntMap CgBreakInfo -> ModBreaks -> InternalModBreaks
    117 
    +mkInternalModBreaks mod im mbs =
    118 
    +  assertPpr (mod == modBreaks_module mbs)
    119 
    +    (text "Constructing InternalModBreaks with the ModBreaks of a different module!") $
    120 
    +      InternalModBreaks im mbs
    121 
    +
    122 
    +-- | Information about a breakpoint that we know at code-generation time
    123 
    +-- In order to be used, this needs to be hydrated relative to the current HscEnv by
    124 
    +-- 'hydrateCgBreakInfo'. Everything here can be fully forced and that's critical for
    125 
    +-- preventing space leaks (see #22530)
    126 
    +data CgBreakInfo
    127 
    +   = CgBreakInfo
    128 
    +   { cgb_tyvars  :: ![IfaceTvBndr] -- ^ Type variables in scope at the breakpoint
    129 
    +   , cgb_vars    :: ![Maybe (IfaceIdBndr, Word)]
    130 
    +   , cgb_resty   :: !IfaceType
    131 
    +   }
    132 
    +-- See Note [Syncing breakpoint info] in GHC.Runtime.Eval
    133 
    +
    134 
    +-- | Get an internal breakpoint info by 'InternalBreakpointId'
    135 
    +getInternalBreak :: InternalBreakpointId -> InternalModBreaks -> CgBreakInfo
    136 
    +getInternalBreak (InternalBreakpointId _ _ info_mod info_ix) imbs =
    137 
    +  assert_modules_match info_mod (modBreaks_module $ imodBreaks_modBreaks imbs) $
    138 
    +    imodBreaks_breakInfo imbs IM.! info_ix
    139 
    +
    140 
    +-- | Add a CgBreakInfo to an 'InternalModBreaks' at 'InternalBreakpointId'
    141 
    +addInternalBreak :: InternalBreakpointId -> CgBreakInfo -> InternalModBreaks -> InternalModBreaks
    142 
    +addInternalBreak (InternalBreakpointId _ _ info_mod info_ix) info imbs =
    143 
    +  assert_modules_match info_mod (modBreaks_module $ imodBreaks_modBreaks imbs) $
    144 
    +    imbs{imodBreaks_breakInfo = IM.insert info_ix info (imodBreaks_breakInfo imbs)}
    145 
    +
    146 
    +-- | Assert that the module in the 'InternalBreakpointId' and in
    147 
    +-- 'InternalModBreaks' match.
    148 
    +assert_modules_match :: Module -> Module -> a -> a
    149 
    +assert_modules_match ibi_mod imbs_mod =
    150 
    +  assertPpr (ibi_mod == imbs_mod)
    151 
    +    (text "Tried to query the InternalModBreaks of module" <+> ppr imbs_mod
    152 
    +        <+> text "with an InternalBreakpointId for module" <+> ppr ibi_mod)
    153 
    +
    154 
    +--------------------------------------------------------------------------------
    155 
    +-- Tick-level Breakpoint information
    156 
    +--------------------------------------------------------------------------------
    157 
    +
    158 
    +-- | Get the source span for this breakpoint
    159 
    +getBreakLoc  :: InternalBreakpointId -> InternalModBreaks -> SrcSpan
    160 
    +getBreakLoc = getBreakXXX modBreaks_locs
    161 
    +
    162 
    +-- | Get the vars for this breakpoint
    163 
    +getBreakVars  :: InternalBreakpointId -> InternalModBreaks -> [OccName]
    164 
    +getBreakVars = getBreakXXX modBreaks_vars
    165 
    +
    166 
    +-- | Get the decls for this breakpoint
    167 
    +getBreakDecls :: InternalBreakpointId -> InternalModBreaks -> [String]
    168 
    +getBreakDecls = getBreakXXX modBreaks_decls
    169 
    +
    170 
    +-- | Get the decls for this breakpoint
    171 
    +getBreakCCS :: InternalBreakpointId -> InternalModBreaks -> (String, String)
    172 
    +getBreakCCS = getBreakXXX modBreaks_ccs
    173 
    +
    174 
    +-- | Internal utility to access a ModBreaks field at a particular breakpoint index
    175 
    +getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> InternalBreakpointId -> InternalModBreaks -> a
    176 
    +getBreakXXX view (InternalBreakpointId tick_mod tick_id _ _) imbs =
    177 
    +  assert_modules_match tick_mod (modBreaks_module $ imodBreaks_modBreaks imbs) $ do
    178 
    +    view (imodBreaks_modBreaks imbs) ! tick_id
    179 
    +
    180 
    +--------------------------------------------------------------------------------
    181 
    +-- Instances
    182 
    +--------------------------------------------------------------------------------
    183 
    +
    184 
    +-- | Fully force an 'InternalModBreaks' value
    185 
    +seqInternalModBreaks :: InternalModBreaks -> ()
    186 
    +seqInternalModBreaks InternalModBreaks{..} =
    187 
    +    rnf (fmap seqCgBreakInfo imodBreaks_breakInfo)
    188 
    +  where
    189 
    +    seqCgBreakInfo :: CgBreakInfo -> ()
    190 
    +    seqCgBreakInfo CgBreakInfo{..} =
    191 
    +        rnf cgb_tyvars `seq`
    192 
    +        rnf cgb_vars `seq`
    193 
    +        rnf cgb_resty
    194 
    +
    195 
    +instance Outputable InternalBreakpointId where
    196 
    +  ppr InternalBreakpointId{..} =
    197 
    +    text "InternalBreakpointId" <+> ppr ibi_info_mod <+> ppr ibi_info_index
    198 
    +
    199 
    +instance NFData InternalBreakpointId where
    200 
    +  rnf InternalBreakpointId{..} =
    201 
    +    rnf ibi_info_mod `seq` rnf ibi_info_index
    202 
    +
    203 
    +instance Outputable CgBreakInfo where
    204 
    +   ppr info = text "CgBreakInfo" <+>
    205 
    +              parens (ppr (cgb_vars info) <+>
    206 
    +                      ppr (cgb_resty info))

  • compiler/GHC/ByteCode/Instr.hs
    ... ... @@ -17,7 +17,6 @@ import GHC.ByteCode.Types
    17 17 
     import GHC.Cmm.Type (Width)
    18 18 
     import GHC.StgToCmm.Layout     ( ArgRep(..) )
    19 19 
     import GHC.Utils.Outputable
    20 
    -import GHC.Unit.Module
    21 20 
     import GHC.Types.Name
    22 21 
     import GHC.Types.Literal
    23 22 
     import GHC.Types.Unique
    ... ... @@ -259,10 +258,7 @@ data BCInstr
    259 258 
                        -- Note [unboxed tuple bytecodes and tuple_BCO] in GHC.StgToByteCode
    260 259
    261 260 
        -- Breakpoints
    262 
    -   | BRK_FUN          !Module                -- breakpoint tick module
    263 
    -                      !Word16                -- breakpoint tick index
    264 
    -                      !Module                -- breakpoint info module
    265 
    -                      !Word16                -- breakpoint info index
    261 
    +   | BRK_FUN          !InternalBreakpointId
    266 262
    267 263 
        -- An internal breakpoint for triggering a break on any case alternative
    268 264 
        -- See Note [Debugger: BRK_ALTS]
    ... ... @@ -458,10 +454,10 @@ instance Outputable BCInstr where
    458 454 
        ppr ENTER                 = text "ENTER"
    459 455 
        ppr (RETURN pk)           = text "RETURN  " <+> ppr pk
    460 456 
        ppr (RETURN_TUPLE)        = text "RETURN_TUPLE"
    461 
    -   ppr (BRK_FUN _tick_mod tickx _info_mod infox)
    457 
    +   ppr (BRK_FUN (InternalBreakpointId tick_mod tickx info_mod infox))
    462 458 
                                  = text "BRK_FUN" <+> text "<breakarray>"
    463 
    -                               <+> text "<tick_module>" <+> text "<tick_module_unitid>" <+> ppr tickx
    464 
    -                               <+> text "<info_module>" <+> text "<info_module_unitid>" <+> ppr infox
    459 
    +                               <+> ppr tick_mod <+> ppr tickx
    460 
    +                               <+> ppr info_mod <+> ppr infox
    465 461 
                                    <+> text "<cc>"
    466 462 
        ppr (BRK_ALTS active)     = text "BRK_ALTS" <+> ppr active
    467 463 
     #if MIN_VERSION_rts(1,0,3)

  • compiler/GHC/ByteCode/Linker.hs
    ... ... @@ -97,9 +97,9 @@ lookupLiteral interp pkgs_loaded le ptr = case ptr of
    97 97 
       BCONPtrFFIInfo (FFIInfo {..}) -> do
    98 98 
         RemotePtr p <- interpCmd interp $ PrepFFI ffiInfoArgs ffiInfoRet
    99 99 
         pure $ fromIntegral p
    100 
    -  BCONPtrCostCentre tick_mod tick_no
    101 
    -    | interpreterProfiled interp ->
    102 
    -        case expectJust (lookupModuleEnv (ccs_env le) tick_mod) ! tick_no of
    100 
    +  BCONPtrCostCentre BreakpointId{..}
    101 
    +    | interpreterProfiled interp -> do
    102 
    +        case expectJust (lookupModuleEnv (ccs_env le) bi_tick_mod) ! bi_tick_index of
    103 103 
               RemotePtr p -> pure $ fromIntegral p
    104 104 
         | otherwise ->
    105 105 
             case toRemotePtr nullPtr of

  • compiler/GHC/ByteCode/Types.hs
    ... ... @@ -18,10 +18,15 @@ module GHC.ByteCode.Types
    18 18 
       , UnlinkedBCO(..), BCOPtr(..), BCONPtr(..)
    19 19 
       , ItblEnv, ItblPtr(..)
    20 20 
       , AddrEnv, AddrPtr(..)
    21 
    -  , CgBreakInfo(..)
    22 
    -  , ModBreaks (..), BreakIndex
    23 
    -  , CCostCentre
    24 21 
       , FlatBag, sizeFlatBag, fromSmallArray, elemsFlatBag
    22 
    +
    23 
    +  -- * Mod Breaks
    24 
    +  , ModBreaks (..), BreakpointId(..), BreakTickIndex
    25 
    +
    26 
    +  -- * Internal Mod Breaks
    27 
    +  , InternalModBreaks(..), CgBreakInfo(..), seqInternalModBreaks
    28 
    +  -- ** Internal breakpoint identifier
    29 
    +  , InternalBreakpointId(..), BreakInfoIndex
    25 30 
       ) where
    26 31
    27 32 
     import GHC.Prelude
    ... ... @@ -33,8 +38,8 @@ import GHC.Types.Name.Env
    33 38 
     import GHC.Utils.Outputable
    34 39 
     import GHC.Builtin.PrimOps
    35 40 
     import GHC.Types.SptEntry
    36 
    -import GHC.Types.SrcLoc
    37 
    -import GHCi.BreakArray
    41 
    +import GHC.HsToCore.Breakpoints
    42 
    +import GHC.ByteCode.Breakpoints
    38 43 
     import GHCi.Message
    39 44 
     import GHCi.RemoteTypes
    40 45 
     import GHCi.FFI
    ... ... @@ -42,12 +47,9 @@ import Control.DeepSeq
    42 47 
     import GHCi.ResolvedBCO ( BCOByteArray(..), mkBCOByteArray )
    43 48
    44 49 
     import Foreign
    45 
    -import Data.Array
    46 50 
     import Data.ByteString (ByteString)
    47 
    -import Data.IntMap (IntMap)
    48 51 
     import qualified GHC.Exts.Heap as Heap
    49 52 
     import GHC.Cmm.Expr ( GlobalRegSet, emptyRegSet, regSetToList )
    50 
    -import GHC.Iface.Syntax
    51 53 
     import GHC.Unit.Module
    52 54
    53 55 
     -- -----------------------------------------------------------------------------
    ... ... @@ -63,8 +65,12 @@ data CompiledByteCode = CompiledByteCode
    63 65 
       , bc_strs   :: [(Name, ByteString)]
    64 66 
         -- ^ top-level strings (heap allocated)
    65 67
    66 
    -  , bc_breaks :: Maybe ModBreaks
    67 
    -    -- ^ breakpoint info (Nothing if breakpoints are disabled)
    68 
    +  , bc_breaks :: Maybe InternalModBreaks
    69 
    +    -- ^ All breakpoint information (no information if breakpoints are disabled).
    70 
    +    --
    71 
    +    -- This information is used when loading a bytecode object: we will
    72 
    +    -- construct the arrays to be used at runtime to trigger breakpoints at load time
    73 
    +    -- from it (in 'allocateBreakArrays' and 'allocateCCS' in 'GHC.ByteCode.Loader').
    68 74
    69 75 
       , bc_spt_entries :: ![SptEntry]
    70 76 
         -- ^ Static pointer table entries which should be loaded along with the
    ... ... @@ -86,7 +92,9 @@ seqCompiledByteCode CompiledByteCode{..} =
    86 92 
       rnf bc_bcos `seq`
    87 93 
       rnf bc_itbls `seq`
    88 94 
       rnf bc_strs `seq`
    89 
    -  rnf (fmap seqModBreaks bc_breaks)
    95 
    +  case bc_breaks of
    96 
    +    Nothing -> ()
    97 
    +    Just ibks -> seqInternalModBreaks ibks
    90 98
    91 99 
     newtype ByteOff = ByteOff Int
    92 100 
         deriving (Enum, Eq, Show, Integral, Num, Ord, Real, Outputable)
    ... ... @@ -276,87 +284,15 @@ data BCONPtr
    276 284 
       | BCONPtrFS    !FastString
    277 285 
       -- | A libffi ffi_cif function prototype.
    278 286 
       | BCONPtrFFIInfo !FFIInfo
    279 
    -  -- | A 'CostCentre' remote pointer array's respective 'Module' and index.
    280 
    -  | BCONPtrCostCentre !Module !BreakIndex
    287 
    +  -- | A 'CostCentre' remote pointer array's respective 'BreakpointId'
    288 
    +  | BCONPtrCostCentre !BreakpointId
    281 289
    282 290 
     instance NFData BCONPtr where
    283 291 
       rnf x = x `seq` ()
    284 292
    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 
    -   }
    295 
    --- See Note [Syncing breakpoint info] in GHC.Runtime.Eval
    296 
    -
    297 
    -seqCgBreakInfo :: CgBreakInfo -> ()
    298 
    -seqCgBreakInfo CgBreakInfo{..} =
    299 
    -    rnf cgb_tyvars `seq`
    300 
    -    rnf cgb_vars `seq`
    301 
    -    rnf cgb_resty
    302 
    -
    303 293 
     instance Outputable UnlinkedBCO where
    304 294 
        ppr (UnlinkedBCO nm _arity _insns _bitmap lits ptrs)
    305 295 
           = sep [text "BCO", ppr nm, text "with",
    306 296 
                  ppr (sizeFlatBag lits), text "lits",
    307 297 
                  ppr (sizeFlatBag ptrs), text "ptrs" ]
    308 298
    309 
    -instance Outputable CgBreakInfo where
    310 
    -   ppr info = text "CgBreakInfo" <+>
    311 
    -              parens (ppr (cgb_vars info) <+>
    312 
    -                      ppr (cgb_resty info))
    313 
    -
    314 
    --- -----------------------------------------------------------------------------
    315 
    --- Breakpoints
    316 
    -
    317 
    --- | Breakpoint index
    318 
    -type BreakIndex = Int
    319 
    -
    320 
    --- | C CostCentre type
    321 
    -data CCostCentre
    322 
    -
    323 
    --- | All the information about the breakpoints for a module
    324 
    -data ModBreaks
    325 
    -   = ModBreaks
    326 
    -   { modBreaks_flags :: ForeignRef BreakArray
    327 
    -        -- ^ The array of flags, one per breakpoint,
    328 
    -        -- indicating which breakpoints are enabled.
    329 
    -   , modBreaks_locs :: !(Array BreakIndex SrcSpan)
    330 
    -        -- ^ An array giving the source span of each breakpoint.
    331 
    -   , modBreaks_vars :: !(Array BreakIndex [OccName])
    332 
    -        -- ^ An array giving the names of the free variables at each breakpoint.
    333 
    -   , modBreaks_decls :: !(Array BreakIndex [String])
    334 
    -        -- ^ An array giving the names of the declarations enclosing each breakpoint.
    335 
    -        -- See Note [Field modBreaks_decls]
    336 
    -   , modBreaks_ccs :: !(Array BreakIndex (String, String))
    337 
    -        -- ^ Array pointing to cost centre info for each breakpoint;
    338 
    -        -- actual 'CostCentre' allocation is done at link-time.
    339 
    -   , modBreaks_breakInfo :: !(IntMap CgBreakInfo)
    340 
    -        -- ^ info about each breakpoint from the bytecode generator
    341 
    -   , modBreaks_module :: !Module
    342 
    -        -- ^ info about the module in which we are setting the breakpoint
    343 
    -   }
    344 
    -
    345 
    -seqModBreaks :: ModBreaks -> ()
    346 
    -seqModBreaks ModBreaks{..} =
    347 
    -  rnf modBreaks_flags `seq`
    348 
    -  rnf modBreaks_locs `seq`
    349 
    -  rnf modBreaks_vars `seq`
    350 
    -  rnf modBreaks_decls `seq`
    351 
    -  rnf modBreaks_ccs `seq`
    352 
    -  rnf (fmap seqCgBreakInfo modBreaks_breakInfo) `seq`
    353 
    -  rnf modBreaks_module
    354 
    -
    355 
    -{-
    356 
    -Note [Field modBreaks_decls]
    357 
    -~~~~~~~~~~~~~~~~~~~~~~
    358 
    -A value of eg ["foo", "bar", "baz"] in a `modBreaks_decls` field means:
    359 
    -The breakpoint is in the function called "baz" that is declared in a `let`
    360 
    -or `where` clause of a declaration called "bar", which itself is declared
    361 
    -in a `let` or `where` clause of the top-level function called "foo".
    362 
    --}

  • 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/Driver/Session/Inspect.hs
    ... ... @@ -91,7 +91,7 @@ data ModuleInfo = ModuleInfo {
    91 91 
             minf_instances :: [ClsInst],
    92 92 
             minf_iface     :: Maybe ModIface,
    93 93 
             minf_safe      :: SafeHaskellMode,
    94 
    -        minf_modBreaks :: Maybe ModBreaks
    94 
    +        minf_modBreaks :: Maybe InternalModBreaks
    95 95 
       }
    96 96 
             -- We don't want HomeModInfo here, because a ModuleInfo applies
    97 97 
             -- to package modules too.
    ... ... @@ -196,6 +196,6 @@ modInfoIface = minf_iface
    196 196 
     modInfoSafe :: ModuleInfo -> SafeHaskellMode
    197 197 
     modInfoSafe = minf_safe
    198 198
    199 
    -modInfoModBreaks :: ModuleInfo -> Maybe ModBreaks
    199 
    +modInfoModBreaks :: ModuleInfo -> Maybe InternalModBreaks
    200 200 
     modInfoModBreaks = minf_modBreaks
    201 201

  • compiler/GHC/HsToCore.hs
    ... ... @@ -97,8 +97,8 @@ 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)
    101 
    +import GHC.Runtime.Interpreter (interpreterProfiled)
    102 102
    103 103 
     {-
    104 104 
     ************************************************************************
    ... ... @@ -162,13 +162,12 @@ deSugar hsc_env
    162 162 
                                            mod mod_loc
    163 163 
                                            export_set (typeEnvTyCons type_env) binds
    164 164 
                                   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
    165 
    +        ; let modBreaks
    166 
    +                | Just (_, specs) <- m_tickInfo
    167 
    +                , breakpointsAllowed dflags
    168 
    +                = Just $ mkModBreaks (interpreterProfiled $ hscInterp hsc_env) mod specs
    169 
    +                | otherwise
    170 
    +                = Nothing
    172 171
    173 172 
             ; ds_hpc_info <- case m_tickInfo of
    174 173 
                 Just (orig_file2, ticks)

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

  • compiler/GHC/HsToCore/Ticks.hs
    ... ... @@ -34,7 +34,6 @@ import GHC.Driver.Flags (DumpFlag(..))
    34 34 
     import GHC.Utils.Outputable as Outputable
    35 35 
     import GHC.Utils.Panic
    36 36 
     import GHC.Utils.Logger
    37 
    -import GHC.Types.Breakpoint
    38 37 
     import GHC.Types.SrcLoc
    39 38 
     import GHC.Types.Basic
    40 39 
     import GHC.Types.Id

  • 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/Linker/Loader.hs
    ... ... @@ -28,6 +28,7 @@ module GHC.Linker.Loader
    28 28 
        , extendLoadedEnv
    29 29 
        , deleteFromLoadedEnv
    30 30 
        -- * Internals
    31 
    +   , allocateBreakArrays
    31 32 
        , rmDupLinkables
    32 33 
        , modifyLoaderState
    33 34 
        , initLinkDepsOpts
    ... ... @@ -122,8 +123,8 @@ import System.Win32.Info (getSystemDirectory)
    122 123 
     import GHC.Utils.Exception
    123 124 
     import GHC.Unit.Home.Graph (lookupHug, unitEnv_foldWithKey)
    124 125 
     import GHC.Driver.Downsweep
    125 
    -
    126 
    -
    126 
    +import qualified GHC.Runtime.Interpreter as GHCi
    127 
    +import Data.Array.Base (numElements)
    127 128
    128 129 
     -- Note [Linkers and loaders]
    129 130 
     -- ~~~~~~~~~~~~~~~~~~~~~~~~~~
    ... ... @@ -696,16 +697,8 @@ loadDecls interp hsc_env span linkable = do
    696 697 
               let le  = linker_env pls
    697 698 
               le2_itbl_env <- linkITbls interp (itbl_env le) (concat $ map bc_itbls cbcs)
    698 699 
               le2_addr_env <- foldlM (\env cbc -> allocateTopStrings interp (bc_strs cbc) env) (addr_env le) cbcs
    699 
    -          le2_breakarray_env <-
    700 
    -            allocateBreakArrays
    701 
    -              interp
    702 
    -              (catMaybes $ map bc_breaks cbcs)
    703 
    -              (breakarray_env le)
    704 
    -          le2_ccs_env <-
    705 
    -            allocateCCS
    706 
    -              interp
    707 
    -              (catMaybes $ map bc_breaks cbcs)
    708 
    -              (ccs_env le)
    700 
    +          le2_breakarray_env <- allocateBreakArrays interp (breakarray_env le) (catMaybes $ map bc_breaks cbcs)
    701 
    +          le2_ccs_env        <- allocateCCS         interp (ccs_env le)        (catMaybes $ map bc_breaks cbcs)
    709 702 
               let le2 = le { itbl_env = le2_itbl_env
    710 703 
                            , addr_env = le2_addr_env
    711 704 
                            , breakarray_env = le2_breakarray_env
    ... ... @@ -933,12 +926,8 @@ dynLinkBCOs interp pls bcos = do
    933 926 
                 le1 = linker_env pls
    934 927 
             ie2 <- linkITbls interp (itbl_env le1) (concatMap bc_itbls cbcs)
    935 928 
             ae2 <- foldlM (\env cbc -> allocateTopStrings interp (bc_strs cbc) env) (addr_env le1) cbcs
    936 
    -        be2 <-
    937 
    -          allocateBreakArrays
    938 
    -            interp
    939 
    -            (catMaybes $ map bc_breaks cbcs)
    940 
    -            (breakarray_env le1)
    941 
    -        ce2 <- allocateCCS interp (catMaybes $ map bc_breaks cbcs) (ccs_env le1)
    929 
    +        be2 <- allocateBreakArrays interp (breakarray_env le1) (catMaybes $ map bc_breaks cbcs)
    930 
    +        ce2 <- allocateCCS         interp (ccs_env le1)        (catMaybes $ map bc_breaks cbcs)
    942 931 
             let le2 = le1 { itbl_env = ie2, addr_env = ae2, breakarray_env = be2, ccs_env = ce2 }
    943 932
    944 933 
             names_and_refs <- linkSomeBCOs interp (pkgs_loaded pls) le2 cbcs
    ... ... @@ -1656,44 +1645,51 @@ allocateTopStrings interp topStrings prev_env = do
    1656 1645 
       where
    1657 1646 
         mk_entry nm ptr = (nm, (nm, AddrPtr ptr))
    1658 1647
    1659 
    --- | Given a list of 'ModBreaks' collected from a list of
    1660 
    --- 'CompiledByteCode', allocate the 'BreakArray'.
    1648 
    +-- | Given a list of 'InternalModBreaks' collected from a list of
    1649 
    +-- 'CompiledByteCode', allocate the 'BreakArray' used to trigger breakpoints.
    1661 1650 
     allocateBreakArrays ::
    1662 1651 
       Interp ->
    1663 
    -  [ModBreaks] ->
    1664 1652 
       ModuleEnv (ForeignRef BreakArray) ->
    1653 
    +  [InternalModBreaks] ->
    1665 1654 
       IO (ModuleEnv (ForeignRef BreakArray))
    1666 
    -allocateBreakArrays _interp mbs be =
    1655 
    +allocateBreakArrays interp =
    1667 1656 
       foldlM
    1668 
    -    ( \be0 ModBreaks {..} ->
    1669 
    -        evaluate $ extendModuleEnv be0 modBreaks_module modBreaks_flags
    1657 
    +    ( \be0 InternalModBreaks{imodBreaks_modBreaks=ModBreaks {..}} -> do
    1658 
    +        -- If no BreakArray is assigned to this module yet, create one
    1659 
    +        if not $ elemModuleEnv modBreaks_module be0 then do
    1660 
    +          let count = numElements modBreaks_locs
    1661 
    +          breakArray <- GHCi.newBreakArray interp count
    1662 
    +          evaluate $ extendModuleEnv be0 modBreaks_module breakArray
    1663 
    +        else
    1664 
    +          return be0
    1670 1665 
         )
    1671 
    -    be
    1672 
    -    mbs
    1673 1666
    1674 
    --- | Given a list of 'ModBreaks' collected from a list of
    1675 
    --- 'CompiledByteCode', allocate the 'CostCentre' arrays when profiling
    1676 
    --- is enabled.
    1667 
    +-- | Given a list of 'InternalModBreaks' collected from a list
    1668 
    +-- of 'CompiledByteCode', allocate the 'CostCentre' arrays when profiling is
    1669 
    +-- enabled.
    1677 1670 
     allocateCCS ::
    1678 1671 
       Interp ->
    1679 
    -  [ModBreaks] ->
    1680 
    -  ModuleEnv (Array BreakIndex (RemotePtr CostCentre)) ->
    1681 
    -  IO (ModuleEnv (Array BreakIndex (RemotePtr CostCentre)))
    1682 
    -allocateCCS interp mbs ce
    1672 
    +  ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre)) ->
    1673 
    +  [InternalModBreaks] ->
    1674 
    +  IO (ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre)))
    1675 
    +allocateCCS interp ce mbss
    1683 1676 
       | interpreterProfiled interp =
    1684 1677 
           foldlM
    1685 
    -        ( \ce0 ModBreaks {..} -> do
    1678 
    +        ( \ce0 InternalModBreaks{imodBreaks_modBreaks=ModBreaks {..}} -> do
    1686 1679 
                 ccs <-
    1687 1680 
                   mkCostCentres
    1688 1681 
                     interp
    1689 1682 
                     (moduleNameString $ moduleName modBreaks_module)
    1690 1683 
                     (elems modBreaks_ccs)
    1691 
    -            evaluate $
    1692 
    -              extendModuleEnv ce0 modBreaks_module $
    1693 
    -                listArray
    1694 
    -                  (0, length ccs - 1)
    1695 
    -                  ccs
    1684 
    +            if not $ elemModuleEnv modBreaks_module ce0 then do
    1685 
    +              evaluate $
    1686 
    +                extendModuleEnv ce0 modBreaks_module $
    1687 
    +                  listArray
    1688 
    +                    (0, length ccs - 1)
    1689 
    +                    ccs
    1690 
    +            else
    1691 
    +              return ce0
    1696 1692 
             )
    1697 1693 
             ce
    1698 
    -        mbs
    1694 
    +        mbss
    1699 1695 
       | otherwise = pure ce

  • compiler/GHC/Linker/Types.hs
    ... ... @@ -188,7 +188,7 @@ data LinkerEnv = LinkerEnv
    188 188 
       , breakarray_env :: !(ModuleEnv (ForeignRef BreakArray))
    189 189 
           -- ^ Each 'Module's remote pointer of 'BreakArray'.
    190 190
    191 
    -  , ccs_env :: !(ModuleEnv (Array BreakIndex (RemotePtr CostCentre)))
    191 
    +  , ccs_env :: !(ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre)))
    192 192 
           -- ^ Each 'Module's array of remote pointers of 'CostCentre'.
    193 193 
           -- Untouched when not profiling.
    194 194 
       }

  • compiler/GHC/Runtime/Debugger/Breakpoints.hs
    ... ... @@ -16,7 +16,8 @@ import Data.Maybe
    16 16 
     import qualified Data.List.NonEmpty as NE
    17 17 
     import qualified Data.Semigroup as S
    18 18
    19 
    -import GHC.ByteCode.Types (BreakIndex, ModBreaks(..))
    19 
    +import GHC.HsToCore.Breakpoints
    20 
    +import GHC.ByteCode.Breakpoints
    20 21 
     import GHC.Driver.Env
    21 22 
     import GHC.Driver.Monad
    22 23 
     import GHC.Driver.Session.Inspect
    ... ... @@ -24,7 +25,6 @@ import GHC.Runtime.Eval
    24 25 
     import GHC.Runtime.Eval.Utils
    25 26 
     import GHC.Types.Name
    26 27 
     import GHC.Types.SrcLoc
    27 
    -import GHC.Types.Breakpoint
    28 28 
     import GHC.Unit.Module
    29 29 
     import GHC.Unit.Module.Graph
    30 30 
     import GHC.Unit.Module.ModSummary
    ... ... @@ -44,7 +44,7 @@ import qualified GHC.Data.Strict as Strict
    44 44 
     --    - the leftmost subexpression starting on the specified line, or
    45 45 
     --    - the rightmost subexpression enclosing the specified line
    46 46 
     --
    47 
    -findBreakByLine :: Int {-^ Line number -} -> TickArray -> Maybe (BreakIndex, RealSrcSpan)
    47 
    +findBreakByLine :: Int {-^ Line number -} -> TickArray -> Maybe (BreakTickIndex, RealSrcSpan)
    48 48 
     findBreakByLine line arr
    49 49 
       | not (inRange (bounds arr) line) = Nothing
    50 50 
       | otherwise =
    ... ... @@ -61,7 +61,7 @@ findBreakByLine line arr
    61 61 
                 where ends_here (_,pan) = srcSpanEndLine pan == line
    62 62
    63 63 
     -- | Find a breakpoint in the 'TickArray' of a module, given a line number and a column coordinate.
    64 
    -findBreakByCoord :: (Int, Int) -> TickArray -> Maybe (BreakIndex, RealSrcSpan)
    64 
    +findBreakByCoord :: (Int, Int) -> TickArray -> Maybe (BreakTickIndex, RealSrcSpan)
    65 65 
     findBreakByCoord (line, col) arr
    66 66 
       | not (inRange (bounds arr) line) = Nothing
    67 67 
       | otherwise =
    ... ... @@ -174,7 +174,7 @@ resolveFunctionBreakpoint inp = do
    174 174 
     -- for
    175 175 
     --   (a) this binder only (it maybe a top-level or a nested declaration)
    176 176 
     --   (b) that do not have an enclosing breakpoint
    177 
    -findBreakForBind :: String {-^ Name of bind to break at -} -> ModBreaks -> [(BreakIndex, RealSrcSpan)]
    177 
    +findBreakForBind :: String {-^ Name of bind to break at -} -> ModBreaks -> [(BreakTickIndex, RealSrcSpan)]
    178 178 
     findBreakForBind str_name modbreaks = filter (not . enclosed) ticks
    179 179 
       where
    180 180 
         ticks = [ (index, span)
    ... ... @@ -191,15 +191,15 @@ findBreakForBind str_name modbreaks = filter (not . enclosed) ticks
    191 191 
     --------------------------------------------------------------------------------
    192 192
    193 193 
     -- | Maps line numbers to the breakpoint ticks existing at that line for a module.
    194 
    -type TickArray = Array Int [(BreakIndex,RealSrcSpan)]
    194 
    +type TickArray = Array Int [(BreakTickIndex,RealSrcSpan)]
    195 195
    196 196 
     -- | Construct the 'TickArray' for the given module.
    197 197 
     makeModuleLineMap :: GhcMonad m => Module -> m (Maybe TickArray)
    198 198 
     makeModuleLineMap m = do
    199 199 
       mi <- getModuleInfo m
    200 
    -  return $ mkTickArray . assocs . modBreaks_locs <$> (modInfoModBreaks =<< mi)
    200 
    +  return $ mkTickArray . assocs . modBreaks_locs . imodBreaks_modBreaks <$> (modInfoModBreaks =<< mi)
    201 201 
       where
    202 
    -    mkTickArray :: [(BreakIndex, SrcSpan)] -> TickArray
    202 
    +    mkTickArray :: [(BreakTickIndex, SrcSpan)] -> TickArray
    203 203 
         mkTickArray ticks
    204 204 
           = accumArray (flip (:)) [] (1, max_line)
    205 205 
                 [ (line, (nm,pan)) | (nm,RealSrcSpan pan _) <- ticks, line <- srcSpanLines pan ]
    ... ... @@ -211,7 +211,7 @@ makeModuleLineMap m = do
    211 211 
     getModBreak :: GhcMonad m => Module -> m (Maybe ModBreaks)
    212 212 
     getModBreak m = do
    213 213 
        mod_info <- fromMaybe (panic "getModBreak") <$> getModuleInfo m
    214 
    -   pure $ modInfoModBreaks mod_info
    214 
    +   pure $ imodBreaks_modBreaks <$> modInfoModBreaks mod_info
    215 215
    216 216 
     --------------------------------------------------------------------------------
    217 217 
     -- Getting current breakpoint information

  • compiler/GHC/Runtime/Eval.hs
    ... ... @@ -64,6 +64,7 @@ import GHCi.RemoteTypes
    64 64 
     import GHC.ByteCode.Types
    65 65
    66 66 
     import GHC.Linker.Loader as Loader
    67 
    +import GHC.Linker.Types (LinkerEnv(..))
    67 68
    68 69 
     import GHC.Hs
    69 70
    ... ... @@ -111,7 +112,6 @@ import GHC.Types.Unique
    111 112 
     import GHC.Types.Unique.Supply
    112 113 
     import GHC.Types.Unique.DSet
    113 114 
     import GHC.Types.TyThing
    114 
    -import GHC.Types.Breakpoint
    115 115 
     import GHC.Types.Unique.Map
    116 116
    117 117 
     import GHC.Types.Avail
    ... ... @@ -127,16 +127,16 @@ import GHC.Tc.Utils.Instantiate (instDFunType)
    127 127 
     import GHC.Tc.Utils.Monad
    128 128
    129 129 
     import GHC.IfaceToCore
    130 
    +import GHC.ByteCode.Breakpoints
    130 131
    131 132 
     import Control.Monad
    132 
    -import Data.Array
    133 133 
     import Data.Dynamic
    134 134 
     import Data.IntMap (IntMap)
    135 
    -import qualified Data.IntMap as IntMap
    136 135 
     import Data.List (find,intercalate)
    137 136 
     import Data.List.NonEmpty (NonEmpty)
    138 137 
     import Unsafe.Coerce ( unsafeCoerce )
    139 138 
     import qualified GHC.Unit.Home.Graph as HUG
    139 
    +import GHCi.BreakArray (BreakArray)
    140 140
    141 141 
     -- -----------------------------------------------------------------------------
    142 142 
     -- running a statement interactively
    ... ... @@ -154,7 +154,7 @@ getHistorySpan :: HUG.HomeUnitGraph -> History -> IO SrcSpan
    154 154 
     getHistorySpan hug hist = do
    155 155 
       let ibi = historyBreakpointId hist
    156 156 
       brks <- readModBreaks hug (ibi_tick_mod ibi)
    157 
    -  return $ modBreaks_locs brks ! ibi_tick_index ibi
    157 
    +  return $ getBreakLoc ibi brks
    158 158
    159 159 
     {- | Finds the enclosing top level function name -}
    160 160 
     -- ToDo: a better way to do this would be to keep hold of the decl_path computed
    ... ... @@ -163,7 +163,7 @@ getHistorySpan hug hist = do
    163 163 
     findEnclosingDecls :: HUG.HomeUnitGraph -> InternalBreakpointId -> IO [String]
    164 164 
     findEnclosingDecls hug ibi = do
    165 165 
       brks <- readModBreaks hug (ibi_tick_mod ibi)
    166 
    -  return $ modBreaks_decls brks ! ibi_tick_index ibi
    166 
    +  return $ getBreakDecls ibi brks
    167 167
    168 168 
     -- | Update fixity environment in the current interactive context.
    169 169 
     updateFixityEnv :: GhcMonad m => FixityEnv -> m ()
    ... ... @@ -350,13 +350,14 @@ handleRunStatus step expr bindings final_ids status history0 = do
    350 350 
         EvalBreak apStack_ref (Just eval_break) resume_ctxt ccs -> do
    351 351 
           let ibi = evalBreakpointToId eval_break
    352 352 
           let hug = hsc_HUG hsc_env
    353 
    -      tick_brks <- liftIO $ readModBreaks hug (ibi_tick_mod ibi)
    353 
    +      tick_brks  <- liftIO $ readModBreaks hug (ibi_tick_mod ibi)
    354 
    +      breakArray <- getBreakArray interp (toBreakpointId ibi) tick_brks
    354 355 
           let
    355 
    -        span      = modBreaks_locs tick_brks ! ibi_tick_index ibi
    356 
    -        decl      = intercalate "." $ modBreaks_decls tick_brks ! ibi_tick_index ibi
    356 
    +        span = getBreakLoc ibi tick_brks
    357 
    +        decl = intercalate "." $ getBreakDecls ibi tick_brks
    357 358
    358 359 
           -- Was this breakpoint explicitly enabled (ie. in @BreakArray@)?
    359 
    -      bactive <- liftIO $ breakpointStatus interp (modBreaks_flags tick_brks) (ibi_tick_index ibi)
    360 
    +      bactive <- liftIO $ breakpointStatus interp breakArray (ibi_tick_index ibi)
    360 361
    361 362 
           apStack_fhv <- liftIO $ mkFinalizedHValue interp apStack_ref
    362 363 
           resume_ctxt_fhv   <- liftIO $ mkFinalizedHValue interp resume_ctxt
    ... ... @@ -464,9 +465,24 @@ setupBreakpoint :: GhcMonad m => Interp -> BreakpointId -> Int -> m () -- #191
    464 465 
     setupBreakpoint interp bi cnt = do
    465 466 
       hug <- hsc_HUG <$> getSession
    466 467 
       modBreaks <- liftIO $ readModBreaks hug (bi_tick_mod bi)
    467 
    -  let breakarray = modBreaks_flags modBreaks
    468 
    -  _ <- liftIO $ GHCi.storeBreakpoint interp breakarray (bi_tick_index bi) cnt
    469 
    -  pure ()
    468 
    +  breakArray <- getBreakArray interp bi modBreaks
    469 
    +  liftIO $ GHCi.storeBreakpoint interp breakArray (bi_tick_index bi) cnt
    470 
    +
    471 
    +getBreakArray :: GhcMonad m => Interp -> BreakpointId -> InternalModBreaks -> m (ForeignRef BreakArray)
    472 
    +getBreakArray interp BreakpointId{bi_tick_mod} imbs = do
    473 
    +
    474 
    +  liftIO $ modifyLoaderState interp $ \ld_st -> do
    475 
    +    let le = linker_env ld_st
    476 
    +
    477 
    +    -- Recall that BreakArrays are allocated only at BCO link time, so if we
    478 
    +    -- haven't linked the BCOs we intend to break at yet, we allocate the arrays here.
    479 
    +    ba_env <- allocateBreakArrays interp (breakarray_env le) [imbs]
    480 
    +
    481 
    +    return
    482 
    +      ( ld_st { linker_env = le{breakarray_env = ba_env} }
    483 
    +      , expectJust {- just computed -} $
    484 
    +        lookupModuleEnv ba_env bi_tick_mod
    485 
    +      )
    470 486
    471 487 
     back :: GhcMonad m => Int -> m ([Name], Int, SrcSpan)
    472 488 
     back n = moveHist (+n)
    ... ... @@ -496,7 +512,7 @@ moveHist fn = do
    496 512 
                           Nothing  -> return $ mkGeneralSrcSpan (fsLit "<unknown>")
    497 513 
                           Just ibi -> liftIO $ do
    498 514 
                             brks <- readModBreaks (hsc_HUG hsc_env) (ibi_tick_mod ibi)
    499 
    -                        return $ modBreaks_locs brks ! ibi_tick_index ibi
    515 
    +                        return $ getBreakLoc ibi brks
    500 516 
                 (hsc_env1, names) <-
    501 517 
                   liftIO $ bindLocalsAtBreakpoint hsc_env apStack span mb_info
    502 518 
                 let ic = hsc_IC hsc_env1
    ... ... @@ -559,9 +575,9 @@ bindLocalsAtBreakpoint hsc_env apStack_fhv span (Just ibi) = do
    559 575 
        let hug = hsc_HUG hsc_env
    560 576 
        info_brks <- readModBreaks hug (ibi_info_mod ibi)
    561 577 
        tick_brks <- readModBreaks hug (ibi_tick_mod ibi)
    562 
    -   let info   = expectJust $ IntMap.lookup (ibi_info_index ibi) (modBreaks_breakInfo info_brks)
    578 
    +   let info   = getInternalBreak ibi (info_brks)
    563 579 
            interp = hscInterp hsc_env
    564 
    -       occs   = modBreaks_vars tick_brks ! ibi_tick_index ibi
    580 
    +       occs   = getBreakVars ibi tick_brks
    565 581
    566 582 
       -- Rehydrate to understand the breakpoint info relative to the current environment.
    567 583 
       -- This design is critical to preventing leaks (#22530)

  • compiler/GHC/Runtime/Eval/Types.hs
    ... ... @@ -17,11 +17,11 @@ 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
    ... ... @@ -176,7 +176,7 @@ data Resume = Resume
    176 176 
            , resumeApStack   :: ForeignHValue -- The object from which we can get
    177 177 
                                             -- value of the free variables.
    178 178 
            , resumeBreakpointId :: Maybe InternalBreakpointId
    179 
    -                                        -- ^ the breakpoint we stopped at
    179 
    +                                        -- ^ the internal breakpoint we stopped at
    180 180 
                                             -- (Nothing <=> exception)
    181 181 
            , resumeSpan      :: SrcSpan     -- just a copy of the SrcSpan
    182 182 
                                             -- from the ModBreaks,

  • compiler/GHC/Runtime/Interpreter.hs
    ... ... @@ -74,9 +74,9 @@ import GHCi.Message
    74 74 
     import GHCi.RemoteTypes
    75 75 
     import GHCi.ResolvedBCO
    76 76 
     import GHCi.BreakArray (BreakArray)
    77 
    -import GHC.Types.Breakpoint
    78 
    -import GHC.ByteCode.Types
    77 
    +import GHC.ByteCode.Breakpoints
    79 78
    79 
    +import GHC.ByteCode.Types
    80 80 
     import GHC.Linker.Types
    81 81
    82 82 
     import GHC.Data.Maybe
    ... ... @@ -105,7 +105,6 @@ import Control.Monad.IO.Class
    105 105 
     import Control.Monad.Catch as MC (mask)
    106 106 
     import Data.Binary
    107 107 
     import Data.ByteString (ByteString)
    108 
    -import Data.Array ((!))
    109 108 
     import Foreign hiding (void)
    110 109 
     import qualified GHC.Exts.Heap as Heap
    111 110 
     import GHC.Stack.CCS (CostCentre,CostCentreStack)
    ... ... @@ -451,7 +450,7 @@ handleSeqHValueStatus interp unit_env eval_status =
    451 450 
                 -- Nothing case - should not occur! We should have the appropriate
    452 451 
                 -- breakpoint information
    453 452 
                 Nothing -> nothing_case
    454 
    -            Just modbreaks -> put $ brackets . ppr $ (modBreaks_locs modbreaks) ! ibi_tick_index bi
    453 
    +            Just modbreaks -> put $ brackets . ppr $ getBreakLoc bi modbreaks
    455 454
    456 455 
           -- resume the seq (:force) processing in the iserv process
    457 456 
           withForeignRef resume_ctxt_fhv $ \hval -> do
    ... ... @@ -737,7 +736,7 @@ wormholeRef interp _r = case interpInstance interp of
    737 736
    738 737 
     -- | Get the breakpoint information from the ByteCode object associated to this
    739 738 
     -- 'HomeModInfo'.
    740 
    -getModBreaks :: HomeModInfo -> Maybe ModBreaks
    739 
    +getModBreaks :: HomeModInfo -> Maybe InternalModBreaks
    741 740 
     getModBreaks hmi
    742 741 
       | Just linkable <- homeModInfoByteCode hmi,
    743 742 
         -- The linkable may have 'DotO's as well; only consider BCOs. See #20570.
    ... ... @@ -748,7 +747,7 @@ getModBreaks hmi
    748 747
    749 748 
     -- | Read the 'InternalModBreaks' and 'ModBreaks' of the given home 'Module'
    750 749 
     -- from the 'HomeUnitGraph'.
    751 
    -readModBreaks :: HomeUnitGraph -> Module -> IO ModBreaks
    750 
    +readModBreaks :: HomeUnitGraph -> Module -> IO InternalModBreaks
    752 751 
     readModBreaks hug modl = expectJust . getModBreaks . expectJust <$> HUG.lookupHugByModule modl hug
    753 752
    754 753 
     -- -----------------------------------------------------------------------------

  • compiler/GHC/StgToByteCode.hs
    ... ... @@ -34,7 +34,6 @@ import GHC.Platform.Profile
    34 34 
     import GHC.Runtime.Interpreter
    35 35 
     import GHCi.FFI
    36 36 
     import GHC.Types.Basic
    37 
    -import GHC.Types.Breakpoint
    38 37 
     import GHC.Utils.Outputable
    39 38 
     import GHC.Types.Name
    40 39 
     import GHC.Types.Id
    ... ... @@ -71,6 +70,7 @@ import GHC.Data.OrdList
    71 70 
     import GHC.Data.Maybe
    72 71 
     import GHC.Types.Tickish
    73 72 
     import GHC.Types.SptEntry
    73 
    +import GHC.ByteCode.Breakpoints
    74 74
    75 75 
     import Data.List ( genericReplicate, intersperse
    76 76 
                      , partition, scanl', sortBy, zip4, zip6 )
    ... ... @@ -134,9 +134,9 @@ byteCodeGen hsc_env this_mod binds tycs mb_modBreaks spt_entries
    134 134 
                "Proto-BCOs" FormatByteCode
    135 135 
                (vcat (intersperse (char ' ') (map ppr $ elemsFlatBag proto_bcos)))
    136 136
    137 
    -        let mod_breaks = case modBreaks of
    137 
    +        let mod_breaks = case mb_modBreaks of
    138 138 
                  Nothing -> Nothing
    139 
    -             Just mb -> Just mb{ modBreaks_breakInfo = breakInfo }
    139 
    +             Just mb -> Just $ mkInternalModBreaks this_mod breakInfo mb
    140 140 
             cbc <- assembleBCOs profile proto_bcos tycs strings mod_breaks spt_entries
    141 141
    142 142 
             -- Squash space leaks in the CompiledByteCode.  This is really
    ... ... @@ -405,7 +405,7 @@ schemeER_wrk d p (StgTick (Breakpoint tick_ty (BreakpointId tick_mod tick_no) fv
    405 405 
         Nothing -> pure code
    406 406 
         Just current_mod_breaks -> break_info hsc_env tick_mod current_mod mb_current_mod_breaks >>= \case
    407 407 
           Nothing -> pure code
    408 
    -      Just ModBreaks {modBreaks_module = tick_mod} -> do
    408 
    +      Just ModBreaks{modBreaks_module = tick_mod} -> do
    409 409 
             platform <- profilePlatform <$> getProfile
    410 410 
             let idOffSets = getVarOffSets platform d p fvs
    411 411 
                 ty_vars   = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
    ... ... @@ -416,12 +416,7 @@ schemeER_wrk d p (StgTick (Breakpoint tick_ty (BreakpointId tick_mod tick_no) fv
    416 416 
             let info_mod = modBreaks_module current_mod_breaks
    417 417 
             infox <- newBreakInfo breakInfo
    418 418
    419 
    -        let -- cast that checks that round-tripping through Word16 doesn't change the value
    420 
    -            toW16 x = let r = fromIntegral x :: Word16
    421 
    -                      in if fromIntegral r == x
    422 
    -                        then r
    423 
    -                        else pprPanic "schemeER_wrk: breakpoint tick/info index too large!" (ppr x)
    424 
    -            breakInstr = BRK_FUN tick_mod (toW16 tick_no) info_mod (toW16 infox)
    419 
    +        let breakInstr = BRK_FUN (InternalBreakpointId tick_mod tick_no info_mod infox)
    425 420 
             return $ breakInstr `consOL` code
    426 421 
     schemeER_wrk d p rhs = schemeE d 0 p rhs
    427 422
    ... ... @@ -455,7 +450,7 @@ break_info hsc_env mod current_mod current_mod_breaks
    455 450 
       = pure current_mod_breaks
    456 451 
       | otherwise
    457 452 
       = liftIO (HUG.lookupHugByModule mod (hsc_HUG hsc_env)) >>= \case
    458 
    -      Just hp -> pure $ getModBreaks hp
    453 
    +      Just hp -> pure $ imodBreaks_modBreaks <$> getModBreaks hp
    459 454 
           Nothing -> pure Nothing
    460 455
    461 456 
     getVarOffSets :: Platform -> StackDepth -> BCEnv -> [Id] -> [Maybe (Id, WordOff)]
    ... ... @@ -2659,20 +2654,19 @@ typeArgReps platform = map (toArgRep platform) . typePrimRep
    2659 2654 
     -- | Read only environment for generating ByteCode
    2660 2655 
     data BcM_Env
    2661 2656 
        = BcM_Env
    2662 
    -        { bcm_hsc_env    :: HscEnv
    2663 
    -        , bcm_module     :: Module -- current module (for breakpoints)
    2657 
    +        { bcm_hsc_env    :: !HscEnv
    2658 
    +        , bcm_module     :: !Module -- current module (for breakpoints)
    2659 
    +        , modBreaks      :: !(Maybe ModBreaks)
    2664 2660 
             }
    2665 2661
    2666 2662 
     data BcM_State
    2667 2663 
        = BcM_State
    2668 2664 
             { nextlabel      :: !Word32 -- ^ For generating local labels
    2669 2665 
             , breakInfoIdx   :: !Int    -- ^ Next index for breakInfo array
    2670 
    -        , modBreaks      :: Maybe ModBreaks -- info about breakpoints
    2671 
    -
    2672 
    -        , breakInfo      :: IntMap CgBreakInfo -- ^ Info at breakpoint occurrence.
    2673 
    -                                               -- Indexed with breakpoint *info* index.
    2674 
    -                                               -- See Note [Breakpoint identifiers]
    2675 
    -                                               -- in GHC.Types.Breakpoint
    2666 
    +        , breakInfo      :: !(IntMap CgBreakInfo)
    2667 
    +          -- ^ Info at breakpoints occurrences. Indexed with
    2668 
    +          -- 'InternalBreakpointId'. See Note [Breakpoint identifiers] in
    2669 
    +          -- GHC.ByteCode.Breakpoints.
    2676 2670 
             }
    2677 2671
    2678 2672 
     newtype BcM r = BcM (BcM_Env -> BcM_State -> IO (r, BcM_State))
    ... ... @@ -2681,7 +2675,7 @@ newtype BcM r = BcM (BcM_Env -> BcM_State -> IO (r, BcM_State))
    2681 2675
    2682 2676 
     runBc :: HscEnv -> Module -> Maybe ModBreaks -> BcM r -> IO (r, BcM_State)
    2683 2677 
     runBc hsc_env this_mod mbs (BcM m)
    2684 
    -   = m (BcM_Env hsc_env this_mod) (BcM_State 0 0 mbs IntMap.empty)
    2678 
    +   = m (BcM_Env hsc_env this_mod mbs) (BcM_State 0 0 IntMap.empty)
    2685 2679
    2686 2680 
     instance HasDynFlags BcM where
    2687 2681 
         getDynFlags = hsc_dflags <$> getHscEnv
    ... ... @@ -2724,7 +2718,7 @@ getCurrentModule :: BcM Module
    2724 2718 
     getCurrentModule = BcM $ \env st -> return (bcm_module env, st)
    2725 2719
    2726 2720 
     getCurrentModBreaks :: BcM (Maybe ModBreaks)
    2727 
    -getCurrentModBreaks = BcM $ \_env st -> return (modBreaks st, st)
    2721 
    +getCurrentModBreaks = BcM $ \env st -> return (modBreaks env, st)
    2728 2722
    2729 2723 
     tickFS :: FastString
    2730 2724 
     tickFS = fsLit "ticked"

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

  • compiler/GHC/Types/Tickish.hs
    ... ... @@ -21,17 +21,20 @@ 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
    32 36 
     import GHC.Unit.Module
    33 37
    34 
    -import GHC.Types.Breakpoint
    35 38 
     import GHC.Types.CostCentre
    36 39 
     import GHC.Types.SrcLoc ( RealSrcSpan, containsSpan )
    37 40 
     import GHC.Types.Var
    ... ... @@ -41,7 +44,7 @@ import GHC.Utils.Panic
    41 44 
     import Language.Haskell.Syntax.Extension ( NoExtField )
    42 45
    43 46 
     import Data.Data
    44 
    -import GHC.Utils.Outputable (Outputable (ppr), text)
    47 
    +import GHC.Utils.Outputable (Outputable (ppr), text, (<+>))
    45 48
    46 49 
     {- *********************************************************************
    47 50 
     *                                                                      *
    ... ... @@ -171,6 +174,35 @@ 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 
    +-- newtype BreakTickIndex = BreakTickIndex Int
    183 
    +--   deriving (Eq, Ord, Data, Ix, NFData, Outputable)
    184 
    +type BreakTickIndex = Int
    185 
    +
    186 
    +-- | Breakpoint identifier.
    187 
    +--
    188 
    +-- Indexes into the structures in the @'ModBreaks'@ created during desugaring
    189 
    +-- (after inserting the breakpoint ticks in the expressions).
    190 
    +-- See Note [Breakpoint identifiers]
    191 
    +data BreakpointId = BreakpointId
    192 
    +  { bi_tick_mod   :: !Module         -- ^ Breakpoint tick module
    193 
    +  , bi_tick_index :: !BreakTickIndex -- ^ Breakpoint tick index
    194 
    +  }
    195 
    +  deriving (Eq, Ord, Data)
    196 
    +
    197 
    +instance Outputable BreakpointId where
    198 
    +  ppr BreakpointId{bi_tick_mod, bi_tick_index} =
    199 
    +    text "BreakpointId" <+> ppr bi_tick_mod <+> ppr bi_tick_index
    200 
    +
    201 
    +instance NFData BreakpointId where
    202 
    +  rnf BreakpointId{bi_tick_mod, bi_tick_index} =
    203 
    +    rnf bi_tick_mod `seq` rnf bi_tick_index
    204 
    +
    205 
    +--------------------------------------------------------------------------------
    174 206
    175 207 
     -- | A "counting tick" (where tickishCounts is True) is one that
    176 208 
     -- counts evaluations in some way.  We cannot discard a counting tick,

  • 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

  • ghc/GHCi/UI.hs
    ... ... @@ -45,6 +45,7 @@ import GHC.Runtime.Eval (mkTopLevEnv)
    45 45 
     import GHC.Runtime.Eval.Utils
    46 46
    47 47 
     -- The GHC interface
    48 
    +import GHC.ByteCode.Breakpoints (imodBreaks_modBreaks)
    48 49 
     import GHC.Runtime.Interpreter
    49 50 
     import GHCi.RemoteTypes
    50 51 
     import GHCi.BreakArray( breakOn, breakOff )
    ... ... @@ -66,7 +67,8 @@ import qualified GHC
    66 67 
     import GHC ( LoadHowMuch(..), Target(..),  TargetId(..),
    67 68 
                  Resume, SingleStep, Ghc,
    68 69 
                  GetDocsFailure(..), pushLogHookM,
    69 
    -             getModuleGraph, handleSourceError )
    70 
    +             getModuleGraph, handleSourceError,
    71 
    +             InternalBreakpointId(..) )
    70 72 
     import GHC.Driver.Main (hscParseModuleWithLocation, hscParseStmtWithLocation)
    71 73 
     import GHC.Hs.ImpExp
    72 74 
     import GHC.Hs
    ... ... @@ -78,7 +80,6 @@ import GHC.Core.TyCo.Ppr
    78 80 
     import GHC.Types.SafeHaskell ( getSafeMode )
    79 81 
     import GHC.Types.SourceError ( SourceError )
    80 82 
     import GHC.Types.Name
    81 
    -import GHC.Types.Breakpoint
    82 83 
     import GHC.Types.Var ( varType )
    83 84 
     import GHC.Iface.Syntax ( showToHeader )
    84 85 
     import GHC.Builtin.Names
    ... ... @@ -4473,7 +4474,7 @@ breakById inp = do
    4473 4474 
         Left sdoc -> printForUser sdoc
    4474 4475 
         Right (mod, mod_info, fun_str) -> do
    4475 4476 
           let modBreaks = expectJust (GHC.modInfoModBreaks mod_info)
    4476 
    -      findBreakAndSet mod $ \_ -> findBreakForBind fun_str modBreaks
    4477 
    +      findBreakAndSet mod $ \_ -> findBreakForBind fun_str (imodBreaks_modBreaks modBreaks)
    4477 4478
    4478 4479 
     breakSyntax :: a
    4479 4480 
     breakSyntax = throwGhcException $ CmdLineError ("Syntax: :break [<mod>.]<func>[.<func>]\n"

  • testsuite/tests/count-deps/CountDepsAst.stdout
    ... ... @@ -5,6 +5,7 @@ GHC.Builtin.Types
    5 5 
     GHC.Builtin.Types.Literals
    6 6 
     GHC.Builtin.Types.Prim
    7 7 
     GHC.Builtin.Uniques
    8 
    +GHC.ByteCode.Breakpoints
    8 9 
     GHC.ByteCode.Types
    9 10 
     GHC.Cmm.BlockId
    10 11 
     GHC.Cmm.CLabel
    ... ... @@ -110,6 +111,8 @@ GHC.Hs.Pat
    110 111 
     GHC.Hs.Specificity
    111 112 
     GHC.Hs.Type
    112 113 
     GHC.Hs.Utils
    114 
    +GHC.HsToCore.Breakpoints
    115 
    +GHC.HsToCore.Ticks
    113 116 
     GHC.Iface.Errors.Types
    114 117 
     GHC.Iface.Ext.Fields
    115 118 
     GHC.Iface.Flags
    ... ... @@ -150,7 +153,6 @@ GHC.Tc.Zonk.Monad
    150 153 
     GHC.Types.Annotations
    151 154 
     GHC.Types.Avail
    152 155 
     GHC.Types.Basic
    153 
    -GHC.Types.Breakpoint
    154 156 
     GHC.Types.CostCentre
    155 157 
     GHC.Types.CostCentre.State
    156 158 
     GHC.Types.Cpr

  • testsuite/tests/count-deps/CountDepsParser.stdout
    ... ... @@ -5,6 +5,7 @@ GHC.Builtin.Types
    5 5 
     GHC.Builtin.Types.Literals
    6 6 
     GHC.Builtin.Types.Prim
    7 7 
     GHC.Builtin.Uniques
    8 
    +GHC.ByteCode.Breakpoints
    8 9 
     GHC.ByteCode.Types
    9 10 
     GHC.Cmm.BlockId
    10 11 
     GHC.Cmm.CLabel
    ... ... @@ -114,8 +115,10 @@ GHC.Hs.Pat
    114 115 
     GHC.Hs.Specificity
    115 116 
     GHC.Hs.Type
    116 117 
     GHC.Hs.Utils
    118 
    +GHC.HsToCore.Breakpoints
    117 119 
     GHC.HsToCore.Errors.Types
    118 120 
     GHC.HsToCore.Pmc.Solver.Types
    121 
    +GHC.HsToCore.Ticks
    119 122 
     GHC.Iface.Errors.Types
    120 123 
     GHC.Iface.Ext.Fields
    121 124 
     GHC.Iface.Flags
    ... ... @@ -171,7 +174,6 @@ GHC.Tc.Zonk.Monad
    171 174 
     GHC.Types.Annotations
    172 175 
     GHC.Types.Avail
    173 176 
     GHC.Types.Basic
    174 
    -GHC.Types.Breakpoint
    175 177 
     GHC.Types.CompleteMatch
    176 178 
     GHC.Types.CostCentre
    177 179 
     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