Rodrigo Mesquita pushed to branch wip/romes/top-level-bcos-tag at Glasgow Haskell Compiler / GHC

Commits:

25 changed files:

Changes:

  • compiler/GHC/Builtin/primops.txt.pp
    ... ... @@ -3872,12 +3872,13 @@ primop MkApUpd0_Op "mkApUpd0#" GenPrimOp
    3872 3872 
        with
    3873 3873 
        out_of_line = True
    3874 3874
    3875 
    -primop  NewBCOOp "newBCO#" GenPrimOp
    3876 
    -   ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> State# s -> (# State# s, BCO #)
    3877 
    -   { @'newBCO#' instrs lits ptrs arity bitmap@ creates a new bytecode object. The
    3875 
    +primop  NewBCOOp "newBCO2#" GenPrimOp
    3876 
    +   Int8# -> ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> State# s -> (# State# s, BCO #)
    3877 
    +   { @'newBCO2#' is_case_cont instrs lits ptrs arity bitmap@ creates a new bytecode object. The
    3878 3878 
          resulting object encodes a function of the given arity with the instructions
    3879 3879 
          encoded in @instrs@, and a static reference table usage bitmap given by
    3880 
    -     @bitmap@. }
    3880 
    +     @bitmap@. The @is_case_cont@ boolean indicates whether the BCO is a case
    3881 
    +     continuation (see Note [Case continuation BCOs]) }
    3881 3882 
        with
    3882 3883 
        effect = ReadWriteEffect
    3883 3884 
        out_of_line      = True

  • compiler/GHC/ByteCode/Asm.hs
    ... ... @@ -85,7 +85,7 @@ bcoFreeNames :: UnlinkedBCO -> UniqDSet Name
    85 85 
     bcoFreeNames bco
    86 86 
       = bco_refs bco `uniqDSetMinusUniqSet` mkNameSet [unlinkedBCOName bco]
    87 87 
       where
    88 
    -    bco_refs (UnlinkedBCO _ _ _ _ nonptrs ptrs)
    88 
    +    bco_refs (UnlinkedBCO _ _ _ _ nonptrs ptrs _)
    89 89 
             = unionManyUniqDSets (
    90 90 
                  mkUniqDSet [ n | BCOPtrName n <- elemsFlatBag ptrs ] :
    91 91 
                  mkUniqDSet [ n | BCONPtrItbl n <- elemsFlatBag nonptrs ] :
    ... ... @@ -236,7 +236,8 @@ assembleBCO platform
    236 236 
                           , protoBCOInstrs     = instrs
    237 237 
                           , protoBCOBitmap     = bitmap
    238 238 
                           , protoBCOBitmapSize = bsize
    239 
    -                      , protoBCOArity      = arity }) = do
    239 
    +                      , protoBCOArity      = arity
    240 
    +                      , protoBCOIsCaseCont = isCC }) = do
    240 241 
       -- pass 1: collect up the offsets of the local labels.
    241 242 
       let initial_offset = 0
    242 243
    ... ... @@ -266,7 +267,7 @@ assembleBCO platform
    266 267
    267 268 
       let !insns_arr =  mkBCOByteArray $ final_isn_array
    268 269 
           !bitmap_arr = mkBCOByteArray $ mkBitmapArray bsize bitmap
    269 
    -      ul_bco = UnlinkedBCO nm arity insns_arr bitmap_arr (fromSmallArray final_lit_array) (fromSmallArray final_ptr_array)
    270 
    +      ul_bco = UnlinkedBCO nm arity insns_arr bitmap_arr (fromSmallArray final_lit_array) (fromSmallArray final_ptr_array) isCC
    270 271
    271 272 
       -- 8 Aug 01: Finalisers aren't safe when attached to non-primitive
    272 273 
       -- objects, since they might get run too early.  Disable this until

  • compiler/GHC/ByteCode/Instr.hs
    ... ... @@ -53,7 +53,8 @@ data ProtoBCO a
    53 53 
             -- what the BCO came from, for debugging only
    54 54 
             protoBCOExpr       :: Either [CgStgAlt] CgStgRhs,
    55 55 
             -- malloc'd pointers
    56 
    -        protoBCOFFIs       :: [FFIInfo]
    56 
    +        protoBCOFFIs       :: [FFIInfo],
    57 
    +        protoBCOIsCaseCont :: !Bool -- See Note [Case continuation BCOs]
    57 58 
        }
    58 59
    59 60 
     -- | A local block label (e.g. identifying a case alternative).

  • compiler/GHC/ByteCode/Linker.hs
    ... ... @@ -59,7 +59,7 @@ linkBCO
    59 59 
       -> UnlinkedBCO
    60 60 
       -> IO ResolvedBCO
    61 61 
     linkBCO interp pkgs_loaded le bco_ix
    62 
    -           (UnlinkedBCO _ arity insns bitmap lits0 ptrs0) = do
    62 
    +           (UnlinkedBCO _ arity insns bitmap lits0 ptrs0 isCC) = do
    63 63 
       -- fromIntegral Word -> Word64 should be a no op if Word is Word64
    64 64 
       -- otherwise it will result in a cast to longlong on 32bit systems.
    65 65 
       (lits :: [Word]) <- mapM (fmap fromIntegral . lookupLiteral interp pkgs_loaded le) (elemsFlatBag lits0)
    ... ... @@ -69,7 +69,7 @@ linkBCO interp pkgs_loaded le bco_ix
    69 69 
                   insns
    70 70 
                   bitmap
    71 71 
                   (mkBCOByteArray lits')
    72 
    -              (addListToSS emptySS ptrs))
    72 
    +              (addListToSS emptySS ptrs) isCC)
    73 73
    74 74 
     lookupLiteral :: Interp -> PkgsLoaded -> LinkerEnv -> BCONPtr -> IO Word
    75 75 
     lookupLiteral interp pkgs_loaded le ptr = case ptr of

  • compiler/GHC/ByteCode/Types.hs
    ... ... @@ -167,14 +167,108 @@ newtype ItblPtr = ItblPtr (RemotePtr Heap.StgInfoTable)
    167 167 
     newtype AddrPtr = AddrPtr (RemotePtr ())
    168 168 
       deriving (NFData)
    169 169
    170 
    +{-
    171 
    +--------------------------------------------------------------------------------
    172 
    +-- * Byte Code Objects (BCOs)
    173 
    +--------------------------------------------------------------------------------
    174 
    +
    175 
    +Note [Case continuation BCOs]
    176 
    +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    177 
    +
    178 
    +A stack with a BCO stack frame at the top looks like:
    179 
    +
    180 
    +                                      (an StgBCO)
    181 
    +         |       ...        |      +---> +---------[1]--+
    182 
    +         +------------------+      |     | info_tbl_ptr | ------+
    183 
    +         |    OTHER FRAME   |      |     +--------------+       |
    184 
    +         +------------------+      |     | StgArrBytes* | <--- the byte code
    185 
    +         |       ...        |      |     +--------------+       |
    186 
    +         +------------------+      |     |     ...      |       |
    187 
    +         |       fvs1       |      |                            |
    188 
    +         +------------------+      |                            |
    189 
    +         |       ...        |      |        (StgInfoTable)      |
    190 
    +         +------------------+      |           +----------+ <---+
    191 
    +         |      args1       |      |           |    ...   |
    192 
    +         +------------------+      |           +----------+
    193 
    +         |   some StgBCO*   | -----+           | type=BCO |
    194 
    +         +------------------+                  +----------+
    195 
    +      Sp | stg_apply_interp | -----+           |   ...    |
    196 
    +         +------------------+      |
    197 
    +                                   |
    198 
    +                                   |   (StgInfoTable)
    199 
    +                                   +----> +--------------+
    200 
    +                                          |     ...      |
    201 
    +                                          +--------------+
    202 
    +                                          | type=RET_BCO |
    203 
    +                                          +--------------+
    204 
    +                                          |     ...      |
    205 
    +
    206 
    +
    207 
    +The byte code for a BCO heap object makes use of arguments and free variables
    208 
    +which can typically be found within the BCO stack frame. In the code, these
    209 
    +variables are referenced via a statically known stack offset (tracked using
    210 
    +`BCEnv` in `StgToByteCode`).
    211 
    +
    212 
    +However, in /case continuation/ BCOs, the code may additionally refer to free
    213 
    +variables that are outside of that BCO's stack frame -- some free variables of a
    214 
    +case continuation BCO may only be found in the stack frame of a parent BCO.
    215 
    +
    216 
    +Yet, references to these out-of-frame variables are also done in terms of stack
    217 
    +offsets. Thus, they rely on the position of /another frame/ to be fixed. (See
    218 
    +Note [PUSH_L underflow] for more information about references to previous
    219 
    +frames and nested BCOs)
    220 
    +
    221 
    +This makes case continuation BCOs special: unlike normal BCOs, case cont BCO
    222 
    +frames cannot be moved on the stack independently from their parent BCOs.
    223 
    +
    224 
    +In order to be able to distinguish them at runtime, the code generator will use
    225 
    +distinct info table pointers for their closures, even though they will have the
    226 
    +same structure on the heap (StgBCO). Specifically:
    227 
    +
    228 
    +  - Normal BCOs are always headed by the `stg_BCO_info` pointer.
    229 
    +  - Case continuation BCOs are always headed by the `stg_CASE_CONT_BCO_info` pointer.
    230 
    +
    231 
    +A primary reason why we need to distinguish these two cases is to know where we
    232 
    +can insert a debugger step-out frame (`stg_stop_after_ret_frame`). In
    233 
    +particular, because case cont BCOs may refer to the parent frame, we must not
    234 
    +insert step-out frames between a case cont BCO and its parent.
    235 
    +
    236 
    +As an example, consider the following, where `y` is free in the case alternatives:
    237 
    +
    238 
    +    f x y = case x of
    239 
    +      True -> y - 1
    240 
    +      False -> y + 1 :: Int
    241 
    +
    242 
    +While interpreting f, the args x and y will be on the stack as part of f's frame.
    243 
    +In its body, a case continuation BCO is pushed (PUSH_ALTS) and then `x` is
    244 
    +entered to be evaluated. Upon entering `x`, the stack would look something like:
    245 
    +
    246 
    +    <f arg 2>
    247 
    +    <f arg 1>
    248 
    +    ...
    249 
    +    <Case continuation BCO Frame>
    250 
    +
    251 
    +We cannot insert a step out frame in between:
    252 
    +
    253 
    +
    254 
    +    <f arg 2>
    255 
    +    <f arg 1>
    256 
    +    ...
    257 
    +    <inserted step-out frame>      <--- BAD! Breaks stack offsets in the case cont.
    258 
    +    <Case continuation BCO Frame>
    259 
    +
    260 
    +Instead, we must traverse until the parent BCO and insert the step-out frame before it instead.
    261 
    +-}
    262 
    +
    170 263 
     data UnlinkedBCO
    171 264 
        = UnlinkedBCO {
    172 265 
             unlinkedBCOName   :: !Name,
    173 266 
             unlinkedBCOArity  :: {-# UNPACK #-} !Int,
    174 
    -        unlinkedBCOInstrs :: !(BCOByteArray Word16),      -- insns
    175 
    -        unlinkedBCOBitmap :: !(BCOByteArray Word),      -- bitmap
    267 
    +        unlinkedBCOInstrs :: !(BCOByteArray Word16),   -- insns
    268 
    +        unlinkedBCOBitmap :: !(BCOByteArray Word),     -- bitmap
    176 269 
             unlinkedBCOLits   :: !(FlatBag BCONPtr),       -- non-ptrs
    177 
    -        unlinkedBCOPtrs   :: !(FlatBag BCOPtr)         -- ptrs
    270 
    +        unlinkedBCOPtrs   :: !(FlatBag BCOPtr),        -- ptrs
    271 
    +        unlinkedBCOIsCaseCont :: !Bool                 -- See Note [Case continuation BCOs]
    178 272 
        }
    179 273
    180 274 
     instance NFData UnlinkedBCO where
    ... ... @@ -227,10 +321,11 @@ seqCgBreakInfo CgBreakInfo{..} =
    227 321 
         rnf cgb_resty
    228 322
    229 323 
     instance Outputable UnlinkedBCO where
    230 
    -   ppr (UnlinkedBCO nm _arity _insns _bitmap lits ptrs)
    324 
    +   ppr (UnlinkedBCO nm _arity _insns _bitmap lits ptrs pi)
    231 325 
           = sep [text "BCO", ppr nm, text "with",
    232 326 
                  ppr (sizeFlatBag lits), text "lits",
    233 
    -             ppr (sizeFlatBag ptrs), text "ptrs" ]
    327 
    +             ppr (sizeFlatBag ptrs), text "ptrs",
    328 
    +             ppr pi, text "is_pos_indep"]
    234 329
    235 330 
     instance Outputable CgBreakInfo where
    236 331 
        ppr info = text "CgBreakInfo" <+>

  • compiler/GHC/StgToByteCode.hs
    ... ... @@ -253,7 +253,11 @@ mkProtoBCO
    253 253 
        -> Int       -- ^ arity
    254 254 
        -> WordOff   -- ^ bitmap size
    255 255 
        -> [StgWord] -- ^ bitmap
    256 
    -   -> Bool      -- ^ True <=> is a return point, rather than a function
    256 
    +   -> Bool      -- ^ True <=> it's a case continuation, rather than a function
    257 
    +                -- Used for
    258 
    +                --  (A) Stack check collision and
    259 
    +                --  (B) Mark the BCO wrt whether it contains non-local stack
    260 
    +                --    references. See Note [Case continuation BCOs].
    257 261 
        -> [FFIInfo]
    258 262 
        -> ProtoBCO Name
    259 263 
     mkProtoBCO platform _add_bco_name nm instrs_ordlist origin arity bitmap_size bitmap is_ret ffis
    ... ... @@ -264,7 +268,8 @@ mkProtoBCO platform _add_bco_name nm instrs_ordlist origin arity bitmap_size bit
    264 268 
             protoBCOBitmapSize = fromIntegral bitmap_size,
    265 269 
             protoBCOArity = arity,
    266 270 
             protoBCOExpr = origin,
    267 
    -        protoBCOFFIs = ffis
    271 
    +        protoBCOFFIs = ffis,
    272 
    +        protoBCOIsCaseCont = is_ret
    268 273 
           }
    269 274 
          where
    270 275 
     #if MIN_VERSION_rts(1,0,3)
    ... ... @@ -353,6 +358,9 @@ schemeTopBind (id, rhs)
    353 358 
     -- Park the resulting BCO in the monad.  Also requires the
    354 359 
     -- name of the variable to which this value was bound,
    355 360 
     -- so as to give the resulting BCO a name.
    361 
    +--
    362 
    +-- The resulting ProtoBCO expects the free variables and the function arguments
    363 
    +-- to be in the stack directly before it.
    356 364 
     schemeR :: [Id]                 -- Free vars of the RHS, ordered as they
    357 365 
                                     -- will appear in the thunk.  Empty for
    358 366 
                                     -- top-level things, which have no free vars.
    ... ... @@ -391,6 +399,8 @@ schemeR_wrk fvs nm original_body (args, body)
    391 399 
              -- them unlike constructor fields.
    392 400 
              szsb_args = map (wordsToBytes platform . idSizeW platform) all_args
    393 401 
              sum_szsb_args  = sum szsb_args
    402 
    +         -- Make a stack offset for each argument or free var -- they should
    403 
    +         -- appear contiguous in the stack, in order.
    394 404 
              p_init    = Map.fromList (zip all_args (mkStackOffsets 0 szsb_args))
    395 405
    396 406 
              -- make the arg bitmap
    ... ... @@ -1401,7 +1411,7 @@ Note [unboxed tuple bytecodes and tuple_BCO]
    1401 1411 
     tupleBCO :: Platform -> NativeCallInfo -> [(PrimRep, ByteOff)] -> [FFIInfo] -> ProtoBCO Name
    1402 1412 
     tupleBCO platform args_info args =
    1403 1413 
       mkProtoBCO platform Nothing invented_name body_code (Left [])
    1404 
    -             0{-no arity-} bitmap_size bitmap False{-is alts-}
    1414 
    +             0{-no arity-} bitmap_size bitmap False{-not alts-}
    1405 1415 
       where
    1406 1416 
         {-
    1407 1417 
           The tuple BCO is never referred to by name, so we can get away
    ... ... @@ -1422,7 +1432,7 @@ tupleBCO platform args_info args =
    1422 1432 
     primCallBCO :: Platform -> NativeCallInfo -> [(PrimRep, ByteOff)] -> [FFIInfo] -> ProtoBCO Name
    1423 1433 
     primCallBCO platform args_info args =
    1424 1434 
       mkProtoBCO platform Nothing invented_name body_code (Left [])
    1425 
    -             0{-no arity-} bitmap_size bitmap False{-is alts-}
    1435 
    +             0{-no arity-} bitmap_size bitmap False{-not alts-}
    1426 1436 
       where
    1427 1437 
         {-
    1428 1438 
           The primcall BCO is never referred to by name, so we can get away

  • libraries/base/src/GHC/Exts.hs
    ... ... @@ -26,12 +26,12 @@ module GHC.Exts
    26 26 
          -- **  Legacy interface for arrays of arrays
    27 27 
          module GHC.Internal.ArrayArray,
    28 28 
          -- *  Primitive operations
    29 
    -     {-# DEPRECATED ["The BCO, mkApUpd0#, and newBCO# re-exports from GHC.Exts have been deprecated and will be removed in 9.14", "These symbols should be imported from ghc-internal instead if needed."] #-}
    29 
    +     {-# DEPRECATED ["The BCO, mkApUpd0#, and newBCO# re-exports from GHC.Exts have been deprecated and will be removed in 10.14", "These symbols should be imported from ghc-internal instead if needed."] #-}
    30 30 
          Prim.BCO,
    31 31 
          {-# DEPRECATED ["The BCO, mkApUpd0#, and newBCO# re-exports from GHC.Exts have been deprecated and will be removed in 9.14", "These symbols should be imported from ghc-internal instead if needed."] #-}
    32 32 
          Prim.mkApUpd0#,
    33 33 
          {-# DEPRECATED ["The BCO, mkApUpd0#, and newBCO# re-exports from GHC.Exts have been deprecated and will be removed in 9.14", "These symbols should be imported from ghc-internal instead if needed."] #-}
    34 
    -     Prim.newBCO#,
    34 
    +     IExts.newBCO#,
    35 35 
          module GHC.Prim,
    36 36 
          module GHC.Prim.Ext,
    37 37 
          -- **  Running 'RealWorld' state thread
    ... ... @@ -119,7 +119,7 @@ module GHC.Exts
    119 119 
          maxTupleSize
    120 120 
          ) where
    121 121
    122 
    -import GHC.Internal.Exts
    122 
    +import GHC.Internal.Exts hiding ( newBCO# )
    123 123 
     import GHC.Internal.ArrayArray
    124 124 
     import GHC.Prim hiding
    125 125 
       ( coerce
    ... ... @@ -132,7 +132,7 @@ import GHC.Prim hiding
    132 132 
       , isByteArrayWeaklyPinned#, isMutableByteArrayWeaklyPinned#
    133 133
    134 134 
       -- deprecated
    135 
    -  , BCO, mkApUpd0#, newBCO#
    135 
    +  , BCO, mkApUpd0#
    136 136
    137 137 
       -- Don't re-export vector FMA instructions
    138 138 
       , fmaddFloatX4#
    ... ... @@ -256,8 +256,10 @@ import GHC.Prim hiding
    256 256 
       , minWord8X32#
    257 257 
       , minWord8X64#
    258 258 
       )
    259 
    +import qualified GHC.Internal.Exts as IExts
    260 
    +  ( newBCO# )
    259 261 
     import qualified GHC.Prim as Prim
    260 
    -  ( BCO, mkApUpd0#, newBCO# )
    262 
    +  ( BCO, mkApUpd0# )
    261 263
    262 264 
     import GHC.Prim.Ext
    263 265

  • libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
    ... ... @@ -624,6 +624,7 @@ data TsoFlags
    624 624 
       | TsoMarked
    625 625 
       | TsoSqueezed
    626 626 
       | TsoAllocLimit
    627 
    +  | TsoStopNextBreakpoint
    627 628 
       | TsoFlagsUnknownValue Word32 -- ^ Please report this as a bug
    628 629 
       deriving (Eq, Show, Generic, Ord)
    629 630

  • libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingDisabled.hsc
    ... ... @@ -87,6 +87,9 @@ parseTsoFlags w | isSet (#const TSO_LOCKED) w = TsoLocked : parseTsoFlags (unset
    87 87 
                     | isSet (#const TSO_MARKED) w = TsoMarked : parseTsoFlags (unset (#const TSO_MARKED) w)
    88 88 
                     | isSet (#const TSO_SQUEEZED) w = TsoSqueezed : parseTsoFlags (unset (#const TSO_SQUEEZED) w)
    89 89 
                     | isSet (#const TSO_ALLOC_LIMIT) w = TsoAllocLimit : parseTsoFlags (unset (#const TSO_ALLOC_LIMIT) w)
    90 
    +#if __GLASGOW_HASKELL__ >= 913
    91 
    +                | isSet (#const TSO_STOP_NEXT_BREAKPOINT) w = TsoStopNextBreakpoint : parseTsoFlags (unset (#const TSO_STOP_NEXT_BREAKPOINT) w)
    92 
    +#endif
    90 93 
     parseTsoFlags 0 = []
    91 94 
     parseTsoFlags w = [TsoFlagsUnknownValue w]
    92 95

  • libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc
    ... ... @@ -87,6 +87,9 @@ parseTsoFlags w | isSet (#const TSO_LOCKED) w = TsoLocked : parseTsoFlags (unset
    87 87 
                     | isSet (#const TSO_MARKED) w = TsoMarked : parseTsoFlags (unset (#const TSO_MARKED) w)
    88 88 
                     | isSet (#const TSO_SQUEEZED) w = TsoSqueezed : parseTsoFlags (unset (#const TSO_SQUEEZED) w)
    89 89 
                     | isSet (#const TSO_ALLOC_LIMIT) w = TsoAllocLimit : parseTsoFlags (unset (#const TSO_ALLOC_LIMIT) w)
    90 
    +#if __GLASGOW_HASKELL__ >= 913
    91 
    +                | isSet (#const TSO_STOP_NEXT_BREAKPOINT) w = TsoStopNextBreakpoint : parseTsoFlags (unset (#const TSO_STOP_NEXT_BREAKPOINT) w)
    92 
    +#endif
    90 93 
     parseTsoFlags 0 = []
    91 94 
     parseTsoFlags w = [TsoFlagsUnknownValue w]
    92 95

  • libraries/ghc-heap/tests/parse_tso_flags.hs
    ... ... @@ -13,5 +13,6 @@ main = do
    13 13 
         assertEqual (parseTsoFlags 64) [TsoMarked]
    14 14 
         assertEqual (parseTsoFlags 128) [TsoSqueezed]
    15 15 
         assertEqual (parseTsoFlags 256) [TsoAllocLimit]
    16 
    +    assertEqual (parseTsoFlags 512) [TsoStopNextBreakpoint]
    16 17
    17 18 
         assertEqual (parseTsoFlags 6) [TsoLocked, TsoBlockx]

  • libraries/ghc-internal/src/GHC/Internal/Exts.hs
    ... ... @@ -163,6 +163,9 @@ module GHC.Internal.Exts
    163 163
    164 164 
             -- * The maximum tuple size
    165 165 
             maxTupleSize,
    166 
    +
    167 
    +        -- * Interpreter
    168 
    +        newBCO#
    166 169 
            ) where
    167 170
    168 171 
     import GHC.Internal.Prim hiding ( coerce, dataToTagSmall#, dataToTagLarge#, whereFrom# )
    ... ... @@ -469,3 +472,18 @@ resizeSmallMutableArray# arr0 szNew a s0 =
    469 472 
     -- accessible\" by word.
    470 473 
     considerAccessible :: Bool
    471 474 
     considerAccessible = True
    475 
    +
    476 
    +--------------------------------------------------------------------------------
    477 
    +-- Interpreter
    478 
    +
    479 
    +{-|
    480 
    +@'newBCO#' instrs lits ptrs arity bitmap@ creates a new bytecode object. The
    481 
    +resulting object encodes a function of the given arity with the instructions
    482 
    +encoded in @instrs@, and a static reference table usage bitmap given by
    483 
    +@bitmap@.
    484 
    +
    485 
    +Note: Case continuation BCOs, with non-local stack references, must be
    486 
    +constructed using @'newBCO2#' 1@ instead. See Note [Case continuation BCOs].
    487 
    +-}
    488 
    +newBCO# :: ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> State# s -> (# State# s, BCO #)
    489 
    +newBCO# b1 b2 a1 i1 b3 s = newBCO2# (intToInt8# 0#) b1 b2 a1 i1 b3 s

  • libraries/ghci/GHCi/CreateBCO.hs
    ... ... @@ -87,11 +87,11 @@ linkBCO' arr ResolvedBCO{..} = do
    87 87 
           literals_barr = barr (getBCOByteArray resolvedBCOLits)
    88 88
    89 89 
       PtrsArr marr <- mkPtrsArray arr n_ptrs ptrs
    90 
    +  let is_case_cont | resolvedBCOIsCaseCont = intToInt8# 1#
    91 
    +                   | otherwise             = intToInt8# 0#
    90 92 
       IO $ \s ->
    91 93 
         case unsafeFreezeArray# marr s of { (# s, arr #) ->
    92 
    -    case newBCO insns_barr literals_barr arr arity# bitmap_barr of { IO io ->
    93 
    -    io s
    94 
    -    }}
    94 
    +      newBCO2# is_case_cont insns_barr literals_barr arr arity# bitmap_barr s }
    95 95
    96 96
    97 97 
     -- we recursively link any sub-BCOs while making the ptrs array

  • libraries/ghci/GHCi/Debugger.hs
    1 
    +{-# LANGUAGE MagicHash #-}
    2 
    +{-# LANGUAGE UnliftedFFITypes #-}
    3 
    +module GHCi.Debugger
    4 
    +  (
    5 
    +  -- * Single step mode
    6 
    +    rts_enableStopNextBreakpoint
    7 
    +  , rts_enableStopNextBreakpointAll
    8 
    +  , rts_disableStopNextBreakpoint
    9 
    +  , rts_disableStopNextBreakpointAll
    10 
    +
    11 
    +  -- * Stop on exception
    12 
    +  , exceptionFlag
    13 
    +
    14 
    +  -- * Breakpoint Callback
    15 
    +  , BreakpointCallback
    16 
    +  , breakPointIOAction
    17 
    +  ) where
    18 
    +
    19 
    +import Prelude -- See note [Why do we import Prelude here?]
    20 
    +
    21 
    +import GHC.Base (ThreadId#, Addr#, Int#)
    22 
    +import Foreign.C (CInt)
    23 
    +import Foreign (StablePtr, Ptr)
    24 
    +import GHCi.RemoteTypes (HValue)
    25 
    +
    26 
    +--------------------------------------------------------------------------------
    27 
    +-- Single step mode
    28 
    +
    29 
    +-- | Enables the single step mode for a specific thread, thus stopping only on
    30 
    +-- breakpoints in that thread.
    31 
    +foreign import ccall unsafe "rts_enableStopNextBreakpoint"
    32 
    +  rts_enableStopNextBreakpoint :: ThreadId# -> IO ()
    33 
    +
    34 
    +-- | Disables per-thread single-step mode. Note: if global single-step is
    35 
    +-- enabled we stop at all breakpoints regardless of the per-thread flag.
    36 
    +foreign import ccall unsafe "rts_disableStopNextBreakpoint"
    37 
    +  rts_disableStopNextBreakpoint :: ThreadId# -> IO ()
    38 
    +
    39 
    +-- | Enables the single step mode for all threads, thus stopping at any
    40 
    +-- existing breakpoint.
    41 
    +foreign import ccall unsafe "rts_enableStopNextBreakpointAll"
    42 
    +  rts_enableStopNextBreakpointAll :: IO ()
    43 
    +
    44 
    +-- | Disables the single step mode for all threads
    45 
    +foreign import ccall unsafe "rts_disableStopNextBreakpointAll"
    46 
    +  rts_disableStopNextBreakpointAll :: IO ()
    47 
    +
    48 
    +--------------------------------------------------------------------------------
    49 
    +
    50 
    +foreign import ccall "&rts_stop_on_exception" exceptionFlag :: Ptr CInt
    51 
    +
    52 
    +--------------------------------------------------------------------------------
    53 
    +
    54 
    +type BreakpointCallback
    55 
    +     = Addr#   -- pointer to the breakpoint tick module name
    56 
    +    -> Addr#   -- pointer to the breakpoint tick module unit id
    57 
    +    -> Int#    -- breakpoint tick index
    58 
    +    -> Addr#   -- pointer to the breakpoint info module name
    59 
    +    -> Addr#   -- pointer to the breakpoint info module unit id
    60 
    +    -> Int#    -- breakpoint info index
    61 
    +    -> Bool    -- exception?
    62 
    +    -> HValue  -- the AP_STACK, or exception
    63 
    +    -> IO ()
    64 
    +
    65 
    +foreign import ccall "&rts_breakpoint_io_action"
    66 
    +   breakPointIOAction :: Ptr (StablePtr BreakpointCallback)
    67 
    +

  • libraries/ghci/GHCi/ResolvedBCO.hs
    ... ... @@ -45,7 +45,8 @@ data ResolvedBCO
    45 45 
             resolvedBCOBitmap :: BCOByteArray Word,         -- ^ bitmap
    46 46 
             resolvedBCOLits   :: BCOByteArray Word,
    47 47 
               -- ^ non-ptrs - subword sized entries still take up a full (host) word
    48 
    -        resolvedBCOPtrs   :: (SizedSeq ResolvedBCOPtr)  -- ^ ptrs
    48 
    +        resolvedBCOPtrs   :: (SizedSeq ResolvedBCOPtr), -- ^ ptrs
    49 
    +        resolvedBCOIsCaseCont :: !Bool                  -- ^ See Note [Case continuation BCOs]
    49 50 
        }
    50 51 
        deriving (Generic, Show)
    51 52
    ... ... @@ -86,7 +87,8 @@ instance Binary ResolvedBCO where
    86 87 
         put resolvedBCOBitmap
    87 88 
         put resolvedBCOLits
    88 89 
         put resolvedBCOPtrs
    89 
    -  get = ResolvedBCO <$> get <*> get <*> get <*> get <*> get <*> get
    90 
    +    put resolvedBCOIsCaseCont
    91 
    +  get = ResolvedBCO <$> get <*> get <*> get <*> get <*> get <*> get <*> get
    90 92
    91 93 
     -- See Note [BCOByteArray serialization]
    92 94 
     instance (Binary a, Storable a, IArray UArray a) => Binary (BCOByteArray a) where

  • libraries/ghci/GHCi/Run.hs
    1 1 
     {-# LANGUAGE GADTs, RecordWildCards, MagicHash, ScopedTypeVariables, CPP,
    2 
    -    UnboxedTuples, LambdaCase #-}
    2 
    +    UnboxedTuples, LambdaCase, UnliftedFFITypes #-}
    3 3 
     {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
    4 4
    5 5 
     -- |
    ... ... @@ -20,6 +20,7 @@ import GHCi.InfoTable
    20 20 
     #endif
    21 21
    22 22 
     import qualified GHC.InfoProv as InfoProv
    23 
    +import GHCi.Debugger
    23 24 
     import GHCi.FFI
    24 25 
     import GHCi.Message
    25 26 
     import GHCi.ObjLink
    ... ... @@ -332,7 +333,7 @@ withBreakAction opts breakMVar statusMVar act
    332 333 
          stablePtr <- newStablePtr onBreak
    333 334 
          poke breakPointIOAction stablePtr
    334 335 
          when (breakOnException opts) $ poke exceptionFlag 1
    335 
    -     when (singleStep opts) $ setStepFlag
    336 
    +     when (singleStep opts) rts_enableStopNextBreakpointAll
    336 337 
          return stablePtr
    337 338 
             -- Breaking on exceptions is not enabled by default, since it
    338 339 
             -- might be a bit surprising.  The exception flag is turned off
    ... ... @@ -363,7 +364,7 @@ withBreakAction opts breakMVar statusMVar act
    363 364 
        resetBreakAction stablePtr = do
    364 365 
          poke breakPointIOAction noBreakStablePtr
    365 366 
          poke exceptionFlag 0
    366 
    -     resetStepFlag
    367 
    +     rts_disableStopNextBreakpointAll
    367 368 
          freeStablePtr stablePtr
    368 369
    369 370 
     resumeStmt
    ... ... @@ -396,28 +397,6 @@ abandonStmt hvref = do
    396 397 
       _ <- takeMVar resumeStatusMVar
    397 398 
       return ()
    398 399
    399 
    -foreign import ccall "&rts_stop_next_breakpoint" stepFlag      :: Ptr CInt
    400 
    -foreign import ccall "&rts_stop_on_exception"    exceptionFlag :: Ptr CInt
    401 
    -
    402 
    -setStepFlag :: IO ()
    403 
    -setStepFlag = poke stepFlag 1
    404 
    -resetStepFlag :: IO ()
    405 
    -resetStepFlag = poke stepFlag 0
    406 
    -
    407 
    -type BreakpointCallback
    408 
    -     = Addr#   -- pointer to the breakpoint tick module name
    409 
    -    -> Addr#   -- pointer to the breakpoint tick module unit id
    410 
    -    -> Int#    -- breakpoint tick index
    411 
    -    -> Addr#   -- pointer to the breakpoint info module name
    412 
    -    -> Addr#   -- pointer to the breakpoint info module unit id
    413 
    -    -> Int#    -- breakpoint info index
    414 
    -    -> Bool    -- exception?
    415 
    -    -> HValue  -- the AP_STACK, or exception
    416 
    -    -> IO ()
    417 
    -
    418 
    -foreign import ccall "&rts_breakpoint_io_action"
    419 
    -   breakPointIOAction :: Ptr (StablePtr BreakpointCallback)
    420 
    -
    421 400 
     noBreakStablePtr :: StablePtr BreakpointCallback
    422 401 
     noBreakStablePtr = unsafePerformIO $ newStablePtr noBreakAction
    423 402

  • libraries/ghci/ghci.cabal.in
    ... ... @@ -60,6 +60,7 @@ library
    60 60 
             CPP-Options: -DHAVE_INTERNAL_INTERPRETER
    61 61 
             exposed-modules:
    62 62 
                 GHCi.Run
    63 
    +            GHCi.Debugger
    63 64 
                 GHCi.CreateBCO
    64 65 
                 GHCi.ObjLink
    65 66 
                 GHCi.Signals

  • rts/Interpreter.c
    ... ... @@ -203,14 +203,14 @@ PUSH_L instruction.
    203 203
    204 204 
     |---------|
    205 205 
     |  BCO_1  | -<-┐
    206 
    -|---------|
    206 
    +|---------|    |
    207 207 
      .........     |
    208 208 
     |---------|    | PUSH_L <n>
    209 209 
     |  BCO_N  | ->-┘
    210 210 
     |---------|
    211 211
    212 212 
     Here BCO_N is syntactically nested within the code for BCO_1 and will result
    213 
    -in code that references the prior stack frame of BCO_1 for some of it's local
    213 
    +in code that references the prior stack frame of BCO_1 for some of its local
    214 214 
     variables. If a stack overflow happens between the creation of the stack frame
    215 215 
     for BCO_1 and BCO_N the RTS might move BCO_N to a new stack chunk while leaving
    216 216 
     BCO_1 in place, invalidating a simple offset based reference to the outer stack
    ... ... @@ -243,9 +243,44 @@ allocate_NONUPD (Capability *cap, int n_words)
    243 243 
         return allocate(cap, stg_max(sizeofW(StgHeader)+MIN_PAYLOAD_SIZE, n_words));
    244 244 
     }
    245 245
    246 
    -int rts_stop_next_breakpoint = 0;
    247 246 
     int rts_stop_on_exception = 0;
    248 247
    248 
    +/* ---------------------------------------------------------------------------
    249 
    + * Enabling and disabling global single step mode
    250 
    + * ------------------------------------------------------------------------ */
    251 
    +
    252 
    +/* A global toggle for single-step mode.
    253 
    + * Unlike `TSO_STOP_NEXT_BREAKPOINT`, which sets single-step mode per-thread,
    254 
    + * `rts_stop_next_breakpoint` globally enables single-step mode. If enabled, we
    255 
    + * will stop at the immediate next breakpoint regardless of what thread it is in. */
    256 
    +int rts_stop_next_breakpoint = 0;
    257 
    +
    258 
    +void rts_enableStopNextBreakpointAll(void)
    259 
    +{
    260 
    +  rts_stop_next_breakpoint = 1;
    261 
    +}
    262 
    +
    263 
    +void rts_disableStopNextBreakpointAll(void)
    264 
    +{
    265 
    +  rts_stop_next_breakpoint = 0;
    266 
    +}
    267 
    +
    268 
    +/* ---------------------------------------------------------------------------
    269 
    + * Enabling and disabling per-thread single step mode
    270 
    + * ------------------------------------------------------------------------ */
    271 
    +
    272 
    +void rts_enableStopNextBreakpoint(StgPtr tso)
    273 
    +{
    274 
    +    ((StgTSO *)tso)->flags |= TSO_STOP_NEXT_BREAKPOINT;
    275 
    +}
    276 
    +
    277 
    +void rts_disableStopNextBreakpoint(StgPtr tso)
    278 
    +{
    279 
    +    ((StgTSO *)tso)->flags &= ~TSO_STOP_NEXT_BREAKPOINT;
    280 
    +}
    281 
    +
    282 
    +/* -------------------------------------------------------------------------- */
    283 
    +
    249 284 
     #if defined(INTERP_STATS)
    250 285
    251 286 
     #define N_CODES 128
    ... ... @@ -508,14 +543,35 @@ interpretBCO (Capability* cap)
    508 543 
         //
    509 544 
         //       We have a BCO application to perform.  Stack looks like:
    510 545 
         //
    511 
    -    //          |     ....      |
    512 
    -    //          +---------------+
    513 
    -    //          |     arg1      |
    514 
    -    //          +---------------+
    515 
    -    //          |     BCO       |
    516 
    -    //          +---------------+
    517 
    -    //       Sp |   RET_BCO     |
    518 
    -    //          +---------------+
    546 
    +    //
    547 
    +    //                                       (an StgBCO)
    548 
    +    //                                    +---> +---------[1]--+
    549 
    +    //                                    |     | stg_BCO_info | ------+
    550 
    +    //                                    |     +--------------+       |
    551 
    +    //                                    |     | StgArrBytes* | <--- the byte code
    552 
    +    //          |       ...        |      |     +--------------+       |
    553 
    +    //          +------------------+      |     |     ...      |       |
    554 
    +    //          |       fvs1       |      |                            |
    555 
    +    //          +------------------+      |                            |
    556 
    +    //          |       ...        |      |        (StgInfoTable)      |
    557 
    +    //          +------------------+      |           +----------+ <---+
    558 
    +    //          |      args1       |      |           |    ...   |
    559 
    +    //          +------------------+      |           +----------+
    560 
    +    //          |   some StgBCO*   | -----+           | type=BCO |
    561 
    +    //          +------------------+                  +----------+
    562 
    +    //       Sp | stg_apply_interp | -----+           |   ...    |
    563 
    +    //          +------------------+      |
    564 
    +    //                                    |
    565 
    +    //                                    |   (StgInfoTable)
    566 
    +    //                                    +----> +--------------+
    567 
    +    //                                           |     ...      |
    568 
    +    //                                           +--------------+
    569 
    +    //                                           | type=RET_BCO |
    570 
    +    //                                           +--------------+
    571 
    +    //                                           |     ...      |
    572 
    +    //
    573 
    +    // [1] An StgBCO's info table pointer may also be stg_CASE_CONT_BCO_info.
    574 
    +    //      See Note [Case continuation BCOs].
    519 575 
         //
    520 576 
         else if (SpW(0) == (W_)&stg_apply_interp_info) {
    521 577 
             obj = UNTAG_CLOSURE((StgClosure *)ReadSpW(1));
    ... ... @@ -1250,7 +1306,7 @@ run_BCO:
    1250 1306 
                 int arg8_cc;
    1251 1307 
     #endif
    1252 1308 
                 StgArrBytes *breakPoints;
    1253 
    -            int returning_from_break;
    1309 
    +            int returning_from_break, stop_next_breakpoint;
    1254 1310
    1255 1311 
                 // the io action to run at a breakpoint
    1256 1312 
                 StgClosure *ioAction;
    ... ... @@ -1280,6 +1336,13 @@ run_BCO:
    1280 1336 
                 returning_from_break =
    1281 1337 
                     cap->r.rCurrentTSO->flags & TSO_STOPPED_ON_BREAKPOINT;
    1282 1338
    1339 
    +            // check whether this thread is set to stop at the immediate next
    1340 
    +            // breakpoint -- either by the global `rts_stop_next_breakpoint`
    1341 
    +            // flag, or by the local `TSO_STOP_NEXT_BREAKPOINT`
    1342 
    +            stop_next_breakpoint =
    1343 
    +              rts_stop_next_breakpoint ||
    1344 
    +                cap->r.rCurrentTSO->flags & TSO_STOP_NEXT_BREAKPOINT;
    1345 
    +
    1283 1346 
     #if defined(PROFILING)
    1284 1347 
                 cap->r.rCCCS = pushCostCentre(cap->r.rCCCS,
    1285 1348 
                                               (CostCentre*)BCO_LIT(arg8_cc));
    ... ... @@ -1291,20 +1354,20 @@ run_BCO:
    1291 1354 
                 {
    1292 1355 
                    breakPoints = (StgArrBytes *) BCO_PTR(arg1_brk_array);
    1293 1356
    1294 
    -               // stop the current thread if either the
    1295 
    -               // "rts_stop_next_breakpoint" flag is true OR if the
    1296 
    -               // ignore count for this particular breakpoint is zero
    1357 
    +               // stop the current thread if either `stop_next_breakpoint` is
    1358 
    +               // true OR if the ignore count for this particular breakpoint is zero
    1297 1359 
                    StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg6_tick_index];
    1298 
    -               if (rts_stop_next_breakpoint == false && ignore_count > 0)
    1360 
    +               if (stop_next_breakpoint == false && ignore_count > 0)
    1299 1361 
                    {
    1300 1362 
                       // decrement and write back ignore count
    1301 1363 
                       ((StgInt*)breakPoints->payload)[arg6_tick_index] = --ignore_count;
    1302 1364 
                    }
    1303 
    -               else if (rts_stop_next_breakpoint == true || ignore_count == 0)
    1365 
    +               else if (stop_next_breakpoint == true || ignore_count == 0)
    1304 1366 
                    {
    1305 1367 
                       // make sure we don't automatically stop at the
    1306 1368 
                       // next breakpoint
    1307 
    -                  rts_stop_next_breakpoint = false;
    1369 
    +                  rts_stop_next_breakpoint = 0;
    1370 
    +                  cap->r.rCurrentTSO->flags &= ~TSO_STOP_NEXT_BREAKPOINT;
    1308 1371
    1309 1372 
                       // allocate memory for a new AP_STACK, enough to
    1310 1373 
                       // store the top stack frame plus an
    ... ... @@ -1477,7 +1540,7 @@ run_BCO:
    1477 1540 
                 // Here we make sure references we push are tagged.
    1478 1541 
                 // See Note [CBV Functions and the interpreter] in Info.hs
    1479 1542
    1480 
    -            //Safe some memory reads if we already have a tag.
    1543 
    +            //Save some memory reads if we already have a tag.
    1481 1544 
                 if(GET_CLOSURE_TAG(tagged_obj) == 0) {
    1482 1545 
                     StgClosure *obj = UNTAG_CLOSURE(tagged_obj);
    1483 1546 
                     switch ( get_itbl(obj)->type ) {

  • rts/Interpreter.h
    ... ... @@ -11,3 +11,8 @@
    11 11 
     RTS_PRIVATE Capability *interpretBCO (Capability* cap);
    12 12 
     void interp_startup ( void );
    13 13 
     void interp_shutdown ( void );
    14 
    +
    15 
    +void rts_enableStopNextBreakpointAll  ( void );
    16 
    +void rts_disableStopNextBreakpointAll ( void );
    17 
    +void rts_enableStopNextBreakpoint     ( StgPtr );
    18 
    +void rts_disableStopNextBreakpoint    ( StgPtr );

  • rts/PrimOps.cmm
    ... ... @@ -55,6 +55,7 @@ import CLOSURE stg_AP_STACK_info;
    55 55 
     import CLOSURE stg_AP_info;
    56 56 
     import CLOSURE stg_ARR_WORDS_info;
    57 57 
     import CLOSURE stg_BCO_info;
    58 
    +import CLOSURE stg_CASE_CONT_BCO_info;
    58 59 
     import CLOSURE stg_C_FINALIZER_LIST_info;
    59 60 
     import CLOSURE stg_DEAD_WEAK_info;
    60 61 
     import CLOSURE stg_END_STM_WATCH_QUEUE_closure;
    ... ... @@ -2434,7 +2435,8 @@ stg_deRefStablePtrzh ( P_ sp )
    2434 2435 
        Bytecode object primitives
    2435 2436 
        -------------------------------------------------------------------------  */
    2436 2437
    2437 
    -stg_newBCOzh ( P_ instrs,
    2438 
    +stg_newBCO2zh ( CBool is_case_cont,
    2439 
    +               P_ instrs,
    2438 2440 
                    P_ literals,
    2439 2441 
                    P_ ptrs,
    2440 2442 
                    W_ arity,
    ... ... @@ -2449,7 +2451,16 @@ stg_newBCOzh ( P_ instrs,
    2449 2451
    2450 2452 
         bco = Hp - bytes + WDS(1);
    2451 2453 
         // No memory barrier necessary as this is a new allocation.
    2452 
    -    SET_HDR(bco, stg_BCO_info, CCS_MAIN);
    2454 
    +    if (is_case_cont > 0) {
    2455 
    +     /* Uses stg_CASE_CONT_BCO_info to construct the BCO frame (rather than stg_BCO_info).
    2456 
    +      * Case continuations may contain non-local references to parent frames. The distinct info table
    2457 
    +      * tag allows the RTS to identify such non-local frames.
    2458 
    +      * See Note [Case continuation BCOs]
    2459 
    +      */
    2460 
    +      SET_HDR(bco, stg_CASE_CONT_BCO_info, CCS_MAIN);
    2461 
    +    } else {
    2462 
    +      SET_HDR(bco, stg_BCO_info, CCS_MAIN);
    2463 
    +    }
    2453 2464
    2454 2465 
         StgBCO_instrs(bco)     = instrs;
    2455 2466 
         StgBCO_literals(bco)   = literals;

  • rts/Printer.c
    ... ... @@ -690,6 +690,8 @@ printStackChunk( StgPtr sp, StgPtr spBottom )
    690 690 
                     debugBelch("stg_ctoi_V_info" );
    691 691 
                 } else if (c == (StgWord)&stg_BCO_info) {
    692 692 
                     debugBelch("stg_BCO_info" );
    693 
    +            } else if (c == (StgWord)&stg_CASE_CONT_BCO_info) {
    694 
    +                debugBelch("stg_CASE_CONT_BCO_info" );
    693 695 
                 } else if (c == (StgWord)&stg_apply_interp_info) {
    694 696 
                     debugBelch("stg_apply_interp_info" );
    695 697 
                 } else if (c == (StgWord)&stg_ret_t_info) {

  • rts/RtsSymbols.c
    ... ... @@ -639,7 +639,7 @@ extern char **environ;
    639 639 
           SymI_HasDataProto(stg_copySmallMutableArrayzh)                        \
    640 640 
           SymI_HasDataProto(stg_casSmallArrayzh)                                \
    641 641 
           SymI_HasDataProto(stg_copyArray_barrier)                              \
    642 
    -      SymI_HasDataProto(stg_newBCOzh)                                       \
    642 
    +      SymI_HasDataProto(stg_newBCO2zh)                                      \
    643 643 
           SymI_HasDataProto(stg_newByteArrayzh)                                 \
    644 644 
           SymI_HasDataProto(stg_casIntArrayzh)                                  \
    645 645 
           SymI_HasDataProto(stg_casInt8Arrayzh)                                 \
    ... ... @@ -906,7 +906,10 @@ extern char **environ;
    906 906 
           SymI_HasProto(revertCAFs)                                         \
    907 907 
           SymI_HasProto(RtsFlags)                                           \
    908 908 
           SymI_NeedsDataProto(rts_breakpoint_io_action)                     \
    909 
    -      SymI_NeedsDataProto(rts_stop_next_breakpoint)                     \
    909 
    +      SymI_NeedsDataProto(rts_enableStopNextBreakpointAll)              \
    910 
    +      SymI_NeedsDataProto(rts_disableStopNextBreakpointAll)             \
    911 
    +      SymI_NeedsDataProto(rts_enableStopNextBreakpoint)                 \
    912 
    +      SymI_NeedsDataProto(rts_disableStopNextBreakpoint)                \
    910 913 
           SymI_NeedsDataProto(rts_stop_on_exception)                        \
    911 914 
           SymI_HasProto(stopTimer)                                          \
    912 915 
           SymI_HasProto(n_capabilities)                                     \

  • rts/StgMiscClosures.cmm
    ... ... @@ -464,6 +464,12 @@ INFO_TABLE_RET( stg_dead_thread, RET_SMALL,
    464 464
    465 465 
     /* ----------------------------------------------------------------------------
    466 466 
        Entry code for a BCO
    467 
    +
    468 
    +   `stg_BCO` and `stg_CASE_CONT_BCO` distinguish between a BCO that refers to
    469 
    +   non-local variables in its code (using a stack offset) and those that do not.
    470 
    +   Only case-continuation BCOs should use non-local variables.
    471 
    +   Otherwise, `stg_BCO` and `stg_CASE_CONT_BCO` behave the same.
    472 
    +   See Note [Case continuation BCOs].
    467 473 
        ------------------------------------------------------------------------- */
    468 474
    469 475 
     INFO_TABLE_FUN( stg_BCO, 3, 0, BCO, "BCO", "BCO", 0, ARG_BCO )
    ... ... @@ -478,6 +484,15 @@ INFO_TABLE_FUN( stg_BCO, 3, 0, BCO, "BCO", "BCO", 0, ARG_BCO )
    478 484 
       jump stg_yield_to_interpreter [];
    479 485 
     }
    480 486
    487 
    +INFO_TABLE_FUN( stg_CASE_CONT_BCO, 3, 0, BCO, "BCO", "BCO", 0, ARG_BCO )
    488 
    +{
    489 
    +  /* Exactly as for stg_BCO */
    490 
    +  Sp_adj(-2);
    491 
    +  Sp(1) = R1;
    492 
    +  Sp(0) = stg_apply_interp_info;
    493 
    +  jump stg_yield_to_interpreter [];
    494 
    +}
    495 
    +
    481 496 
     /* ----------------------------------------------------------------------------
    482 497 
        Info tables for indirections.
    483 498

  • rts/include/rts/Constants.h
    ... ... @@ -328,6 +328,12 @@
    328 328 
      */
    329 329 
     #define TSO_ALLOC_LIMIT 256
    330 330
    331 
    +/*
    332 
    + * Enables step-in mode for this thread -- it will stop at the immediate next
    333 
    + * breakpoint found in this thread.
    334 
    + */
    335 
    +#define TSO_STOP_NEXT_BREAKPOINT 512
    336 
    +
    331 337 
     /*
    332 338 
      * The number of times we spin in a spin lock before yielding (see
    333 339 
      * #3758).  To tune this value, use the benchmark in #3758: run the

  • rts/include/stg/MiscClosures.h
    ... ... @@ -180,6 +180,7 @@ RTS_ENTRY(stg_BLOCKING_QUEUE_CLEAN);
    180 180 
     RTS_ENTRY(stg_BLOCKING_QUEUE_DIRTY);
    181 181
    182 182 
     RTS_FUN(stg_BCO);
    183 
    +RTS_FUN(stg_CASE_CONT_BCO);
    183 184 
     RTS_ENTRY(stg_EVACUATED);
    184 185 
     RTS_ENTRY(stg_WEAK);
    185 186 
     RTS_ENTRY(stg_DEAD_WEAK);
    ... ... @@ -577,7 +578,7 @@ RTS_FUN_DECL(stg_deRefWeakzh);
    577 578
    578 579 
     RTS_FUN_DECL(stg_runRWzh);
    579 580
    580 
    -RTS_FUN_DECL(stg_newBCOzh);
    581 
    +RTS_FUN_DECL(stg_newBCO2zh);
    581 582 
     RTS_FUN_DECL(stg_mkApUpd0zh);
    582 583
    583 584 
     RTS_FUN_DECL(stg_retryzh);

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