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

Commits:

23 changed files:

Changes:

  • compiler/GHC/ByteCode/Asm.hs
    ... ... @@ -841,19 +841,14 @@ 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 ibi@(InternalBreakpointId info_mod infox) -> do
    845 
    +    p1 <- ptr $ BCOPtrBreakArray info_mod
    846 
    +    info_addr <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName info_mod
    847 
    +    info_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS $ moduleUnitId info_mod
    848 
    +    info_wix <- int infox
    849 
    +    np <- lit1 $ BCONPtrCostCentre ibi
    850 
    +    emit_ bci_BRK_FUN [ Op p1, Op info_addr, Op info_unitid_addr
    851 
    +                      , Op info_wix, Op np ]
    857 852
    858 853 
       BRK_ALTS active -> emit_ bci_BRK_ALTS [SmallOp active]
    859 854

  • compiler/GHC/ByteCode/Breakpoints.hs
    ... ... @@ -7,7 +7,7 @@
    7 7 
     -- 'InternalModBreaks', and is uniquely identified at runtime by an
    8 8 
     -- 'InternalBreakpointId'.
    9 9 
     --
    10 
    --- See Note [Breakpoint identifiers]
    10 
    +-- See Note [ModBreaks vs InternalModBreaks] and Note [Breakpoint identifiers]
    11 11 
     module GHC.ByteCode.Breakpoints
    12 12 
       ( -- * Internal Mod Breaks
    13 13 
         InternalModBreaks(..), CgBreakInfo(..)
    ... ... @@ -17,7 +17,6 @@ module GHC.ByteCode.Breakpoints
    17 17 
       , InternalBreakpointId(..), BreakInfoIndex
    18 18
    19 19 
         -- * Operations
    20 
    -  , toBreakpointId
    21 20
    22 21 
         -- ** Internal-level operations
    23 22 
       , getInternalBreak, addInternalBreak
    ... ... @@ -47,6 +46,31 @@ import GHC.Utils.Panic
    47 46 
     import Data.Array
    48 47
    49 48 
     {-
    49 
    +Note [ModBreaks vs InternalModBreaks]
    50 
    +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    51 
    +'ModBreaks' and 'BreakpointId's must not to be confused with
    52 
    +'InternalModBreaks' and 'InternalBreakId's.
    53 
    +
    54 
    +'ModBreaks' is constructed once during HsToCore from the information attached
    55 
    +to source-level breakpoint ticks and is never changed afterwards. A 'ModBreaks'
    56 
    +can be queried using 'BreakpointId's, which uniquely identifies a breakpoint
    57 
    +within the list of breakpoint information for a given module's 'ModBreaks'.
    58 
    +
    59 
    +'InternalModBreaks' are constructed during bytecode generation and are indexed
    60 
    +by a 'InternalBreakpointId'. They contain all the information relevant to a
    61 
    +breakpoint for code generation that can be accessed during runtime execution
    62 
    +(such as a 'BreakArray' for triggering breakpoints). 'InternalBreakpointId's
    63 
    +are used at runtime to trigger and inspect breakpoints -- a 'BRK_FUN'
    64 
    +instruction receives 'InternalBreakpointId' as an argument.
    65 
    +
    66 
    +We keep a mapping from 'InternalModBreaks' to a 'BreakpointId', which can then be used
    67 
    +to get source-level information about a breakpoint via the corresponding 'ModBreaks'.
    68 
    +
    69 
    +Notably, 'InternalModBreaks' can contain entries for so-called internal
    70 
    +breakpoints, which do not necessarily have a source-level location attached to
    71 
    +it (i.e. do not have a matching entry in 'ModBreaks'). We may leverage this to
    72 
    +introduce breakpoints during code generation for features such as stepping-out.
    73 
    +
    50 74 
     Note [Breakpoint identifiers]
    51 75 
     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    52 76 
     Before optimization a breakpoint is identified uniquely with a tick module
    ... ... @@ -64,6 +88,10 @@ So every breakpoint occurrence gets assigned a module-unique *info index* and
    64 88 
     we store it alongside the occurrence module (*info module*) in the
    65 89 
     'InternalBreakpointId' datatype. This is the index that we use at runtime to
    66 90 
     identify a breakpoint.
    91 
    +
    92 
    +When the internal breakpoint has a matching tick-level breakpoint we can fetch
    93 
    +the related tick-level information by first looking up a mapping
    94 
    +@'InternalBreakpointId' -> 'BreakpointId'@. See `internalBreakIdToBreakId`
    67 95 
     -}
    68 96
    69 97 
     --------------------------------------------------------------------------------
    ... ... @@ -78,19 +106,11 @@ type BreakInfoIndex = Int
    78 106 
     -- Indexes into the structures in the @'InternalModBreaks'@ produced during ByteCode generation.
    79 107 
     -- See Note [Breakpoint identifiers]
    80 108 
     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
    109 
    +  { ibi_info_mod   :: !Module         -- ^ Breakpoint tick module
    84 110 
       , ibi_info_index :: !BreakInfoIndex -- ^ Breakpoint tick index
    85 111 
       }
    86 112 
       deriving (Eq, Ord)
    87 113
    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 114 
     --------------------------------------------------------------------------------
    95 115 
     -- * Internal Mod Breaks
    96 116 
     --------------------------------------------------------------------------------
    ... ... @@ -128,20 +148,23 @@ data CgBreakInfo
    128 148 
        { cgb_tyvars  :: ![IfaceTvBndr] -- ^ Type variables in scope at the breakpoint
    129 149 
        , cgb_vars    :: ![Maybe (IfaceIdBndr, Word)]
    130 150 
        , cgb_resty   :: !IfaceType
    151 
    +   , cgb_tick_id :: !BreakpointId
    152 
    +     -- ^ This field records the original breakpoint tick identifier for this
    153 
    +     -- internal breakpoint info. See Note [Breakpoint identifiers].
    131 154 
        }
    132 155 
     -- See Note [Syncing breakpoint info] in GHC.Runtime.Eval
    133 156
    134 157 
     -- | Get an internal breakpoint info by 'InternalBreakpointId'
    135 158 
     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
    159 
    +getInternalBreak (InternalBreakpointId mod ix) imbs =
    160 
    +  assert_modules_match mod (imodBreaks_module imbs) $
    161 
    +    imodBreaks_breakInfo imbs IM.! ix
    139 162
    140 163 
     -- | Add a CgBreakInfo to an 'InternalModBreaks' at 'InternalBreakpointId'
    141 164 
     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)}
    165 
    +addInternalBreak (InternalBreakpointId mod ix) info imbs =
    166 
    +  assert_modules_match mod (imodBreaks_module imbs) $
    167 
    +    imbs{imodBreaks_breakInfo = IM.insert ix info (imodBreaks_breakInfo imbs)}
    145 168
    146 169 
     -- | Assert that the module in the 'InternalBreakpointId' and in
    147 170 
     -- 'InternalModBreaks' match.
    ... ... @@ -156,26 +179,28 @@ assert_modules_match ibi_mod imbs_mod =
    156 179 
     --------------------------------------------------------------------------------
    157 180
    158 181 
     -- | Get the source span for this breakpoint
    159 
    -getBreakLoc  :: InternalBreakpointId -> InternalModBreaks -> SrcSpan
    182 
    +getBreakLoc  :: InternalBreakpointId -> InternalModBreaks -> Maybe SrcSpan
    160 183 
     getBreakLoc = getBreakXXX modBreaks_locs
    161 184
    162 185 
     -- | Get the vars for this breakpoint
    163 
    -getBreakVars  :: InternalBreakpointId -> InternalModBreaks -> [OccName]
    186 
    +getBreakVars  :: InternalBreakpointId -> InternalModBreaks -> Maybe [OccName]
    164 187 
     getBreakVars = getBreakXXX modBreaks_vars
    165 188
    166 189 
     -- | Get the decls for this breakpoint
    167 
    -getBreakDecls :: InternalBreakpointId -> InternalModBreaks -> [String]
    190 
    +getBreakDecls :: InternalBreakpointId -> InternalModBreaks -> Maybe [String]
    168 191 
     getBreakDecls = getBreakXXX modBreaks_decls
    169 192
    170 193 
     -- | Get the decls for this breakpoint
    171 
    -getBreakCCS :: InternalBreakpointId -> InternalModBreaks -> (String, String)
    194 
    +getBreakCCS :: InternalBreakpointId -> InternalModBreaks -> Maybe (String, String)
    172 195 
     getBreakCCS = getBreakXXX modBreaks_ccs
    173 196
    174 197 
     -- | 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
    198 
    +getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> InternalBreakpointId -> InternalModBreaks -> Maybe a
    199 
    +getBreakXXX view (InternalBreakpointId ibi_mod ibi_ix) imbs =
    200 
    +  assert_modules_match ibi_mod (imodBreaks_module imbs) $ do
    201 
    +    let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
    202 
    +    mbs <- imodBreaks_modBreaks imbs
    203 
    +    Just $ view mbs ! bi_tick_index (cgb_tick_id cgb)
    179 204
    180 205 
     --------------------------------------------------------------------------------
    181 206 
     -- Instances
    ... ... @@ -190,7 +215,8 @@ seqInternalModBreaks InternalModBreaks{..} =
    190 215 
         seqCgBreakInfo CgBreakInfo{..} =
    191 216 
             rnf cgb_tyvars `seq`
    192 217 
             rnf cgb_vars `seq`
    193 
    -        rnf cgb_resty
    218 
    +        rnf cgb_resty `seq`
    219 
    +        rnf cgb_tick_id
    194 220
    195 221 
     instance Outputable InternalBreakpointId where
    196 222 
       ppr InternalBreakpointId{..} =
    ... ... @@ -203,4 +229,5 @@ instance NFData InternalBreakpointId where
    203 229 
     instance Outputable CgBreakInfo where
    204 230 
        ppr info = text "CgBreakInfo" <+>
    205 231 
                   parens (ppr (cgb_vars info) <+>
    206 
    -                      ppr (cgb_resty info))
    232 
    +                      ppr (cgb_resty info) <+>
    233 
    +                      ppr (cgb_tick_id 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,9 @@ 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 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 info_mod <+> ppr infox
    465 460 
                                    <+> text "<cc>"
    466 461 
        ppr (BRK_ALTS active)     = text "BRK_ALTS" <+> ppr active
    467 462 
     #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 InternalBreakpointId{..}
    101 
    +    | interpreterProfiled interp -> do
    102 
    +        case expectJust (lookupModuleEnv (ccs_env le) ibi_info_mod) ! ibi_info_index of
    103 103 
               RemotePtr p -> pure $ fromIntegral p
    104 104 
         | otherwise ->
    105 105 
             case toRemotePtr nullPtr of

  • compiler/GHC/ByteCode/Types.hs
    ... ... @@ -284,8 +284,8 @@ data BCONPtr
    284 284 
       | BCONPtrFS    !FastString
    285 285 
       -- | A libffi ffi_cif function prototype.
    286 286 
       | BCONPtrFFIInfo !FFIInfo
    287 
    -  -- | A 'CostCentre' remote pointer array's respective 'Module' and index
    288 
    -  | BCONPtrCostCentre !Module !BreakTickIndex
    287 
    +  -- | A 'CostCentre' remote pointer array's respective 'BreakpointId'
    288 
    +  | BCONPtrCostCentre !BreakpointId
    289 289
    290 290 
     instance NFData BCONPtr where
    291 291 
       rnf x = x `seq` ()

  • compiler/GHC/CoreToIface.hs
    ... ... @@ -704,12 +704,13 @@ toIfaceLFInfo nm lfi = case lfi of
    704 704
    705 705 
     -- Dehydrating CgBreakInfo
    706 706
    707 
    -dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> CgBreakInfo
    708 
    -dehydrateCgBreakInfo ty_vars idOffSets tick_ty =
    707 
    +dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> BreakpointId -> CgBreakInfo
    708 
    +dehydrateCgBreakInfo ty_vars idOffSets tick_ty bid =
    709 709 
               CgBreakInfo
    710 710 
                 { cgb_tyvars = map toIfaceTvBndr ty_vars
    711 711 
                 , cgb_vars = map (fmap (\(i, offset) -> (toIfaceIdBndr i, offset))) idOffSets
    712 712 
                 , cgb_resty = toIfaceType tick_ty
    713 
    +            , cgb_tick_id = bid
    713 714 
                 }
    714 715
    715 716 
     {- Note [Inlining and hs-boot files]

  • 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
    ... ... @@ -12,7 +12,7 @@
    12 12 
     -- 'InternalModBreaks' and 'InternalBreakId's. The latter are constructed
    13 13 
     -- during bytecode generation and can be found in 'GHC.ByteCode.Breakpoints'.
    14 14 
     --
    15 
    --- See Note [Breakpoint identifiers]
    15 
    +-- See Note [ModBreaks vs InternalModBreaks] and Note [Breakpoint identifiers]
    16 16 
     module GHC.HsToCore.Breakpoints
    17 17 
       ( -- * ModBreaks
    18 18 
         mkModBreaks, ModBreaks(..)
    ... ... @@ -33,14 +33,6 @@ import GHC.Unit.Module (Module)
    33 33 
     import GHC.Utils.Outputable
    34 34 
     import Data.List (intersperse)
    35 35
    36 
    -import GHCi.BreakArray (BreakArray)
    37 
    -import GHCi.RemoteTypes (ForeignRef)
    38 
    -
    39 
    --- TODO: Break this cycle
    40 
    -import {-# SOURCE #-} GHC.Runtime.Interpreter.Types (Interp, interpreterProfiled)
    41 
    -import {-# SOURCE #-} qualified GHC.Runtime.Interpreter as GHCi (newBreakArray)
    42 
    -import Data.Array.Base (numElements)
    43 
    -
    44 36 
     --------------------------------------------------------------------------------
    45 37 
     -- ModBreaks
    46 38 
     --------------------------------------------------------------------------------
    ... ... @@ -58,10 +50,7 @@ import Data.Array.Base (numElements)
    58 50 
     -- and 'modBreaks_decls'.
    59 51 
     data ModBreaks
    60 52 
        = ModBreaks
    61 
    -   { modBreaks_flags  :: ForeignRef BreakArray
    62 
    -        -- ^ The array of flags, one per breakpoint,
    63 
    -        -- indicating which breakpoints are enabled.
    64 
    -   , modBreaks_locs   :: !(Array BreakTickIndex SrcSpan)
    53 
    +   { modBreaks_locs   :: !(Array BreakTickIndex SrcSpan)
    65 54 
             -- ^ An array giving the source span of each breakpoint.
    66 55 
        , modBreaks_vars   :: !(Array BreakTickIndex [OccName])
    67 56 
             -- ^ An array giving the names of the free variables at each breakpoint.
    ... ... @@ -83,40 +72,31 @@ data ModBreaks
    83 72 
     -- generator needs to encode this information for each expression, the data is
    84 73 
     -- allocated remotely in GHCi's address space and passed to the codegen as
    85 74 
     -- foreign pointers.
    86 
    -mkModBreaks :: Interp -> Module -> SizedSeq Tick -> IO ModBreaks
    87 
    -mkModBreaks interp mod extendedMixEntries
    88 
    -  = do
    89 
    -    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
    90 79 
             entries = ssElts extendedMixEntries
    91 
    -    let
    92 
    -           locsTicks  = listArray (0,count-1) [ tick_loc  t | t <- entries ]
    93 
    -           varsTicks  = listArray (0,count-1) [ tick_ids  t | t <- entries ]
    94 
    -           declsTicks = listArray (0,count-1) [ tick_path t | t <- entries ]
    95 
    -           ccs
    96 
    -             | interpreterProfiled interp =
    97 
    -                 listArray
    98 
    -                   (0, count - 1)
    99 
    -                   [ ( concat $ intersperse "." $ tick_path t,
    100 
    -                       renderWithContext defaultSDocContext $ ppr $ tick_loc t
    101 
    -                     )
    102 
    -                   | t <- entries
    103 
    -                   ]
    104 
    -             | otherwise = listArray (0, -1) []
    105 
    -    hydrateModBreaks interp $
    106 
    -      ModBreaks
    107 
    -        { modBreaks_flags = undefined,
    108 
    -          modBreaks_locs = locsTicks,
    109 
    -          modBreaks_vars = varsTicks,
    110 
    -          modBreaks_decls = declsTicks,
    111 
    -          modBreaks_ccs = ccs,
    112 
    -          modBreaks_module = mod
    113 
    -        }
    114 
    -
    115 
    -hydrateModBreaks :: Interp -> ModBreaks -> IO ModBreaks
    116 
    -hydrateModBreaks interp ModBreaks {..} = do
    117 
    -  let count = numElements modBreaks_locs
    118 
    -  modBreaks_flags <- GHCi.newBreakArray interp count
    119 
    -  pure ModBreaks {..}
    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 
    +      }
    120 100
    121 101 
     {-
    122 102 
     Note [Field modBreaks_decls]

  • 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,6 +123,11 @@ 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
    126 
    +import GHC.HsToCore.Breakpoints
    127 
    +import qualified Data.IntMap.Strict as IM
    128 
    +import qualified GHC.Runtime.Interpreter as GHCi
    129 
    +import GHC.Data.Maybe (expectJust)
    130 
    +import Foreign.Ptr (nullPtr)
    125 131
    126 132
    127 133
    ... ... @@ -699,13 +705,13 @@ loadDecls interp hsc_env span linkable = do
    699 705 
               le2_breakarray_env <-
    700 706 
                 allocateBreakArrays
    701 707 
                   interp
    702 
    -              (catMaybes $ map bc_breaks cbcs)
    703 708 
                   (breakarray_env le)
    709 
    +              (map bc_breaks cbcs)
    704 710 
               le2_ccs_env <-
    705 711 
                 allocateCCS
    706 712 
                   interp
    707 
    -              (catMaybes $ map bc_breaks cbcs)
    708 713 
                   (ccs_env le)
    714 
    +              (map bc_breaks cbcs)
    709 715 
               let le2 = le { itbl_env = le2_itbl_env
    710 716 
                            , addr_env = le2_addr_env
    711 717 
                            , breakarray_env = le2_breakarray_env
    ... ... @@ -933,12 +939,8 @@ dynLinkBCOs interp pls bcos = do
    933 939 
                 le1 = linker_env pls
    934 940 
             ie2 <- linkITbls interp (itbl_env le1) (concatMap bc_itbls cbcs)
    935 941 
             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)
    942 
    +        be2 <- allocateBreakArrays interp (breakarray_env le1) (map bc_breaks cbcs)
    943 
    +        ce2 <- allocateCCS         interp (ccs_env le1)        (map bc_breaks cbcs)
    942 944 
             let le2 = le1 { itbl_env = ie2, addr_env = ae2, breakarray_env = be2, ccs_env = ce2 }
    943 945
    944 946 
             names_and_refs <- linkSomeBCOs interp (pkgs_loaded pls) le2 cbcs
    ... ... @@ -1656,44 +1658,80 @@ allocateTopStrings interp topStrings prev_env = do
    1656 1658 
       where
    1657 1659 
         mk_entry nm ptr = (nm, (nm, AddrPtr ptr))
    1658 1660
    1659 
    --- | Given a list of 'ModBreaks' collected from a list of
    1660 
    --- 'CompiledByteCode', allocate the 'BreakArray'.
    1661 
    +-- | Given a list of 'InternalModBreaks and 'ModBreaks' collected from a list of
    1662 
    +-- 'CompiledByteCode', allocate the 'BreakArray' used to trigger breakpoints.
    1661 1663 
     allocateBreakArrays ::
    1662 1664 
       Interp ->
    1663 
    -  [InternalModBreaks] ->
    1664 1665 
       ModuleEnv (ForeignRef BreakArray) ->
    1666 
    +  [InternalModBreaks] ->
    1665 1667 
       IO (ModuleEnv (ForeignRef BreakArray))
    1666 
    -allocateBreakArrays _interp mbs be =
    1668 
    +allocateBreakArrays interp =
    1667 1669 
       foldlM
    1668 
    -    ( \be0 InternalModBreaks{imodBreaks_modBreaks=ModBreaks {..}} ->
    1669 
    -        evaluate $ extendModuleEnv be0 modBreaks_module modBreaks_flags
    1670 
    +    ( \be0 imbs -> do
    1671 
    +        let bi = imodBreaks_breakInfo imbs
    1672 
    +            hi = maybe 0 fst (IM.lookupMax bi) -- allocate as many slots as internal breakpoints
    1673 
    +        if not $ elemModuleEnv (imodBreaks_module imbs) be0 then do
    1674 
    +          -- If no BreakArray is assigned to this module yet, create one
    1675 
    +          breakArray <- GHCi.newBreakArray interp hi
    1676 
    +          evaluate $ extendModuleEnv be0 (imodBreaks_module imbs) breakArray
    1677 
    +        else
    1678 
    +          return be0
    1670 1679 
         )
    1671 
    -    be
    1672 
    -    mbs
    1673 1680
    1674 
    --- | Given a list of 'ModBreaks' collected from a list of
    1675 
    --- 'CompiledByteCode', allocate the 'CostCentre' arrays when profiling
    1676 
    --- is enabled.
    1681 
    +-- | Given a list of 'InternalModBreaks' and 'ModBreaks' collected from a list
    1682 
    +-- of 'CompiledByteCode', allocate the 'CostCentre' arrays when profiling is
    1683 
    +-- enabled.
    1684 
    +--
    1685 
    +-- Note that the resulting CostCenter is indexed by the 'InternalBreakpointId',
    1686 
    +-- not by 'BreakpointId'. At runtime, BRK_FUN instructions are annotated with
    1687 
    +-- internal ids -- we'll look them up in the array and push the corresponding
    1688 
    +-- cost center.
    1677 1689 
     allocateCCS ::
    1678 1690 
       Interp ->
    1679 
    -  [InternalModBreaks] ->
    1680 1691 
       ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre)) ->
    1692 
    +  [InternalModBreaks] ->
    1681 1693 
       IO (ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre)))
    1682 
    -allocateCCS interp mbs ce
    1683 
    -  | interpreterProfiled interp =
    1694 
    +allocateCCS interp ce mbss
    1695 
    +  | interpreterProfiled interp = do
    1696 
    +      -- First construct the CCSs for each module, using the 'ModBreaks'
    1697 
    +      ccs_map <- foldlM
    1698 
    +        ( \(ccs_map :: ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre))) imbs -> do
    1699 
    +          case imodBreaks_modBreaks imbs of
    1700 
    +            Nothing -> return ccs_map -- don't add it
    1701 
    +            Just mbs -> do
    1702 
    +              ccs <-
    1703 
    +                mkCostCentres
    1704 
    +                  interp
    1705 
    +                  (moduleNameString $ moduleName $ modBreaks_module mbs)
    1706 
    +                  (elems $ modBreaks_ccs mbs)
    1707 
    +              evaluate $
    1708 
    +                extendModuleEnv ccs_map (modBreaks_module mbs) $
    1709 
    +                  listArray (0, length ccs - 1) ccs
    1710 
    +        ) emptyModuleEnv mbss
    1711 
    +      -- Now, construct an array indexed by an 'InternalBreakpointId' index by first
    1712 
    +      -- finding the matching 'BreakpointId' and then looking it up in the ccs_map
    1684 1713 
           foldlM
    1685 
    -        ( \ce0 InternalModBreaks{imodBreaks_modBreaks=ModBreaks {..}} -> do
    1686 
    -            ccs <-
    1687 
    -              mkCostCentres
    1688 
    -                interp
    1689 
    -                (moduleNameString $ moduleName modBreaks_module)
    1690 
    -                (elems modBreaks_ccs)
    1714 
    +        ( \ce0 imbs -> do
    1715 
    +          let breakModl    = imodBreaks_module imbs
    1716 
    +              breakInfoMap = imodBreaks_breakInfo imbs
    1717 
    +              hi           = maybe 0 fst (IM.lookupMax breakInfoMap) -- as many slots as internal breaks
    1718 
    +              ccss         = expectJust $ lookupModuleEnv ccs_map breakModl
    1719 
    +          ccs_im <- foldlM
    1720 
    +            (\(bids :: IM.IntMap (RemotePtr CostCentre)) cgi -> do
    1721 
    +              let tickBreakId = bi_tick_index $ cgb_tick_id cgi
    1722 
    +              pure $ IM.insert tickBreakId (ccss ! tickBreakId) bids
    1723 
    +            ) mempty breakInfoMap
    1724 
    +          if not $ elemModuleEnv breakModl ce0 then do
    1691 1725 
                 evaluate $
    1692 
    -              extendModuleEnv ce0 modBreaks_module $
    1693 
    -                listArray
    1694 
    -                  (0, length ccs - 1)
    1695 
    -                  ccs
    1726 
    +              extendModuleEnv ce0 breakModl $
    1727 
    +                listArray (0, hi-1) $
    1728 
    +                  map (\i -> case IM.lookup i ccs_im of
    1729 
    +                        Nothing -> toRemotePtr nullPtr
    1730 
    +                        Just ccs -> ccs
    1731 
    +                      ) [0..hi-1]
    1732 
    +          else
    1733 
    +            return ce0
    1696 1734 
             )
    1697 1735 
             ce
    1698 
    -        mbs
    1736 
    +        mbss
    1699 1737 
       | otherwise = pure ce

  • compiler/GHC/Linker/Types.hs
    ... ... @@ -72,6 +72,7 @@ import GHC.Unit.Module.WholeCoreBindings
    72 72 
     import Data.Maybe (mapMaybe)
    73 73 
     import Data.List.NonEmpty (NonEmpty, nonEmpty)
    74 74 
     import qualified Data.List.NonEmpty as NE
    75 
    +import GHC.HsToCore.Breakpoints (BreakTickIndex)
    75 76
    76 77
    77 78 
     {- **********************************************************************

  • compiler/GHC/Runtime/Debugger/Breakpoints.hs
    ... ... @@ -197,7 +197,7 @@ type TickArray = Array Int [(BreakTickIndex,RealSrcSpan)]
    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 . imodBreaks_modBreaks <$> (modInfoModBreaks =<< mi)
    200 
    +  return $ mkTickArray . assocs . modBreaks_locs <$> (imodBreaks_modBreaks =<< modInfoModBreaks =<< mi)
    201 201 
       where
    202 202 
         mkTickArray :: [(BreakTickIndex, SrcSpan)] -> TickArray
    203 203 
         mkTickArray ticks
    ... ... @@ -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 $ imodBreaks_modBreaks <$> modInfoModBreaks mod_info
    214 
    +   pure $ imodBreaks_modBreaks =<< modInfoModBreaks mod_info
    215 215
    216 216 
     --------------------------------------------------------------------------------
    217 217 
     -- Getting current breakpoint information
    ... ... @@ -238,6 +238,6 @@ getCurrentBreakModule = do
    238 238 
       return $ case resumes of
    239 239 
         [] -> Nothing
    240 240 
         (r:_) -> case resumeHistoryIx r of
    241 
    -      0  -> ibi_tick_mod <$> resumeBreakpointId r
    241 
    +      0  -> ibi_info_mod <$> resumeBreakpointId r
    242 242 
           ix -> Just $ getHistoryModule $ resumeHistory r !! (ix-1)
    243 243

  • 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
    ... ... @@ -126,6 +127,7 @@ import GHC.Tc.Utils.Instantiate (instDFunType)
    126 127 
     import GHC.Tc.Utils.Monad
    127 128
    128 129 
     import GHC.IfaceToCore
    130 
    +import GHC.ByteCode.Breakpoints
    129 131
    130 132 
     import Control.Monad
    131 133 
     import Data.Dynamic
    ... ... @@ -134,7 +136,7 @@ import Data.List (find,intercalate)
    134 136 
     import Data.List.NonEmpty (NonEmpty)
    135 137 
     import Unsafe.Coerce ( unsafeCoerce )
    136 138 
     import qualified GHC.Unit.Home.Graph as HUG
    137 
    -import GHC.ByteCode.Breakpoints
    139 
    +import GHCi.BreakArray (BreakArray)
    138 140
    139 141 
     -- -----------------------------------------------------------------------------
    140 142 
     -- running a statement interactively
    ... ... @@ -146,13 +148,13 @@ mkHistory :: HUG.HomeUnitGraph -> ForeignHValue -> InternalBreakpointId -> IO Hi
    146 148 
     mkHistory hug hval ibi = History hval ibi <$> findEnclosingDecls hug ibi
    147 149
    148 150 
     getHistoryModule :: History -> Module
    149 
    -getHistoryModule = ibi_tick_mod . historyBreakpointId
    151 
    +getHistoryModule = ibi_info_mod . historyBreakpointId
    150 152
    151 153 
     getHistorySpan :: HUG.HomeUnitGraph -> History -> IO SrcSpan
    152 154 
     getHistorySpan hug hist = do
    153 155 
       let ibi = historyBreakpointId hist
    154 
    -  brks <- readModBreaks hug (ibi_tick_mod ibi)
    155 
    -  return $ getBreakLoc ibi brks
    156 
    +  brks <- expectJust <$> readModBreaks hug ibi
    157 
    +  return $ expectJust $ getBreakLoc ibi brks
    156 158
    157 159 
     {- | Finds the enclosing top level function name -}
    158 160 
     -- ToDo: a better way to do this would be to keep hold of the decl_path computed
    ... ... @@ -160,8 +162,10 @@ getHistorySpan hug hist = do
    160 162 
     -- for each tick.
    161 163 
     findEnclosingDecls :: HUG.HomeUnitGraph -> InternalBreakpointId -> IO [String]
    162 164 
     findEnclosingDecls hug ibi = do
    163 
    -  brks <- readModBreaks hug (ibi_tick_mod ibi)
    164 
    -  return $ getBreakDecls ibi brks
    165 
    +  readModBreaks hug ibi >>= \case
    166 
    +    Nothing -> return []
    167 
    +    Just brks -> return $
    168 
    +      fromMaybe [] (getBreakDecls ibi brks)
    165 169
    166 170 
     -- | Update fixity environment in the current interactive context.
    167 171 
     updateFixityEnv :: GhcMonad m => FixityEnv -> m ()
    ... ... @@ -346,15 +350,17 @@ handleRunStatus step expr bindings final_ids status history0 = do
    346 350 
         --  - the breakpoint was explicitly enabled (in @BreakArray@)
    347 351 
         --  - or one of the stepping options in @EvalOpts@ caused us to stop at one
    348 352 
         EvalBreak apStack_ref (Just eval_break) resume_ctxt ccs -> do
    349 
    -      let ibi = evalBreakpointToId eval_break
    350 353 
           let hug = hsc_HUG hsc_env
    351 
    -      tick_brks <- liftIO $ readModBreaks hug (ibi_tick_mod ibi)
    354 
    +      let ibi@InternalBreakpointId{ibi_info_index}
    355 
    +            = evalBreakpointToId eval_break
    356 
    +      brks <- liftIO $ readModBreaks hug ibi
    357 
    +      breakArray     <- getBreakArray interp ibi (expectJust brks)
    352 358 
           let
    353 
    -        span = getBreakLoc ibi tick_brks
    354 
    -        decl = intercalate "." $ getBreakDecls ibi tick_brks
    359 
    +        span = fromMaybe noSrcSpan $ getBreakLoc ibi =<< brks
    360 
    +        decl = intercalate "." $ fromMaybe [] $ getBreakDecls ibi =<< brks
    355 361
    356 362 
           -- Was this breakpoint explicitly enabled (ie. in @BreakArray@)?
    357 
    -      bactive <- liftIO $ breakpointStatus interp (modBreaks_flags $ imodBreaks_modBreaks tick_brks) (ibi_tick_index ibi)
    363 
    +      bactive <- liftIO $ breakpointStatus interp breakArray ibi_info_index
    358 364
    359 365 
           apStack_fhv <- liftIO $ mkFinalizedHValue interp apStack_ref
    360 366 
           resume_ctxt_fhv   <- liftIO $ mkFinalizedHValue interp resume_ctxt
    ... ... @@ -442,7 +448,8 @@ resumeExec step mbCnt
    442 448 
                     -- When the user specified a break ignore count, set it
    443 449 
                     -- in the interpreter
    444 450 
                     case (mb_brkpt, mbCnt) of
    445 
    -                  (Just brkpt, Just cnt) -> setupBreakpoint interp (toBreakpointId brkpt) cnt
    451 
    +                  (Just ibi, Just cnt) ->
    452 
    +                    setupBreakpoint interp ibi cnt
    446 453 
                       _ -> return ()
    447 454
    448 455 
                     let eval_opts = initEvalOpts dflags (enableGhcStepMode step)
    ... ... @@ -451,20 +458,35 @@ resumeExec step mbCnt
    451 458 
                         hug = hsc_HUG hsc_env
    452 459 
                         hist' = case mb_brkpt of
    453 460 
                            Nothing -> pure prevHistoryLst
    454 
    -                       Just bi
    461 
    +                       Just ibi
    455 462 
                              | breakHere False step span -> do
    456 
    -                            hist1 <- liftIO (mkHistory hug apStack bi)
    463 
    +                            hist1 <- liftIO (mkHistory hug apStack ibi)
    457 464 
                                 return $ hist1 `consBL` fromListBL 50 hist
    458 465 
                              | otherwise -> pure prevHistoryLst
    459 466 
                     handleRunStatus step expr bindings final_ids status =<< hist'
    460 467
    461 
    -setupBreakpoint :: GhcMonad m => Interp -> BreakpointId -> Int -> m ()   -- #19157
    462 
    -setupBreakpoint interp bi cnt = do
    468 
    +setupBreakpoint :: GhcMonad m => Interp -> InternalBreakpointId -> Int -> m ()   -- #19157
    469 
    +setupBreakpoint interp ibi cnt = do
    463 470 
       hug <- hsc_HUG <$> getSession
    464 
    -  modBreaks <- liftIO $ readModBreaks hug (bi_tick_mod bi)
    465 
    -  let breakarray = modBreaks_flags $ imodBreaks_modBreaks modBreaks
    466 
    -  _ <- liftIO $ GHCi.storeBreakpoint interp breakarray (bi_tick_index bi) cnt
    467 
    -  pure ()
    471 
    +  ims <- liftIO $ readModBreaks hug ibi
    472 
    +  breakArray <- getBreakArray interp ibi (expectJust ims)
    473 
    +  liftIO $ GHCi.storeBreakpoint interp breakArray (ibi_info_index ibi) cnt
    474 
    +
    475 
    +getBreakArray :: GhcMonad m => Interp -> InternalBreakpointId -> InternalModBreaks -> m (ForeignRef BreakArray)
    476 
    +getBreakArray interp InternalBreakpointId{ibi_info_mod} imbs = do
    477 
    +
    478 
    +  liftIO $ modifyLoaderState interp $ \ld_st -> do
    479 
    +    let le = linker_env ld_st
    480 
    +
    481 
    +    -- Recall that BreakArrays are allocated only at BCO link time, so if we
    482 
    +    -- haven't linked the BCOs we intend to break at yet, we allocate the arrays here.
    483 
    +    ba_env <- allocateBreakArrays interp (breakarray_env le) [imbs]
    484 
    +
    485 
    +    return
    486 
    +      ( ld_st { linker_env = le{breakarray_env = ba_env} }
    487 
    +      , expectJust {- just computed -} $
    488 
    +        lookupModuleEnv ba_env ibi_info_mod
    489 
    +      )
    468 490
    469 491 
     back :: GhcMonad m => Int -> m ([Name], Int, SrcSpan)
    470 492 
     back n = moveHist (+n)
    ... ... @@ -493,8 +515,8 @@ moveHist fn = do
    493 515 
                 span <- case mb_info of
    494 516 
                           Nothing  -> return $ mkGeneralSrcSpan (fsLit "<unknown>")
    495 517 
                           Just ibi -> liftIO $ do
    496 
    -                        brks <- readModBreaks (hsc_HUG hsc_env) (ibi_tick_mod ibi)
    497 
    -                        return $ getBreakLoc ibi brks
    518 
    +                        brks <- readModBreaks (hsc_HUG hsc_env) ibi
    519 
    +                        return $ fromMaybe noSrcSpan $ getBreakLoc ibi =<< brks
    498 520 
                 (hsc_env1, names) <-
    499 521 
                   liftIO $ bindLocalsAtBreakpoint hsc_env apStack span mb_info
    500 522 
                 let ic = hsc_IC hsc_env1
    ... ... @@ -555,11 +577,10 @@ bindLocalsAtBreakpoint hsc_env apStack span Nothing = do
    555 577 
     -- of the breakpoint and the free variables of the expression.
    556 578 
     bindLocalsAtBreakpoint hsc_env apStack_fhv span (Just ibi) = do
    557 579 
        let hug = hsc_HUG hsc_env
    558 
    -   info_brks <- readModBreaks hug (ibi_info_mod ibi)
    559 
    -   tick_brks <- readModBreaks hug (ibi_tick_mod ibi)
    560 
    -   let info   = getInternalBreak ibi (info_brks)
    580 
    +   info_brks <- readModBreaks hug ibi
    581 
    +   let info   = getInternalBreak ibi (expectJust info_brks)
    561 582 
            interp = hscInterp hsc_env
    562 
    -       occs   = getBreakVars ibi tick_brks
    583 
    +       occs   = fromMaybe [] $ getBreakVars ibi =<< info_brks
    563 584
    564 585 
       -- Rehydrate to understand the breakpoint info relative to the current environment.
    565 586 
       -- This design is critical to preventing leaks (#22530)
    ... ... @@ -699,6 +720,7 @@ pushResume hsc_env resume = hsc_env { hsc_IC = ictxt1 }
    699 720 
       {-
    700 721 
       Note [Syncing breakpoint info]
    701 722 
       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    723 
    +  ROMES:TODO: Update
    702 724 
       To display the values of the free variables for a single breakpoint, the
    703 725 
       function `GHC.Runtime.Eval.bindLocalsAtBreakpoint` pulls
    704 726 
       out the information from the fields `modBreaks_breakInfo` and

  • compiler/GHC/Runtime/Interpreter.hs
    ... ... @@ -107,7 +107,6 @@ import Data.Binary
    107 107 
     import Data.ByteString (ByteString)
    108 108 
     import Foreign hiding (void)
    109 109 
     import qualified GHC.Exts.Heap as Heap
    110 
    -import GHC.Stack.CCS (CostCentre,CostCentreStack)
    111 110 
     import System.Directory
    112 111 
     import System.Process
    113 112 
     import qualified GHC.InfoProv as InfoProv
    ... ... @@ -411,15 +410,10 @@ evalBreakpointToId :: EvalBreakpoint -> InternalBreakpointId
    411 410 
     evalBreakpointToId eval_break =
    412 411 
       let
    413 412 
         mkUnitId u = fsToUnit $ mkFastStringShortByteString u
    414 
    -
    415 413 
         toModule u n = mkModule (mkUnitId u) (mkModuleName n)
    416 
    -    tickl = toModule (eb_tick_mod_unit eval_break) (eb_tick_mod eval_break)
    417 
    -    infol = toModule (eb_info_mod_unit eval_break) (eb_info_mod eval_break)
    418 414 
       in
    419 415 
         InternalBreakpointId
    420 
    -      { ibi_tick_mod   = tickl
    421 
    -      , ibi_tick_index = eb_tick_index eval_break
    422 
    -      , ibi_info_mod   = infol
    416 
    +      { ibi_info_mod   = toModule (eb_info_mod_unit eval_break) (eb_info_mod eval_break)
    423 417 
           , ibi_info_index = eb_info_index eval_break
    424 418 
           }
    425 419
    ... ... @@ -440,17 +434,17 @@ handleSeqHValueStatus interp unit_env eval_status =
    440 434 
               -- Reason: Setting of flags in libraries/ghci/GHCi/Run.hs:evalOptsSeq
    441 435
    442 436 
             Just break -> do
    443 
    -          let bi = evalBreakpointToId break
    437 
    +          let ibi = evalBreakpointToId break
    438 
    +              hug = ue_home_unit_graph unit_env
    444 439
    445 440 
               -- Just case: Stopped at a breakpoint, extract SrcSpan information
    446 441 
               -- from the breakpoint.
    447 
    -          mb_modbreaks <- getModBreaks . expectJust <$>
    448 
    -                          lookupHugByModule (ibi_tick_mod bi) (ue_home_unit_graph unit_env)
    442 
    +          mb_modbreaks <- readModBreaks hug ibi
    449 443 
               case mb_modbreaks of
    450 444 
                 -- Nothing case - should not occur! We should have the appropriate
    451 445 
                 -- breakpoint information
    452 446 
                 Nothing -> nothing_case
    453 
    -            Just modbreaks -> put $ brackets . ppr $ getBreakLoc bi modbreaks
    447 
    +            Just modbreaks -> put $ brackets . ppr $ getBreakLoc ibi modbreaks
    454 448
    455 449 
           -- resume the seq (:force) processing in the iserv process
    456 450 
           withForeignRef resume_ctxt_fhv $ \hval -> do
    ... ... @@ -741,14 +735,14 @@ getModBreaks hmi
    741 735 
       | Just linkable <- homeModInfoByteCode hmi,
    742 736 
         -- The linkable may have 'DotO's as well; only consider BCOs. See #20570.
    743 737 
         [cbc] <- linkableBCOs linkable
    744 
    -  = bc_breaks cbc
    738 
    +  = Just $ bc_breaks cbc
    745 739 
       | otherwise
    746 740 
       = Nothing -- probably object code
    747 741
    748 742 
     -- | Read the 'InternalModBreaks' and 'ModBreaks' of the given home 'Module'
    749 743 
     -- from the 'HomeUnitGraph'.
    750 
    -readModBreaks :: HomeUnitGraph -> Module -> IO InternalModBreaks
    751 
    -readModBreaks hug modl = expectJust . getModBreaks . expectJust <$> HUG.lookupHugByModule modl hug
    744 
    +readModBreaks :: HasCallStack => HomeUnitGraph -> InternalBreakpointId -> IO (Maybe InternalModBreaks)
    745 
    +readModBreaks hug ibi = getModBreaks . expectJust <$> HUG.lookupHugByModule (ibi_info_mod ibi) hug
    752 746
    753 747 
     -- -----------------------------------------------------------------------------
    754 748 
     -- Misc utils

  • compiler/GHC/Runtime/Interpreter.hs-boot deleted
    1 
    -module GHC.Runtime.Interpreter where
    2 
    -
    3 
    -import {-# SOURCE #-} GHC.Runtime.Interpreter.Types
    4 
    -import Data.Int (Int)
    5 
    -import GHC.Base (IO)
    6 
    -import GHCi.BreakArray (BreakArray)
    7 
    -import GHCi.RemoteTypes (ForeignRef)
    8 
    -
    9 
    -newBreakArray :: Interp -> Int -> IO (ForeignRef BreakArray)
    10 
    -

  • compiler/GHC/Runtime/Interpreter/Types.hs-boot deleted
    1 
    -module GHC.Runtime.Interpreter.Types where
    2 
    -
    3 
    -import Data.Bool
    4 
    -
    5 
    -data Interp
    6 
    -interpreterProfiled :: Interp -> Bool

  • compiler/GHC/StgToByteCode.hs
    ... ... @@ -134,10 +134,7 @@ 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 mb_modBreaks of
    138 
    -             Nothing -> Nothing
    139 
    -             Just mb -> Just $ mkInternalModBreaks this_mod breakInfo mb
    140 
    -        cbc <- assembleBCOs profile proto_bcos tycs strings mod_breaks spt_entries
    137 
    +        cbc <- assembleBCOs profile proto_bcos tycs strings internalBreaks spt_entries
    141 138
    142 139 
             -- Squash space leaks in the CompiledByteCode.  This is really
    143 140 
             -- important, because when loading a set of modules into GHCi
    ... ... @@ -394,69 +391,22 @@ schemeR_wrk fvs nm original_body (args, body)
    394 391 
     -- | Introduce break instructions for ticked expressions.
    395 392 
     -- If no breakpoint information is available, the instruction is omitted.
    396 393 
     schemeER_wrk :: StackDepth -> BCEnv -> CgStgExpr -> BcM BCInstrList
    397 
    -schemeER_wrk d p (StgTick (Breakpoint tick_ty (BreakpointId tick_mod tick_no) fvs) rhs) = do
    394 
    +schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_id fvs) rhs) = do
    398 395 
       code <- schemeE d 0 p rhs
    399 
    -  hsc_env <- getHscEnv
    400 
    -  current_mod <- getCurrentModule
    401 
    -  mb_current_mod_breaks <- getCurrentModBreaks
    402 
    -  case mb_current_mod_breaks of
    403 
    -    -- if we're not generating ModBreaks for this module for some reason, we
    404 
    -    -- can't store breakpoint occurrence information.
    405 
    -    Nothing -> pure code
    406 
    -    Just current_mod_breaks -> break_info hsc_env tick_mod current_mod mb_current_mod_breaks >>= \case
    407 
    -      Nothing -> pure code
    408 
    -      Just ModBreaks{modBreaks_module = tick_mod} -> do
    409 
    -        platform <- profilePlatform <$> getProfile
    410 
    -        let idOffSets = getVarOffSets platform d p fvs
    411 
    -            ty_vars   = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
    412 
    -            toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
    413 
    -            toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
    414 
    -            breakInfo  = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty
    415 
    -
    416 
    -        let info_mod = modBreaks_module current_mod_breaks
    417 
    -        infox <- newBreakInfo breakInfo
    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)
    425 
    -        return $ breakInstr `consOL` code
    426 
    -schemeER_wrk d p rhs = schemeE d 0 p rhs
    396 
    +  platform <- profilePlatform <$> getProfile
    397 
    +  let idOffSets = getVarOffSets platform d p fvs
    398 
    +      ty_vars   = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
    399 
    +      toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
    400 
    +      toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
    401 
    +      breakInfo  = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty tick_id
    402 
    +
    403 
    +  -- TODO: Lookup tick_id in InternalBreakMods and if it returns Nothing then
    404 
    +  -- we don't have Breakpoint information for this Breakpoint so might as well
    405 
    +  -- not emit the instruction.
    406 
    +  ibi <- newBreakInfo breakInfo
    407 
    +  return $ BRK_FUN ibi `consOL` code
    427 408
    428 
    --- | Determine the GHCi-allocated 'BreakArray' and module pointer for the module
    429 
    --- from which the breakpoint originates.
    430 
    --- These are stored in 'ModBreaks' as remote pointers in order to allow the BCOs
    431 
    --- to refer to pointers in GHCi's address space.
    432 
    --- They are initialized in 'GHC.HsToCore.Breakpoints.mkModBreaks', called by
    433 
    --- 'GHC.HsToCore.deSugar'.
    434 
    ---
    435 
    --- Breakpoints might be disabled because we're in TH, because
    436 
    --- @-fno-break-points@ was specified, or because a module was reloaded without
    437 
    --- reinitializing 'ModBreaks'.
    438 
    ---
    439 
    --- If the module stored in the breakpoint is the currently processed module, use
    440 
    --- the 'ModBreaks' from the state.
    441 
    --- If that is 'Nothing', consider breakpoints to be disabled and skip the
    442 
    --- instruction.
    443 
    ---
    444 
    --- If the breakpoint is inlined from another module, look it up in the HUG (home unit graph).
    445 
    --- If the module doesn't exist there, or if the 'ModBreaks' value is
    446 
    --- uninitialized, skip the instruction (i.e. return Nothing).
    447 
    -break_info ::
    448 
    -  HscEnv ->
    449 
    -  Module ->
    450 
    -  Module ->
    451 
    -  Maybe ModBreaks ->
    452 
    -  BcM (Maybe ModBreaks)
    453 
    -break_info hsc_env mod current_mod current_mod_breaks
    454 
    -  | mod == current_mod
    455 
    -  = pure current_mod_breaks
    456 
    -  | otherwise
    457 
    -  = liftIO (HUG.lookupHugByModule mod (hsc_HUG hsc_env)) >>= \case
    458 
    -      Just hp -> pure $ imodBreaks_modBreaks <$> getModBreaks hp
    459 
    -      Nothing -> pure Nothing
    409 
    +schemeER_wrk d p rhs = schemeE d 0 p rhs
    460 410
    461 411 
     getVarOffSets :: Platform -> StackDepth -> BCEnv -> [Id] -> [Maybe (Id, WordOff)]
    462 412 
     getVarOffSets platform depth env = map getOffSet

  • ghc/GHCi/UI.hs
    ... ... @@ -1572,9 +1572,9 @@ afterRunStmt step run_result = do
    1572 1572 
               Right names -> do
    1573 1573 
                 show_types <- isOptionSet ShowType
    1574 1574 
                 when show_types $ printTypeOfNames names
    1575 
    -     GHC.ExecBreak names mb_info
    1575 
    +     GHC.ExecBreak names mibi
    1576 1576 
              | first_resume : _ <- resumes
    1577 
    -         -> do mb_id_loc <- toBreakIdAndLocation mb_info
    1577 
    +         -> do mb_id_loc <- toBreakIdAndLocation mibi
    1578 1578 
                    let bCmd = maybe "" ( \(_,l) -> onBreakCmd l ) mb_id_loc
    1579 1579 
                    if (null bCmd)
    1580 1580 
                      then printStoppedAtBreakInfo first_resume names
    ... ... @@ -1612,8 +1612,8 @@ toBreakIdAndLocation Nothing = return Nothing
    1612 1612 
     toBreakIdAndLocation (Just inf) = do
    1613 1613 
       st <- getGHCiState
    1614 1614 
       return $ listToMaybe [ id_loc | id_loc@(_,loc) <- IntMap.assocs (breaks st),
    1615 
    -                                  breakModule loc == ibi_tick_mod inf,
    1616 
    -                                  breakTick loc == ibi_tick_index inf ]
    1615 
    +                                  breakModule loc == ibi_info_mod inf,
    1616 
    +                                  breakTick loc == ibi_info_index inf ]
    1617 1617
    1618 1618 
     printStoppedAtBreakInfo :: GHC.GhcMonad m => Resume -> [Name] -> m ()
    1619 1619 
     printStoppedAtBreakInfo res names = do
    ... ... @@ -3793,7 +3793,7 @@ pprStopped res =
    3793 3793 
              <> text (GHC.resumeDecl res))
    3794 3794 
         <> char ',' <+> ppr (GHC.resumeSpan res)
    3795 3795 
      where
    3796 
    -  mb_mod_name = moduleName <$> ibi_tick_mod <$> GHC.resumeBreakpointId res
    3796 
    +  mb_mod_name = moduleName . ibi_info_mod <$> GHC.resumeBreakpointId res
    3797 3797
    3798 3798 
     showUnits :: GHC.GhcMonad m => m ()
    3799 3799 
     showUnits = mapNonInteractiveHomeUnitsM $ \dflags -> do
    ... ... @@ -4348,11 +4348,11 @@ ignoreCmd argLine = withSandboxOnly ":ignore" $ do
    4348 4348 
         case result of
    4349 4349 
           Left sdoc -> printForUser sdoc
    4350 4350 
           Right (loc, count)   -> do
    4351 
    -        let bi = GHC.BreakpointId
    4352 
    -                  { bi_tick_mod   = breakModule loc
    4353 
    -                  , bi_tick_index = breakTick loc
    4351 
    +        let ibi = GHC.InternalBreakpointId
    4352 
    +                  { ibi_info_mod   = breakModule loc
    4353 
    +                  , ibi_info_index = breakTick loc
    4354 4354 
                       }
    4355 
    -        setupBreakpoint bi count
    4355 
    +        setupBreakpoint ibi count
    4356 4356
    4357 4357 
     ignoreSwitch :: GhciMonad m => [String] -> m (Either SDoc (BreakLocation, Int))
    4358 4358 
     ignoreSwitch [break, count] = do
    ... ... @@ -4369,7 +4369,7 @@ getIgnoreCount str =
    4369 4369 
         where
    4370 4370 
           sdocIgnore = text "Ignore count" <+> quotes (text str)
    4371 4371
    4372 
    -setupBreakpoint :: GhciMonad m => GHC.BreakpointId -> Int -> m()
    4372 
    +setupBreakpoint :: GhciMonad m => GHC.InternalBreakpointId -> Int -> m()
    4373 4373 
     setupBreakpoint loc count = do
    4374 4374 
         hsc_env <- GHC.getSession
    4375 4375 
         GHC.setupBreakpoint (hscInterp hsc_env) loc count
    ... ... @@ -4448,7 +4448,7 @@ breakById inp = do
    4448 4448 
         Left sdoc -> printForUser sdoc
    4449 4449 
         Right (mod, mod_info, fun_str) -> do
    4450 4450 
           let modBreaks = expectJust (GHC.modInfoModBreaks mod_info)
    4451 
    -      findBreakAndSet mod $ \_ -> findBreakForBind fun_str (imodBreaks_modBreaks modBreaks)
    4451 
    +      findBreakAndSet mod $ \_ -> maybe [] (findBreakForBind fun_str) (imodBreaks_modBreaks modBreaks)
    4452 4452
    4453 4453 
     breakSyntax :: a
    4454 4454 
     breakSyntax = throwGhcException $ CmdLineError ("Syntax: :break [<mod>.]<func>[.<func>]\n"
    ... ... @@ -4727,10 +4727,10 @@ turnBreakOnOff onOff loc
    4727 4727 
           return loc { breakEnabled = onOff }
    4728 4728
    4729 4729 
     setBreakFlag :: GhciMonad m => Module -> Int -> Bool ->m ()
    4730 
    -setBreakFlag  md ix enaDisa = do
    4730 
    +setBreakFlag md ix enaDisa = do
    4731 4731 
       let enaDisaToCount True = breakOn
    4732 4732 
           enaDisaToCount False = breakOff
    4733 
    -  setupBreakpoint (GHC.BreakpointId md ix) $ enaDisaToCount enaDisa
    4733 
    +  setupBreakpoint (GHC.InternalBreakpointId md ix) $ enaDisaToCount enaDisa
    4734 4734
    4735 4735 
     -- ---------------------------------------------------------------------------
    4736 4736 
     -- User code exception handling

  • libraries/ghci/GHCi/Debugger.hs
    ... ... @@ -65,10 +65,7 @@ foreign import ccall "&rts_stop_on_exception" exceptionFlag :: Ptr CInt
    65 65 
     --------------------------------------------------------------------------------
    66 66
    67 67 
     type BreakpointCallback
    68 
    -     = Addr#   -- pointer to the breakpoint tick module name
    69 
    -    -> Addr#   -- pointer to the breakpoint tick module unit id
    70 
    -    -> Int#    -- breakpoint tick index
    71 
    -    -> Addr#   -- pointer to the breakpoint info module name
    68 
    +     = Addr#   -- pointer to the breakpoint info module name
    72 69 
         -> Addr#   -- pointer to the breakpoint info module unit id
    73 70 
         -> Int#    -- breakpoint info index
    74 71 
         -> Bool    -- exception?

  • libraries/ghci/GHCi/Message.hs
    ... ... @@ -418,10 +418,7 @@ data EvalStatus_ a b
    418 418 
     instance Binary a => Binary (EvalStatus_ a b)
    419 419
    420 420 
     data EvalBreakpoint = EvalBreakpoint
    421 
    -  { eb_tick_mod      :: String -- ^ Breakpoint tick module
    422 
    -  , eb_tick_mod_unit :: BS.ShortByteString -- ^ Breakpoint tick module unit id
    423 
    -  , eb_tick_index    :: Int    -- ^ Breakpoint tick index
    424 
    -  , eb_info_mod      :: String -- ^ Breakpoint info module
    421 
    +  { eb_info_mod      :: String -- ^ Breakpoint info module
    425 422 
       , eb_info_mod_unit :: BS.ShortByteString -- ^ Breakpoint tick module unit id
    426 423 
       , eb_info_index    :: Int    -- ^ Breakpoint info index
    427 424 
       }

  • libraries/ghci/GHCi/Run.hs
    ... ... @@ -342,7 +342,7 @@ withBreakAction opts breakMVar statusMVar mtid act
    342 342 
             -- as soon as it is hit, or in resetBreakAction below.
    343 343
    344 344 
        onBreak :: BreakpointCallback
    345 
    -   onBreak tick_mod# tick_mod_uid# tickx# info_mod# info_mod_uid# infox# is_exception apStack = do
    345 
    +   onBreak info_mod# info_mod_uid# infox# is_exception apStack = do
    346 346 
          tid <- myThreadId
    347 347 
          let resume = ResumeContext
    348 348 
                { resumeBreakMVar = breakMVar
    ... ... @@ -355,11 +355,9 @@ withBreakAction opts breakMVar statusMVar mtid act
    355 355 
            if is_exception
    356 356 
            then pure Nothing
    357 357 
            else do
    358 
    -         tick_mod <- peekCString (Ptr tick_mod#)
    359 
    -         tick_mod_uid <- BS.packCString (Ptr tick_mod_uid#)
    360 358 
              info_mod <- peekCString (Ptr info_mod#)
    361 359 
              info_mod_uid <- BS.packCString (Ptr info_mod_uid#)
    362 
    -         pure (Just (EvalBreakpoint tick_mod tick_mod_uid (I# tickx#) info_mod info_mod_uid (I# infox#)))
    360 
    +         pure (Just (EvalBreakpoint info_mod info_mod_uid (I# infox#)))
    363 361 
          putMVar statusMVar $ EvalBreak apStack_r breakpoint resume_r ccs
    364 362 
          takeMVar breakMVar
    365 363
    ... ... @@ -406,8 +404,8 @@ noBreakStablePtr :: StablePtr BreakpointCallback
    406 404 
     noBreakStablePtr = unsafePerformIO $ newStablePtr noBreakAction
    407 405
    408 406 
     noBreakAction :: BreakpointCallback
    409 
    -noBreakAction _ _ _ _ _ _ False _ = putStrLn "*** Ignoring breakpoint"
    410 
    -noBreakAction _ _ _ _ _ _ True  _ = return () -- exception: just continue
    407 
    +noBreakAction _ _ _ False _ = putStrLn "*** Ignoring breakpoint"
    408 
    +noBreakAction _ _ _ True  _ = return () -- exception: just continue
    411 409
    412 410 
     -- Malloc and copy the bytes.  We don't have any way to monitor the
    413 411 
     -- lifetime of this memory, so it just leaks.

  • rts/Disassembler.c
    ... ... @@ -84,16 +84,23 @@ disInstr ( StgBCO *bco, int pc )
    84 84
    85 85
    86 86 
        switch (instr & 0xff) {
    87 
    -      case bci_BRK_FUN:
    88 
    -         debugBelch ("BRK_FUN  " );  printPtr( ptrs[instrs[pc]] );
    89 
    -         debugBelch (" %d ", instrs[pc+1]); printPtr( ptrs[instrs[pc+2]] );
    90 
    -         CostCentre* cc = (CostCentre*)literals[instrs[pc+5]];
    87 
    +      case bci_BRK_FUN: {
    88 
    +         W_ p1, info_mod, info_unit_id, info_wix, np;
    89 
    +         p1           = BCO_GET_LARGE_ARG;
    90 
    +         info_mod     = BCO_GET_LARGE_ARG;
    91 
    +         info_unit_id = BCO_GET_LARGE_ARG;
    92 
    +         info_wix     = BCO_GET_LARGE_ARG;
    93 
    +         np           = BCO_GET_LARGE_ARG;
    94 
    +         debugBelch ("BRK_FUN " );  printPtr( ptrs[p1] );
    95 
    +         debugBelch("%" FMT_Word, literals[info_mod] );
    96 
    +         debugBelch("%" FMT_Word, literals[info_unit_id] );
    97 
    +         debugBelch("%" FMT_Word, literals[info_wix] );
    98 
    +         CostCentre* cc = (CostCentre*)literals[np];
    91 99 
              if (cc) {
    92 100 
                debugBelch(" %s", cc->label);
    93 101 
              }
    94 102 
              debugBelch("\n");
    95 
    -         pc += 6;
    96 
    -         break;
    103 
    +         break; }
    97 104 
           case bci_BRK_ALTS:
    98 105 
              debugBelch ("BRK_ALTS %d\n", BCO_NEXT);
    99 106 
              break;

  • rts/Exception.cmm
    ... ... @@ -535,23 +535,17 @@ retry_pop_stack:
    535 535 
                 // be per-thread.
    536 536 
                 CInt[rts_stop_on_exception] = 0;
    537 537 
                 ("ptr" ioAction) = ccall deRefStablePtr (W_[rts_breakpoint_io_action] "ptr");
    538 
    -            Sp = Sp - WDS(17);
    539 
    -            Sp(16) = exception;
    540 
    -            Sp(15) = stg_raise_ret_info;
    541 
    -            Sp(14) = exception;
    542 
    -            Sp(13) = ghczminternal_GHCziInternalziTypes_True_closure; // True <=> an exception
    543 
    -            Sp(12) = stg_ap_ppv_info;
    544 
    -            Sp(11) = 0;
    545 
    -            Sp(10) = stg_ap_n_info;
    546 
    -            Sp(9)  = 0;
    547 
    -            Sp(8)  = stg_ap_n_info;
    548 
    -            Sp(7)  = 0;
    549 
    -            Sp(6)  = stg_ap_n_info;
    550 
    -            Sp(5)  = 0;
    551 
    -            Sp(4)  = stg_ap_n_info;
    552 
    -            Sp(3)  = 0;
    553 
    -            Sp(2)  = stg_ap_n_info;
    554 
    -            Sp(1)  = 0;
    538 
    +            Sp = Sp - WDS(11);
    539 
    +            Sp(10) = exception;
    540 
    +            Sp(9) = stg_raise_ret_info;
    541 
    +            Sp(8) = exception;
    542 
    +            Sp(7) = ghczminternal_GHCziInternalziTypes_True_closure; // True <=> an exception
    543 
    +            Sp(6) = stg_ap_ppv_info;
    544 
    +            Sp(5) = 0;
    545 
    +            Sp(4) = stg_ap_n_info;
    546 
    +            Sp(3) = 0;
    547 
    +            Sp(2) = stg_ap_n_info;
    548 
    +            Sp(1) = 0;
    555 549 
                 R1 = ioAction;
    556 550 
                 jump RET_LBL(stg_ap_n) [R1];
    557 551 
             }

  • rts/Interpreter.c
    ... ... @@ -1454,9 +1454,9 @@ run_BCO:
    1454 1454 
             /* check for a breakpoint on the beginning of a let binding */
    1455 1455 
             case bci_BRK_FUN:
    1456 1456 
             {
    1457 
    -            int arg1_brk_array, arg2_tick_mod, arg3_info_mod, arg4_tick_mod_id, arg5_info_mod_id, arg6_tick_index, arg7_info_index;
    1457 
    +            W_ arg1_brk_array, arg2_info_mod_name, arg3_info_mod_id, arg4_info_index;
    1458 1458 
     #if defined(PROFILING)
    1459 
    -            int arg8_cc;
    1459 
    +            W_ arg5_cc;
    1460 1460 
     #endif
    1461 1461 
                 StgArrBytes *breakPoints;
    1462 1462 
                 int returning_from_break, stop_next_breakpoint;
    ... ... @@ -1471,14 +1471,11 @@ run_BCO:
    1471 1471 
                 int size_words;
    1472 1472
    1473 1473 
                 arg1_brk_array      = BCO_GET_LARGE_ARG;
    1474 
    -            arg2_tick_mod       = BCO_GET_LARGE_ARG;
    1475 
    -            arg3_info_mod       = BCO_GET_LARGE_ARG;
    1476 
    -            arg4_tick_mod_id    = BCO_GET_LARGE_ARG;
    1477 
    -            arg5_info_mod_id    = BCO_GET_LARGE_ARG;
    1478 
    -            arg6_tick_index     = BCO_NEXT;
    1479 
    -            arg7_info_index     = BCO_NEXT;
    1474 
    +            arg2_info_mod_name  = BCO_GET_LARGE_ARG;
    1475 
    +            arg3_info_mod_id    = BCO_GET_LARGE_ARG;
    1476 
    +            arg4_info_index     = BCO_LIT(BCO_GET_LARGE_ARG);
    1480 1477 
     #if defined(PROFILING)
    1481 
    -            arg8_cc             = BCO_GET_LARGE_ARG;
    1478 
    +            arg5_cc             = BCO_GET_LARGE_ARG;
    1482 1479 
     #else
    1483 1480 
                 BCO_GET_LARGE_ARG;
    1484 1481 
     #endif
    ... ... @@ -1498,7 +1495,7 @@ run_BCO:
    1498 1495
    1499 1496 
     #if defined(PROFILING)
    1500 1497 
                 cap->r.rCCCS = pushCostCentre(cap->r.rCCCS,
    1501 
    -                                          (CostCentre*)BCO_LIT(arg8_cc));
    1498 
    +                                          (CostCentre*)BCO_LIT(arg5_cc));
    1502 1499 
     #endif
    1503 1500
    1504 1501 
                 // if we are returning from a break then skip this section
    ... ... @@ -1509,11 +1506,11 @@ run_BCO:
    1509 1506
    1510 1507 
                    // stop the current thread if either `stop_next_breakpoint` is
    1511 1508 
                    // true OR if the ignore count for this particular breakpoint is zero
    1512 
    -               StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg6_tick_index];
    1509 
    +               StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg4_info_index];
    1513 1510 
                    if (stop_next_breakpoint == false && ignore_count > 0)
    1514 1511 
                    {
    1515 1512 
                       // decrement and write back ignore count
    1516 
    -                  ((StgInt*)breakPoints->payload)[arg6_tick_index] = --ignore_count;
    1513 
    +                  ((StgInt*)breakPoints->payload)[arg4_info_index] = --ignore_count;
    1517 1514 
                    }
    1518 1515 
                    else if (stop_next_breakpoint == true || ignore_count == 0)
    1519 1516 
                    {
    ... ... @@ -1547,10 +1544,7 @@ run_BCO:
    1547 1544 
                       // Arrange the stack to call the breakpoint IO action, and
    1548 1545 
                       // continue execution of this BCO when the IO action returns.
    1549 1546 
                       //
    1550 
    -                  // ioAction :: Addr#       -- the breakpoint tick module
    1551 
    -                  //          -> Addr#       -- the breakpoint tick module unit id
    1552 
    -                  //          -> Int#        -- the breakpoint tick index
    1553 
    -                  //          -> Addr#       -- the breakpoint info module
    1547 
    +                  // ioAction :: Addr#       -- the breakpoint info module
    1554 1548 
                       //          -> Addr#       -- the breakpoint info module unit id
    1555 1549 
                       //          -> Int#        -- the breakpoint info index
    1556 1550 
                       //          -> Bool        -- exception?
    ... ... @@ -1560,23 +1554,17 @@ run_BCO:
    1560 1554 
                       ioAction = (StgClosure *) deRefStablePtr (
    1561 1555 
                           rts_breakpoint_io_action);
    1562 1556
    1563 
    -                  Sp_subW(19);
    1564 
    -                  SpW(18) = (W_)obj;
    1565 
    -                  SpW(17) = (W_)&stg_apply_interp_info;
    1566 
    -                  SpW(16) = (W_)new_aps;
    1567 
    -                  SpW(15) = (W_)False_closure;         // True <=> an exception
    1568 
    -                  SpW(14) = (W_)&stg_ap_ppv_info;
    1569 
    -                  SpW(13)  = (W_)arg7_info_index;
    1570 
    -                  SpW(12)  = (W_)&stg_ap_n_info;
    1571 
    -                  SpW(11)  = (W_)BCO_LIT(arg5_info_mod_id);
    1572 
    -                  SpW(10)  = (W_)&stg_ap_n_info;
    1573 
    -                  SpW(9)  = (W_)BCO_LIT(arg3_info_mod);
    1574 
    -                  SpW(8)  = (W_)&stg_ap_n_info;
    1575 
    -                  SpW(7)  = (W_)arg6_tick_index;
    1557 
    +                  Sp_subW(13);
    1558 
    +                  SpW(12) = (W_)obj;
    1559 
    +                  SpW(11) = (W_)&stg_apply_interp_info;
    1560 
    +                  SpW(10) = (W_)new_aps;
    1561 
    +                  SpW(9) = (W_)False_closure;         // True <=> an exception
    1562 
    +                  SpW(8) = (W_)&stg_ap_ppv_info;
    1563 
    +                  SpW(7)  = (W_)arg4_info_index;
    1576 1564 
                       SpW(6)  = (W_)&stg_ap_n_info;
    1577 
    -                  SpW(5)  = (W_)BCO_LIT(arg4_tick_mod_id);
    1565 
    +                  SpW(5)  = (W_)BCO_LIT(arg3_info_mod_id);
    1578 1566 
                       SpW(4)  = (W_)&stg_ap_n_info;
    1579 
    -                  SpW(3)  = (W_)BCO_LIT(arg2_tick_mod);
    1567 
    +                  SpW(3)  = (W_)BCO_LIT(arg2_info_mod_name);
    1580 1568 
                       SpW(2)  = (W_)&stg_ap_n_info;
    1581 1569 
                       SpW(1)  = (W_)ioAction;
    1582 1570 
                       SpW(0)  = (W_)&stg_enter_info;

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