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

Commits:

16 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,109 @@ 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 
    +See Note [Debugger: Step-out] for further details.
    236 
    +
    237 
    +As an example, consider the following, where `y` is free in the case alternatives:
    238 
    +
    239 
    +    f x y = case x of
    240 
    +      True -> y - 1
    241 
    +      False -> y + 1 :: Int
    242 
    +
    243 
    +While interpreting f, the args x and y will be on the stack as part of f's frame.
    244 
    +In its body, a case continuation BCO is pushed (PUSH_ALTS) and then `x` is
    245 
    +entered to be evaluated. Upon entering `x`, the stack would look something like:
    246 
    +
    247 
    +    <f arg 2>
    248 
    +    <f arg 1>
    249 
    +    ...
    250 
    +    <Case continuation BCO Frame>
    251 
    +
    252 
    +We cannot insert a step out frame in between:
    253 
    +
    254 
    +
    255 
    +    <f arg 2>
    256 
    +    <f arg 1>
    257 
    +    ...
    258 
    +    <inserted step-out frame>      <--- BAD! Breaks stack offsets in the case cont.
    259 
    +    <Case continuation BCO Frame>
    260 
    +
    261 
    +Instead, we must traverse until the parent BCO and insert the step-out frame before it instead.
    262 
    +-}
    263 
    +
    170 264 
     data UnlinkedBCO
    171 265 
        = UnlinkedBCO {
    172 266 
             unlinkedBCOName   :: !Name,
    173 267 
             unlinkedBCOArity  :: {-# UNPACK #-} !Int,
    174 
    -        unlinkedBCOInstrs :: !(BCOByteArray Word16),      -- insns
    175 
    -        unlinkedBCOBitmap :: !(BCOByteArray Word),      -- bitmap
    268 
    +        unlinkedBCOInstrs :: !(BCOByteArray Word16),   -- insns
    269 
    +        unlinkedBCOBitmap :: !(BCOByteArray Word),     -- bitmap
    176 270 
             unlinkedBCOLits   :: !(FlatBag BCONPtr),       -- non-ptrs
    177 
    -        unlinkedBCOPtrs   :: !(FlatBag BCOPtr)         -- ptrs
    271 
    +        unlinkedBCOPtrs   :: !(FlatBag BCOPtr),        -- ptrs
    272 
    +        unlinkedBCOIsCaseCont :: !Bool                 -- See Note [Case continuation BCOs]
    178 273 
        }
    179 274
    180 275 
     instance NFData UnlinkedBCO where
    ... ... @@ -227,10 +322,11 @@ seqCgBreakInfo CgBreakInfo{..} =
    227 322 
         rnf cgb_resty
    228 323
    229 324 
     instance Outputable UnlinkedBCO where
    230 
    -   ppr (UnlinkedBCO nm _arity _insns _bitmap lits ptrs)
    325 
    +   ppr (UnlinkedBCO nm _arity _insns _bitmap lits ptrs pi)
    231 326 
           = sep [text "BCO", ppr nm, text "with",
    232 327 
                  ppr (sizeFlatBag lits), text "lits",
    233 
    -             ppr (sizeFlatBag ptrs), text "ptrs" ]
    328 
    +             ppr (sizeFlatBag ptrs), text "ptrs",
    329 
    +             ppr pi, text "is_pos_indep"]
    234 330
    235 331 
     instance Outputable CgBreakInfo where
    236 332 
        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-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/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

  • 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
    ... ... @@ -524,14 +524,35 @@ interpretBCO (Capability* cap)
    524 524 
         //
    525 525 
         //       We have a BCO application to perform.  Stack looks like:
    526 526 
         //
    527 
    -    //          |     ....      |
    528 
    -    //          +---------------+
    529 
    -    //          |     arg1      |
    530 
    -    //          +---------------+
    531 
    -    //          |     BCO       |
    532 
    -    //          +---------------+
    533 
    -    //       Sp |   RET_BCO     |
    534 
    -    //          +---------------+
    527 
    +    //
    528 
    +    //                                       (an StgBCO)
    529 
    +    //                                    +---> +---------[1]--+
    530 
    +    //                                    |     | stg_BCO_info | ------+
    531 
    +    //                                    |     +--------------+       |
    532 
    +    //                                    |     | StgArrBytes* | <--- the byte code
    533 
    +    //          |       ...        |      |     +--------------+       |
    534 
    +    //          +------------------+      |     |     ...      |       |
    535 
    +    //          |       fvs1       |      |                            |
    536 
    +    //          +------------------+      |                            |
    537 
    +    //          |       ...        |      |        (StgInfoTable)      |
    538 
    +    //          +------------------+      |           +----------+ <---+
    539 
    +    //          |      args1       |      |           |    ...   |
    540 
    +    //          +------------------+      |           +----------+
    541 
    +    //          |   some StgBCO*   | -----+           | type=BCO |
    542 
    +    //          +------------------+                  +----------+
    543 
    +    //       Sp | stg_apply_interp | -----+           |   ...    |
    544 
    +    //          +------------------+      |
    545 
    +    //                                    |
    546 
    +    //                                    |   (StgInfoTable)
    547 
    +    //                                    +----> +--------------+
    548 
    +    //                                           |     ...      |
    549 
    +    //                                           +--------------+
    550 
    +    //                                           | type=RET_BCO |
    551 
    +    //                                           +--------------+
    552 
    +    //                                           |     ...      |
    553 
    +    //
    554 
    +    // [1] An StgBCO's info table pointer may also be stg_CASE_CONT_BCO_info.
    555 
    +    //      See Note [Case continuation BCOs].
    535 556 
         //
    536 557 
         else if (SpW(0) == (W_)&stg_apply_interp_info) {
    537 558 
             obj = UNTAG_CLOSURE((StgClosure *)ReadSpW(1));
    ... ... @@ -1500,7 +1521,7 @@ run_BCO:
    1500 1521 
                 // Here we make sure references we push are tagged.
    1501 1522 
                 // See Note [CBV Functions and the interpreter] in Info.hs
    1502 1523
    1503 
    -            //Safe some memory reads if we already have a tag.
    1524 
    +            //Save some memory reads if we already have a tag.
    1504 1525 
                 if(GET_CLOSURE_TAG(tagged_obj) == 0) {
    1505 1526 
                     StgClosure *obj = UNTAG_CLOSURE(tagged_obj);
    1506 1527 
                     switch ( get_itbl(obj)->type ) {

  • 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)                                 \

  • 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/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