    {-# LANGUAGE RecordWildCards, GADTs #-}
    module GHC.Cmm.LayoutStack (
           cmmLayoutStack, setInfoTableStackMap
      ) where

    import GHC.Prelude hiding ((<*>))

    import GHC.Platform
    import GHC.Platform.Profile

    import GHC.StgToCmm.Monad      ( newTemp  ) -- XXX layering violation
    import GHC.StgToCmm.Utils      ( callerSaveVolatileRegs  ) -- XXX layering violation
    import GHC.StgToCmm.Foreign    ( saveThreadState, loadThreadState ) -- XXX layering violation

    import GHC.Cmm
    import GHC.Cmm.Info
    import GHC.Cmm.BlockId
    import GHC.Cmm.Config
    import GHC.Cmm.Utils
    import GHC.Cmm.Graph
    import GHC.Cmm.Liveness
    import GHC.Cmm.ProcPoint
    import GHC.Runtime.Heap.Layout
    import GHC.Cmm.Dataflow
    import GHC.Cmm.Dataflow.Block
    import GHC.Cmm.Dataflow.Graph
    import GHC.Cmm.Dataflow.Label
    import GHC.Types.Unique.Supply
    import GHC.Data.Maybe
    import GHC.Types.Unique.FM
    import GHC.Utils.Misc

    import GHC.Utils.Outputable hiding ( isEmpty )
    import GHC.Utils.Panic
    import qualified Data.Set as Set
    import Control.Monad.Fix
    import Data.Array as Array
    import Data.List (nub)

    {- Note [Stack Layout]
       ~~~~~~~~~~~~~~~~~~~
    The job of this pass is to

     - replace references to abstract stack Areas with fixed offsets from Sp.

     - replace the CmmHighStackMark constant used in the stack check with
       the maximum stack usage of the proc.

     - save any variables that are live across a call, and reload them as
       necessary.

    Before stack allocation, local variables remain live across native
    calls (CmmCall{ cmm_cont = Just _ }), and after stack allocation local
    variables are clobbered by native calls.

    We want to do stack allocation so that as far as possible
     - stack use is minimized, and
     - unnecessary stack saves and loads are avoided.

    The algorithm we use is a variant of linear-scan register allocation,
    where the stack is our register file.

    We proceed in two passes, see Note [Two pass approach] for why they are not easy
    to merge into one.

    Pass 1:

     - First, we do a liveness analysis, which annotates every block with
       the variables live on entry to the block.

     - We traverse blocks in reverse postorder DFS; that is, we visit at
       least one predecessor of a block before the block itself.  The
       stack layout flowing from the predecessor of the block will
       determine the stack layout on entry to the block.

     - We maintain a data structure

         Map Label StackMap

       which describes the contents of the stack and the stack pointer on
       entry to each block that is a successor of a block that we have
       visited.

     - For each block we visit:

        - Look up the StackMap for this block.

        - If this block is a proc point (or a call continuation, if we aren't
          splitting proc points), we need to reload all the live variables from the
          stack - but this is done in Pass 2, which calculates more precise liveness
          information (see description of Pass 2).

        - Walk forwards through the instructions:
          - At an assignment  x = Sp[loc]
            - Record the fact that Sp[loc] contains x, so that we won't
              need to save x if it ever needs to be spilled.
          - At an assignment  x = E
            - If x was previously on the stack, it isn't any more
          - At the last node, if it is a call or a jump to a proc point
            - Lay out the stack frame for the call (see setupStackFrame)
            - emit instructions to save all the live variables
            - Remember the StackMaps for all the successors
            - emit an instruction to adjust Sp
          - If the last node is a branch, then the current StackMap is the
            StackMap for the successors.

        - Manifest Sp: replace references to stack areas in this block
          with real Sp offsets. We cannot do this until we have laid out
          the stack area for the successors above.

          In this phase we also eliminate redundant stores to the stack;
          see elimStackStores.

      - There is one important gotcha: sometimes we'll encounter a control
        transfer to a block that we've already processed (a join point),
        and in that case we might need to rearrange the stack to match
        what the block is expecting. (exactly the same as in linear-scan
        register allocation, except here we have the luxury of an infinite
        supply of temporary variables).

      - Finally, we update the magic CmmHighStackMark constant with the
        stack usage of the function, and eliminate the whole stack check
        if there was no stack use. (in fact this is done as part of the
        main traversal, by feeding the high-water-mark output back in as
        an input. I hate cyclic programming, but it's just too convenient
        sometimes.)

      There are plenty of tricky details: update frames, proc points, return
      addresses, foreign calls, and some ad-hoc optimisations that are
      convenient to do here and effective in common cases.  Comments in the
      code below explain these.

    Pass 2:

    - Calculate live registers, but taking into account that nothing is live at the
      entry to a proc point.

    - At each proc point and call continuation insert reloads of live registers from
      the stack (they were saved by Pass 1).

    Note [Two pass approach]
    ~~~~~~~~~~~~~~~~~~~~~~~~
    The main reason for Pass 2 is being able to insert only the reloads that are
    needed and the fact that the two passes need different liveness information.
    Let's consider an example:

      .....
       \ /
        D   <- proc point
       / \
      E   F
       \ /
        G   <- proc point
        |
        X

    Pass 1 needs liveness assuming that local variables are preserved across calls.
    This is important because it needs to save any local registers to the stack
    (e.g., if register a is used in block X, it must be saved before any native
    call).
    However, for Pass 2, where we want to reload registers from stack (in a proc
    point), this is overly conservative and would lead us to generate reloads in D
    for things used in X, even though we're going to generate reloads in G anyway
    (since it's also a proc point).
    So Pass 2 calculates liveness knowing that nothing is live at the entry to a
    proc point. This means that in D we only need to reload things used in E or F.
    This can be quite important, for an extreme example see testcase for #3294.

    Merging the two passes is not trivial - Pass 2 is a backward rewrite and Pass 1
    is a forward one. Furthermore, Pass 1 is creating code that uses local registers
    (saving them before a call), which the liveness analysis for Pass 2 must see to
    be correct.

    -}

    -- All stack locations are expressed as positive byte offsets from the
    -- "base", which is defined to be the address above the return address
    -- on the stack on entry to this CmmProc.
    --
    -- Lower addresses have higher StackLocs.
    --
    type StackLoc = ByteOff

    {-
     A StackMap describes the stack at any given point.  At a continuation
     it has a particular layout, like this:

             |             | <- base
             |-------------|
             |     ret0    | <- base + 8
             |-------------|
             .  upd frame  . <- base + sm_ret_off
             |-------------|
             |             |
             .    vars     .
             . (live/dead) .
             |             | <- base + sm_sp - sm_args
             |-------------|
             |    ret1     |
             .  ret vals   . <- base + sm_sp    (<--- Sp points here)
             |-------------|

    Why do we include the final return address (ret0) in our stack map?  I
    have absolutely no idea, but it seems to be done that way consistently
    in the rest of the code generator, so I played along here. --SDM

    Note that we will be constructing an info table for the continuation
    (ret1), which needs to describe the stack down to, but not including,
    the update frame (or ret0, if there is no update frame).
    -}

    data StackMap = StackMap
     {  StackMap -> WordOff
    sm_sp   :: StackLoc
           -- ^ the offset of Sp relative to the base on entry
           -- to this block.
     ,  StackMap -> WordOff
    sm_args :: ByteOff
           -- ^ the number of bytes of arguments in the area for this block
           -- Defn: the offset of young(L) relative to the base is given by
           -- (sm_sp - sm_args) of the StackMap for block L.
     ,  StackMap -> WordOff
    sm_ret_off :: ByteOff
           -- ^ Number of words of stack that we do not describe with an info
           -- table, because it contains an update frame.
     ,  StackMap -> UniqFM LocalReg (LocalReg, WordOff)
    sm_regs :: UniqFM LocalReg (LocalReg,StackLoc)
           -- ^ regs on the stack
     }

    instance Outputable StackMap where
      ppr :: StackMap -> SDoc
    ppr StackMap{WordOff
    UniqFM LocalReg (LocalReg, WordOff)
    sm_sp :: StackMap -> WordOff
    sm_args :: StackMap -> WordOff
    sm_ret_off :: StackMap -> WordOff
    sm_regs :: StackMap -> UniqFM LocalReg (LocalReg, WordOff)
    sm_sp :: WordOff
    sm_args :: WordOff
    sm_ret_off :: WordOff
    sm_regs :: UniqFM LocalReg (LocalReg, WordOff)
    ..} =
         String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Sp = " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> WordOff -> SDoc
    forall doc. IsLine doc => WordOff -> doc
    int WordOff
    sm_sp SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$
         String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "sm_args = " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> WordOff -> SDoc
    forall doc. IsLine doc => WordOff -> doc
    int WordOff
    sm_args SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$
         String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "sm_ret_off = " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> WordOff -> SDoc
    forall doc. IsLine doc => WordOff -> doc
    int WordOff
    sm_ret_off SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$
         String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "sm_regs = " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> UniqFM LocalReg (LocalReg, WordOff)
    -> ([(LocalReg, WordOff)] -> SDoc) -> SDoc
    forall {k} (key :: k) a. UniqFM key a -> ([a] -> SDoc) -> SDoc
    pprUFM UniqFM LocalReg (LocalReg, WordOff)
    sm_regs [(LocalReg, WordOff)] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr

    cmmLayoutStack :: CmmConfig -> ProcPointSet -> ByteOff -> CmmGraph
                   -> UniqSM (CmmGraph, LabelMap StackMap)
    cmmLayoutStack :: CmmConfig
    -> ProcPointSet
    -> WordOff
    -> CmmGraph
    -> UniqSM (CmmGraph, LabelMap StackMap)
    cmmLayoutStack CmmConfig
    cfg ProcPointSet
    procpoints WordOff
    entry_args
                   graph :: CmmGraph
    graph@(CmmGraph { g_entry :: forall (n :: Extensibility -> Extensibility -> *).
    GenCmmGraph n -> BlockId
    g_entry = BlockId
    entry })
      = do
        -- We need liveness info. Dead assignments are removed later
        -- by the sinking pass.
        let liveness :: BlockEntryLiveness LocalReg
    liveness = Platform -> CmmGraph -> BlockEntryLiveness LocalReg
    cmmLocalLiveness Platform
    platform CmmGraph
    graph
            blocks :: [CmmBlock]
    blocks   = CmmGraph -> [CmmBlock]
    revPostorder CmmGraph
    graph
            profile :: Profile
    profile  = CmmConfig -> Profile
    cmmProfile   CmmConfig
    cfg
            platform :: Platform
    platform = Profile -> Platform
    profilePlatform Profile
    profile

        (final_stackmaps, _final_high_sp, new_blocks) <-
              ((LabelMap StackMap, WordOff, [CmmBlock])
     -> UniqSM (LabelMap StackMap, WordOff, [CmmBlock]))
    -> UniqSM (LabelMap StackMap, WordOff, [CmmBlock])
    forall a. (a -> UniqSM a) -> UniqSM a
    forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
    mfix (((LabelMap StackMap, WordOff, [CmmBlock])
      -> UniqSM (LabelMap StackMap, WordOff, [CmmBlock]))
     -> UniqSM (LabelMap StackMap, WordOff, [CmmBlock]))
    -> ((LabelMap StackMap, WordOff, [CmmBlock])
        -> UniqSM (LabelMap StackMap, WordOff, [CmmBlock]))
    -> UniqSM (LabelMap StackMap, WordOff, [CmmBlock])
    forall a b. (a -> b) -> a -> b
    $ \ ~(LabelMap StackMap
    rec_stackmaps, WordOff
    rec_high_sp, [CmmBlock]
    _new_blocks) ->
                CmmConfig
    -> ProcPointSet
    -> BlockEntryLiveness LocalReg
    -> BlockId
    -> WordOff
    -> LabelMap StackMap
    -> WordOff
    -> [CmmBlock]
    -> UniqSM (LabelMap StackMap, WordOff, [CmmBlock])
    layout CmmConfig
    cfg ProcPointSet
    procpoints BlockEntryLiveness LocalReg
    liveness BlockId
    entry WordOff
    entry_args
                       LabelMap StackMap
    rec_stackmaps WordOff
    rec_high_sp [CmmBlock]
    blocks

        blocks_with_reloads <-
            insertReloadsAsNeeded platform procpoints final_stackmaps entry new_blocks
        new_blocks' <- mapM (lowerSafeForeignCall profile) blocks_with_reloads
        return (ofBlockList entry new_blocks', final_stackmaps)

    -- -----------------------------------------------------------------------------
    -- Pass 1
    -- -----------------------------------------------------------------------------

    layout :: CmmConfig
           -> LabelSet                      -- proc points
           -> LabelMap CmmLocalLive         -- liveness
           -> BlockId                       -- entry
           -> ByteOff                       -- stack args on entry

           -> LabelMap StackMap             -- [final] stack maps
           -> ByteOff                       -- [final] Sp high water mark

           -> [CmmBlock]                    -- [in] blocks

           -> UniqSM
              ( LabelMap StackMap           -- [out] stack maps
              , ByteOff                     -- [out] Sp high water mark
              , [CmmBlock]                  -- [out] new blocks
              )

    layout :: CmmConfig
    -> ProcPointSet
    -> BlockEntryLiveness LocalReg
    -> BlockId
    -> WordOff
    -> LabelMap StackMap
    -> WordOff
    -> [CmmBlock]
    -> UniqSM (LabelMap StackMap, WordOff, [CmmBlock])
    layout CmmConfig
    cfg ProcPointSet
    procpoints BlockEntryLiveness LocalReg
    liveness BlockId
    entry WordOff
    entry_args LabelMap StackMap
    final_stackmaps WordOff
    final_sp_high [CmmBlock]
    blocks
      = [CmmBlock]
    -> LabelMap StackMap
    -> WordOff
    -> [CmmBlock]
    -> UniqSM (LabelMap StackMap, WordOff, [CmmBlock])
    go [CmmBlock]
    blocks LabelMap StackMap
    init_stackmap WordOff
    entry_args []
      where
        (WordOff
    updfr, LabelMap WordOff
    cont_info)  = [CmmBlock] -> (WordOff, LabelMap WordOff)
    collectContInfo [CmmBlock]
    blocks

        init_stackmap :: LabelMap StackMap
    init_stackmap = BlockId -> StackMap -> LabelMap StackMap
    forall v. BlockId -> v -> LabelMap v
    mapSingleton BlockId
    entry StackMap{ sm_sp :: WordOff
    sm_sp   = WordOff
    entry_args
                                                   , sm_args :: WordOff
    sm_args = WordOff
    entry_args
                                                   , sm_ret_off :: WordOff
    sm_ret_off = WordOff
    updfr
                                                   , sm_regs :: UniqFM LocalReg (LocalReg, WordOff)
    sm_regs = UniqFM LocalReg (LocalReg, WordOff)
    forall {k} (key :: k) elt. UniqFM key elt
    emptyUFM
                                                   }

        go :: [CmmBlock]
    -> LabelMap StackMap
    -> WordOff
    -> [CmmBlock]
    -> UniqSM (LabelMap StackMap, WordOff, [CmmBlock])
    go [] LabelMap StackMap
    acc_stackmaps WordOff
    acc_hwm [CmmBlock]
    acc_blocks
          = (LabelMap StackMap, WordOff, [CmmBlock])
    -> UniqSM (LabelMap StackMap, WordOff, [CmmBlock])
    forall a. a -> UniqSM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LabelMap StackMap
    acc_stackmaps, WordOff
    acc_hwm, [CmmBlock]
    acc_blocks)

        go (CmmBlock
    b0 : [CmmBlock]
    bs) LabelMap StackMap
    acc_stackmaps WordOff
    acc_hwm [CmmBlock]
    acc_blocks
          = do
           let (entry0 :: CmmNode C O
    entry0@(CmmEntry BlockId
    entry_lbl CmmTickScope
    tscope), Block CmmNode O O
    middle0, CmmNode O C
    last0) = CmmBlock -> (CmmNode C O, Block CmmNode O O, CmmNode O C)
    forall (n :: Extensibility -> Extensibility -> *).
    Block n C C -> (n C O, Block n O O, n O C)
    blockSplit CmmBlock
    b0

           let stack0 :: StackMap
    stack0@StackMap { sm_sp :: StackMap -> WordOff
    sm_sp = WordOff
    sp0 }
                   = StackMap -> BlockId -> LabelMap StackMap -> StackMap
    forall a. a -> BlockId -> LabelMap a -> a
    mapFindWithDefault
                         (String -> SDoc -> StackMap
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "no stack map for" (BlockId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr BlockId
    entry_lbl))
                         BlockId
    entry_lbl LabelMap StackMap
    acc_stackmaps

           -- (a) Update the stack map to include the effects of
           --     assignments in this block
           let stack1 :: IndexedCO O StackMap StackMap
    stack1 = (forall (e :: Extensibility) (x :: Extensibility).
     CmmNode e x -> StackMap -> StackMap)
    -> forall (e :: Extensibility) (x :: Extensibility).
       Block CmmNode e x
       -> IndexedCO e StackMap StackMap -> IndexedCO x StackMap StackMap
    forall (n :: Extensibility -> Extensibility -> *) a.
    (forall (e :: Extensibility) (x :: Extensibility). n e x -> a -> a)
    -> forall (e :: Extensibility) (x :: Extensibility).
       Block n e x -> IndexedCO e a a -> IndexedCO x a a
    foldBlockNodesF (LabelMap StackMap -> CmmNode e x -> StackMap -> StackMap
    forall (e :: Extensibility) (x :: Extensibility).
    LabelMap StackMap -> CmmNode e x -> StackMap -> StackMap
    procMiddle LabelMap StackMap
    acc_stackmaps) Block CmmNode O O
    middle0 IndexedCO O StackMap StackMap
    StackMap
    stack0

           -- (b) Look at the last node and if we are making a call or
           --     jumping to a proc point, we must save the live
           --     variables, adjust Sp, and construct the StackMaps for
           --     each of the successor blocks.  See handleLastNode for
           --     details.
           (middle1, sp_off, last1, fixup_blocks, out)
               <- CmmConfig
    -> ProcPointSet
    -> BlockEntryLiveness LocalReg
    -> LabelMap WordOff
    -> LabelMap StackMap
    -> StackMap
    -> CmmTickScope
    -> Block CmmNode O O
    -> CmmNode O C
    -> UniqSM
         ([CmmNode O O], WordOff, CmmNode O C, [CmmBlock],
          LabelMap StackMap)
    handleLastNode CmmConfig
    cfg ProcPointSet
    procpoints BlockEntryLiveness LocalReg
    liveness LabelMap WordOff
    cont_info
                                 LabelMap StackMap
    acc_stackmaps IndexedCO O StackMap StackMap
    StackMap
    stack1 CmmTickScope
    tscope Block CmmNode O O
    middle0 CmmNode O C
    last0

           -- (c) Manifest Sp: run over the nodes in the block and replace
           --     CmmStackSlot with CmmLoad from Sp with a concrete offset.
           --
           -- our block:
           --    middle0          -- the original middle nodes
           --    middle1          -- live variable saves from handleLastNode
           --    Sp = Sp + sp_off -- Sp adjustment goes here
           --    last1            -- the last node
           --
           let middle_pre = Block CmmNode O O -> [CmmNode O O]
    forall (n :: Extensibility -> Extensibility -> *).
    Block n O O -> [n O O]
    blockToList (Block CmmNode O O -> [CmmNode O O])
    -> Block CmmNode O O -> [CmmNode O O]
    forall a b. (a -> b) -> a -> b
    $ (Block CmmNode O O -> CmmNode O O -> Block CmmNode O O)
    -> Block CmmNode O O -> [CmmNode O O] -> Block CmmNode O O
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' Block CmmNode O O -> CmmNode O O -> Block CmmNode O O
    forall (n :: Extensibility -> Extensibility -> *)
           (e :: Extensibility).
    Block n e O -> n O O -> Block n e O
    blockSnoc Block CmmNode O O
    middle0 [CmmNode O O]
    middle1

           let final_blocks =
                   CmmConfig
    -> LabelMap StackMap
    -> StackMap
    -> WordOff
    -> WordOff
    -> CmmNode C O
    -> [CmmNode O O]
    -> WordOff
    -> CmmNode O C
    -> [CmmBlock]
    -> [CmmBlock]
    manifestSp CmmConfig
    cfg LabelMap StackMap
    final_stackmaps StackMap
    stack0 WordOff
    sp0 WordOff
    final_sp_high
                              CmmNode C O
    entry0 [CmmNode O O]
    middle_pre WordOff
    sp_off CmmNode O C
    last1 [CmmBlock]
    fixup_blocks

           let acc_stackmaps' = LabelMap StackMap -> LabelMap StackMap -> LabelMap StackMap
    forall v. LabelMap v -> LabelMap v -> LabelMap v
    mapUnion LabelMap StackMap
    acc_stackmaps LabelMap StackMap
    out

               -- If this block jumps to the GC, then we do not take its
               -- stack usage into account for the high-water mark.
               -- Otherwise, if the only stack usage is in the stack-check
               -- failure block itself, we will do a redundant stack
               -- check.  The stack has a buffer designed to accommodate
               -- the largest amount of stack needed for calling the GC.
               --
               this_sp_hwm | CmmNode O C -> Bool
    isGcJump CmmNode O C
    last0 = WordOff
    0
                           | Bool
    otherwise      = WordOff
    sp0 WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    - WordOff
    sp_off

               hwm' = [WordOff] -> WordOff
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum (WordOff
    acc_hwm WordOff -> [WordOff] -> [WordOff]
    forall a. a -> [a] -> [a]
    : WordOff
    this_sp_hwm WordOff -> [WordOff] -> [WordOff]
    forall a. a -> [a] -> [a]
    : (StackMap -> WordOff) -> [StackMap] -> [WordOff]
    forall a b. (a -> b) -> [a] -> [b]
    map StackMap -> WordOff
    sm_sp (LabelMap StackMap -> [StackMap]
    forall a. LabelMap a -> [a]
    mapElems LabelMap StackMap
    out))

           go bs acc_stackmaps' hwm' (final_blocks ++ acc_blocks)

    -- -----------------------------------------------------------------------------

    -- Not foolproof, but GCFun is the culprit we most want to catch
    isGcJump :: CmmNode O C -> Bool
    isGcJump :: CmmNode O C -> Bool
    isGcJump (CmmCall { cml_target :: CmmNode O C -> CmmExpr
    cml_target = CmmReg (CmmGlobal (GlobalRegUse GlobalReg
    l CmmType
    _)) })
      = GlobalReg
    l GlobalReg -> GlobalReg -> Bool
    forall a. Eq a => a -> a -> Bool
    == GlobalReg
    GCFun Bool -> Bool -> Bool
    || GlobalReg
    l GlobalReg -> GlobalReg -> Bool
    forall a. Eq a => a -> a -> Bool
    == GlobalReg
    GCEnter1
    isGcJump CmmNode O C
    _something_else = Bool
    False

    -- -----------------------------------------------------------------------------

    -- This doesn't seem right somehow.  We need to find out whether this
    -- proc will push some update frame material at some point, so that we
    -- can avoid using that area of the stack for spilling. Ideally we would
    -- capture this information in the CmmProc (e.g. in CmmStackInfo; see #18232
    -- for details on one ill-fated attempt at this).
    --
    -- So we'll just take the max of all the cml_ret_offs.  This could be
    -- unnecessarily pessimistic, but probably not in the code we
    -- generate.

    collectContInfo :: [CmmBlock] -> (ByteOff, LabelMap ByteOff)
    collectContInfo :: [CmmBlock] -> (WordOff, LabelMap WordOff)
    collectContInfo [CmmBlock]
    blocks
      = ([WordOff] -> WordOff
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum [WordOff]
    ret_offs, [(BlockId, WordOff)] -> LabelMap WordOff
    forall v. [(BlockId, v)] -> LabelMap v
    mapFromList ([Maybe (BlockId, WordOff)] -> [(BlockId, WordOff)]
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe (BlockId, WordOff)]
    mb_argss))
     where
      ([Maybe (BlockId, WordOff)]
    mb_argss, [WordOff]
    ret_offs) = (CmmBlock -> (Maybe (BlockId, WordOff), WordOff))
    -> [CmmBlock] -> ([Maybe (BlockId, WordOff)], [WordOff])
    forall a b c. (a -> (b, c)) -> [a] -> ([b], [c])
    mapAndUnzip CmmBlock -> (Maybe (BlockId, WordOff), WordOff)
    forall (x :: Extensibility).
    Block CmmNode x C -> (Maybe (BlockId, WordOff), WordOff)
    get_cont [CmmBlock]
    blocks

      get_cont :: Block CmmNode x C -> (Maybe (Label, ByteOff), ByteOff)
      get_cont :: forall (x :: Extensibility).
    Block CmmNode x C -> (Maybe (BlockId, WordOff), WordOff)
    get_cont Block CmmNode x C
    b =
         case Block CmmNode x C -> CmmNode O C
    forall (n :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    Block n x C -> n O C
    lastNode Block CmmNode x C
    b of
            CmmCall { cml_cont :: CmmNode O C -> Maybe BlockId
    cml_cont = Just BlockId
    l, WordOff
    [GlobalReg]
    CmmExpr
    cml_target :: CmmNode O C -> CmmExpr
    cml_target :: CmmExpr
    cml_args_regs :: [GlobalReg]
    cml_args :: WordOff
    cml_ret_args :: WordOff
    cml_ret_off :: WordOff
    cml_ret_off :: CmmNode O C -> WordOff
    cml_ret_args :: CmmNode O C -> WordOff
    cml_args :: CmmNode O C -> WordOff
    cml_args_regs :: CmmNode O C -> [GlobalReg]
    .. }
               -> ((BlockId, WordOff) -> Maybe (BlockId, WordOff)
    forall a. a -> Maybe a
    Just (BlockId
    l, WordOff
    cml_ret_args), WordOff
    cml_ret_off)
            CmmForeignCall { Bool
    WordOff
    [LocalReg]
    [CmmExpr]
    BlockId
    ForeignTarget
    tgt :: ForeignTarget
    res :: [LocalReg]
    args :: [CmmExpr]
    succ :: BlockId
    ret_args :: WordOff
    ret_off :: WordOff
    intrbl :: Bool
    intrbl :: CmmNode O C -> Bool
    ret_off :: CmmNode O C -> WordOff
    ret_args :: CmmNode O C -> WordOff
    succ :: CmmNode O C -> BlockId
    args :: CmmNode O C -> [CmmExpr]
    res :: CmmNode O C -> [LocalReg]
    tgt :: CmmNode O C -> ForeignTarget
    .. }
               -> ((BlockId, WordOff) -> Maybe (BlockId, WordOff)
    forall a. a -> Maybe a
    Just (BlockId
    succ, WordOff
    ret_args), WordOff
    ret_off)
            CmmNode O C
    _other -> (Maybe (BlockId, WordOff)
    forall a. Maybe a
    Nothing, WordOff
    0)

    -- -----------------------------------------------------------------------------
    -- Updating the StackMap from middle nodes

    -- Look for loads from stack slots, and update the StackMap.  This is
    -- purely for optimisation reasons, so that we can avoid saving a
    -- variable back to a different stack slot if it is already on the
    -- stack.
    --
    -- This happens a lot: for example when function arguments are passed
    -- on the stack and need to be immediately saved across a call, we
    -- want to just leave them where they are on the stack.
    --
    procMiddle :: LabelMap StackMap -> CmmNode e x -> StackMap -> StackMap
    procMiddle :: forall (e :: Extensibility) (x :: Extensibility).
    LabelMap StackMap -> CmmNode e x -> StackMap -> StackMap
    procMiddle LabelMap StackMap
    stackmaps CmmNode e x
    node StackMap
    sm
      = case CmmNode e x
    node of
         CmmAssign (CmmLocal LocalReg
    r) (CmmLoad (CmmStackSlot Area
    area WordOff
    off) CmmType
    _ AlignmentSpec
    _)
           -> StackMap
    sm { sm_regs = addToUFM (sm_regs sm) r (r,loc) }
            where loc :: WordOff
    loc = Area -> WordOff -> LabelMap StackMap -> WordOff
    getStackLoc Area
    area WordOff
    off LabelMap StackMap
    stackmaps
         CmmAssign (CmmLocal LocalReg
    r) CmmExpr
    _other
           -> StackMap
    sm { sm_regs = delFromUFM (sm_regs sm) r }
         CmmNode e x
    _other
           -> StackMap
    sm

    getStackLoc :: Area -> ByteOff -> LabelMap StackMap -> StackLoc
    getStackLoc :: Area -> WordOff -> LabelMap StackMap -> WordOff
    getStackLoc Area
    Old       WordOff
    n LabelMap StackMap
    _         = WordOff
    n
    getStackLoc (Young BlockId
    l) WordOff
    n LabelMap StackMap
    stackmaps =
      case BlockId -> LabelMap StackMap -> Maybe StackMap
    forall a. BlockId -> LabelMap a -> Maybe a
    mapLookup BlockId
    l LabelMap StackMap
    stackmaps of
        Maybe StackMap
    Nothing -> String -> SDoc -> WordOff
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "getStackLoc" (BlockId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr BlockId
    l)
        Just StackMap
    sm -> StackMap -> WordOff
    sm_sp StackMap
    sm WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    - StackMap -> WordOff
    sm_args StackMap
    sm WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    + WordOff
    n

    -- -----------------------------------------------------------------------------
    -- Handling stack allocation for a last node

    -- We take a single last node and turn it into:
    --
    --    C1 (some statements)
    --    Sp = Sp + N
    --    C2 (some more statements)
    --    call f()          -- the actual last node
    --
    -- plus possibly some more blocks (we may have to add some fixup code
    -- between the last node and the continuation).
    --
    -- C1: is the code for saving the variables across this last node onto
    -- the stack, if the continuation is a call or jumps to a proc point.
    --
    -- C2: if the last node is a safe foreign call, we have to inject some
    -- extra code that goes *after* the Sp adjustment.

    handleLastNode
       :: CmmConfig -> ProcPointSet -> LabelMap CmmLocalLive -> LabelMap ByteOff
       -> LabelMap StackMap -> StackMap -> CmmTickScope
       -> Block CmmNode O O
       -> CmmNode O C
       -> UniqSM
          ( [CmmNode O O]      -- nodes to go *before* the Sp adjustment
          , ByteOff            -- amount to adjust Sp
          , CmmNode O C        -- new last node
          , [CmmBlock]         -- new blocks
          , LabelMap StackMap  -- stackmaps for the continuations
          )

    handleLastNode :: CmmConfig
    -> ProcPointSet
    -> BlockEntryLiveness LocalReg
    -> LabelMap WordOff
    -> LabelMap StackMap
    -> StackMap
    -> CmmTickScope
    -> Block CmmNode O O
    -> CmmNode O C
    -> UniqSM
         ([CmmNode O O], WordOff, CmmNode O C, [CmmBlock],
          LabelMap StackMap)
    handleLastNode CmmConfig
    cfg ProcPointSet
    procpoints BlockEntryLiveness LocalReg
    liveness LabelMap WordOff
    cont_info LabelMap StackMap
    stackmaps
                   stack0 :: StackMap
    stack0@StackMap { sm_sp :: StackMap -> WordOff
    sm_sp = WordOff
    sp0 } CmmTickScope
    tscp Block CmmNode O O
    middle CmmNode O C
    last
      = case CmmNode O C
    last of
          --  At each return / tail call,
          --  adjust Sp to point to the last argument pushed, which
          --  is cml_args, after popping any other junk from the stack.
          CmmCall{ cml_cont :: CmmNode O C -> Maybe BlockId
    cml_cont = Maybe BlockId
    Nothing, WordOff
    [GlobalReg]
    CmmExpr
    cml_target :: CmmNode O C -> CmmExpr
    cml_ret_off :: CmmNode O C -> WordOff
    cml_ret_args :: CmmNode O C -> WordOff
    cml_args :: CmmNode O C -> WordOff
    cml_args_regs :: CmmNode O C -> [GlobalReg]
    cml_target :: CmmExpr
    cml_args_regs :: [GlobalReg]
    cml_args :: WordOff
    cml_ret_args :: WordOff
    cml_ret_off :: WordOff
    .. } -> do
            let sp_off :: WordOff
    sp_off = WordOff
    sp0 WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    - WordOff
    cml_args
            ([CmmNode O O], WordOff, CmmNode O C, [CmmBlock],
     LabelMap StackMap)
    -> UniqSM
         ([CmmNode O O], WordOff, CmmNode O C, [CmmBlock],
          LabelMap StackMap)
    forall a. a -> UniqSM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], WordOff
    sp_off, CmmNode O C
    last, [], LabelMap StackMap
    forall v. LabelMap v
    mapEmpty)

          --  At each CmmCall with a continuation:
          CmmCall{ cml_cont :: CmmNode O C -> Maybe BlockId
    cml_cont = Just BlockId
    cont_lbl, WordOff
    [GlobalReg]
    CmmExpr
    cml_target :: CmmNode O C -> CmmExpr
    cml_ret_off :: CmmNode O C -> WordOff
    cml_ret_args :: CmmNode O C -> WordOff
    cml_args :: CmmNode O C -> WordOff
    cml_args_regs :: CmmNode O C -> [GlobalReg]
    cml_target :: CmmExpr
    cml_args_regs :: [GlobalReg]
    cml_args :: WordOff
    cml_ret_args :: WordOff
    cml_ret_off :: WordOff
    .. } ->
            ([CmmNode O O], WordOff, CmmNode O C, [CmmBlock],
     LabelMap StackMap)
    -> UniqSM
         ([CmmNode O O], WordOff, CmmNode O C, [CmmBlock],
          LabelMap StackMap)
    forall a. a -> UniqSM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (([CmmNode O O], WordOff, CmmNode O C, [CmmBlock],
      LabelMap StackMap)
     -> UniqSM
          ([CmmNode O O], WordOff, CmmNode O C, [CmmBlock],
           LabelMap StackMap))
    -> ([CmmNode O O], WordOff, CmmNode O C, [CmmBlock],
        LabelMap StackMap)
    -> UniqSM
         ([CmmNode O O], WordOff, CmmNode O C, [CmmBlock],
          LabelMap StackMap)
    forall a b. (a -> b) -> a -> b
    $ BlockId
    -> WordOff
    -> WordOff
    -> WordOff
    -> ([CmmNode O O], WordOff, CmmNode O C, [CmmBlock],
        LabelMap StackMap)
    lastCall BlockId
    cont_lbl WordOff
    cml_args WordOff
    cml_ret_args WordOff
    cml_ret_off

          CmmForeignCall{ succ :: CmmNode O C -> BlockId
    succ = BlockId
    cont_lbl, Bool
    WordOff
    [LocalReg]
    [CmmExpr]
    ForeignTarget
    intrbl :: CmmNode O C -> Bool
    ret_off :: CmmNode O C -> WordOff
    ret_args :: CmmNode O C -> WordOff
    args :: CmmNode O C -> [CmmExpr]
    res :: CmmNode O C -> [LocalReg]
    tgt :: CmmNode O C -> ForeignTarget
    tgt :: ForeignTarget
    res :: [LocalReg]
    args :: [CmmExpr]
    ret_args :: WordOff
    ret_off :: WordOff
    intrbl :: Bool
    .. } ->
            ([CmmNode O O], WordOff, CmmNode O C, [CmmBlock],
     LabelMap StackMap)
    -> UniqSM
         ([CmmNode O O], WordOff, CmmNode O C, [CmmBlock],
          LabelMap StackMap)
    forall a. a -> UniqSM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (([CmmNode O O], WordOff, CmmNode O C, [CmmBlock],
      LabelMap StackMap)
     -> UniqSM
          ([CmmNode O O], WordOff, CmmNode O C, [CmmBlock],
           LabelMap StackMap))
    -> ([CmmNode O O], WordOff, CmmNode O C, [CmmBlock],
        LabelMap StackMap)
    -> UniqSM
         ([CmmNode O O], WordOff, CmmNode O C, [CmmBlock],
          LabelMap StackMap)
    forall a b. (a -> b) -> a -> b
    $ BlockId
    -> WordOff
    -> WordOff
    -> WordOff
    -> ([CmmNode O O], WordOff, CmmNode O C, [CmmBlock],
        LabelMap StackMap)
    lastCall BlockId
    cont_lbl (Platform -> WordOff
    platformWordSizeInBytes Platform
    platform) WordOff
    ret_args WordOff
    ret_off
                  -- one word of args: the return address

          CmmBranch {}     ->  UniqSM
      ([CmmNode O O], WordOff, CmmNode O C, [CmmBlock],
       LabelMap StackMap)
    handleBranches
          CmmCondBranch {} ->  UniqSM
      ([CmmNode O O], WordOff, CmmNode O C, [CmmBlock],
       LabelMap StackMap)
    handleBranches
          CmmSwitch {}     ->  UniqSM
      ([CmmNode O O], WordOff, CmmNode O C, [CmmBlock],
       LabelMap StackMap)
    handleBranches
      where
         platform :: Platform
    platform = CmmConfig -> Platform
    cmmPlatform CmmConfig
    cfg
         -- Calls and ForeignCalls are handled the same way:
         lastCall :: BlockId -> ByteOff -> ByteOff -> ByteOff
                  -> ( [CmmNode O O]
                     , ByteOff
                     , CmmNode O C
                     , [CmmBlock]
                     , LabelMap StackMap
                     )
         lastCall :: BlockId
    -> WordOff
    -> WordOff
    -> WordOff
    -> ([CmmNode O O], WordOff, CmmNode O C, [CmmBlock],
        LabelMap StackMap)
    lastCall BlockId
    lbl WordOff
    cml_args WordOff
    cml_ret_args WordOff
    cml_ret_off
          =  ( [CmmNode O O]
    assignments
             , WordOff -> StackMap -> WordOff -> WordOff
    spOffsetForCall WordOff
    sp0 StackMap
    cont_stack WordOff
    cml_args
             , CmmNode O C
    last
             , [] -- no new blocks
             , BlockId -> StackMap -> LabelMap StackMap
    forall v. BlockId -> v -> LabelMap v
    mapSingleton BlockId
    lbl StackMap
    cont_stack )
          where
             ([CmmNode O O]
    assignments, StackMap
    cont_stack) = BlockId -> WordOff -> WordOff -> ([CmmNode O O], StackMap)
    prepareStack BlockId
    lbl WordOff
    cml_ret_args WordOff
    cml_ret_off

         prepareStack :: BlockId -> WordOff -> WordOff -> ([CmmNode O O], StackMap)
    prepareStack BlockId
    lbl WordOff
    cml_ret_args WordOff
    cml_ret_off
           | Just StackMap
    cont_stack <- BlockId -> LabelMap StackMap -> Maybe StackMap
    forall a. BlockId -> LabelMap a -> Maybe a
    mapLookup BlockId
    lbl LabelMap StackMap
    stackmaps
                 -- If we have already seen this continuation before, then
                 -- we just have to make the stack look the same:
           = (StackMap -> StackMap -> [CmmNode O O]
    fixupStack StackMap
    stack0 StackMap
    cont_stack, StackMap
    cont_stack)
                 -- Otherwise, we have to allocate the stack frame
           | Bool
    otherwise
           = ([CmmNode O O]
    save_assignments, StackMap
    new_cont_stack)
           where
            (StackMap
    new_cont_stack, [CmmNode O O]
    save_assignments)
               = Platform
    -> BlockId
    -> BlockEntryLiveness LocalReg
    -> WordOff
    -> WordOff
    -> StackMap
    -> (StackMap, [CmmNode O O])
    setupStackFrame Platform
    platform BlockId
    lbl BlockEntryLiveness LocalReg
    liveness WordOff
    cml_ret_off WordOff
    cml_ret_args StackMap
    stack0

         -- For other last nodes (branches), if any of the targets is a
         -- proc point, we have to set up the stack to match what the proc
         -- point is expecting.
         --
         handleBranches :: UniqSM ( [CmmNode O O]
                                    , ByteOff
                                    , CmmNode O C
                                    , [CmmBlock]
                                    , LabelMap StackMap )

         handleBranches :: UniqSM
      ([CmmNode O O], WordOff, CmmNode O C, [CmmBlock],
       LabelMap StackMap)
    handleBranches
             -- See Note [diamond proc point]
           | Just BlockId
    l <- Block CmmNode O O -> Maybe BlockId
    futureContinuation Block CmmNode O O
    middle
           , ([BlockId] -> [BlockId]
    forall a. Eq a => [a] -> [a]
    nub ([BlockId] -> [BlockId]) -> [BlockId] -> [BlockId]
    forall a b. (a -> b) -> a -> b
    $ (BlockId -> Bool) -> [BlockId] -> [BlockId]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (BlockId -> ProcPointSet -> Bool
    `setMember` ProcPointSet
    procpoints) ([BlockId] -> [BlockId]) -> [BlockId] -> [BlockId]
    forall a b. (a -> b) -> a -> b
    $ CmmNode O C -> [BlockId]
    forall (e :: Extensibility). CmmNode e C -> [BlockId]
    forall (thing :: Extensibility -> Extensibility -> *)
           (e :: Extensibility).
    NonLocal thing =>
    thing e C -> [BlockId]
    successors CmmNode O C
    last) [BlockId] -> [BlockId] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [BlockId
    l]
           = do
             let cont_args :: WordOff
    cont_args = WordOff -> BlockId -> LabelMap WordOff -> WordOff
    forall a. a -> BlockId -> LabelMap a -> a
    mapFindWithDefault WordOff
    0 BlockId
    l LabelMap WordOff
    cont_info
                 ([CmmNode O O]
    assigs, StackMap
    cont_stack) = BlockId -> WordOff -> WordOff -> ([CmmNode O O], StackMap)
    prepareStack BlockId
    l WordOff
    cont_args (StackMap -> WordOff
    sm_ret_off StackMap
    stack0)
                 out :: LabelMap StackMap
    out = [(BlockId, StackMap)] -> LabelMap StackMap
    forall v. [(BlockId, v)] -> LabelMap v
    mapFromList [ (BlockId
    l', StackMap
    cont_stack)
                                   | BlockId
    l' <- CmmNode O C -> [BlockId]
    forall (e :: Extensibility). CmmNode e C -> [BlockId]
    forall (thing :: Extensibility -> Extensibility -> *)
           (e :: Extensibility).
    NonLocal thing =>
    thing e C -> [BlockId]
    successors CmmNode O C
    last ]
             ([CmmNode O O], WordOff, CmmNode O C, [CmmBlock],
     LabelMap StackMap)
    -> UniqSM
         ([CmmNode O O], WordOff, CmmNode O C, [CmmBlock],
          LabelMap StackMap)
    forall a. a -> UniqSM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ( [CmmNode O O]
    assigs
                    , WordOff -> StackMap -> WordOff -> WordOff
    spOffsetForCall WordOff
    sp0 StackMap
    cont_stack (Platform -> WordOff
    platformWordSizeInBytes Platform
    platform)
                    , CmmNode O C
    last
                    , []
                    , LabelMap StackMap
    out)

            | Bool
    otherwise = do
              pps <- (BlockId -> UniqSM (BlockId, BlockId, StackMap, [CmmBlock]))
    -> [BlockId] -> UniqSM [(BlockId, BlockId, StackMap, [CmmBlock])]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM BlockId -> UniqSM (BlockId, BlockId, StackMap, [CmmBlock])
    handleBranch (CmmNode O C -> [BlockId]
    forall (e :: Extensibility). CmmNode e C -> [BlockId]
    forall (thing :: Extensibility -> Extensibility -> *)
           (e :: Extensibility).
    NonLocal thing =>
    thing e C -> [BlockId]
    successors CmmNode O C
    last)
              let lbl_map :: LabelMap Label
                  lbl_map = [(BlockId, BlockId)] -> LabelMap BlockId
    forall v. [(BlockId, v)] -> LabelMap v
    mapFromList [ (BlockId
    l,BlockId
    tmp) | (BlockId
    l,BlockId
    tmp,StackMap
    _,[CmmBlock]
    _) <- [(BlockId, BlockId, StackMap, [CmmBlock])]
    pps ]
                  fix_lbl BlockId
    l = BlockId -> BlockId -> LabelMap BlockId -> BlockId
    forall a. a -> BlockId -> LabelMap a -> a
    mapFindWithDefault BlockId
    l BlockId
    l LabelMap BlockId
    lbl_map
              return ( []
                     , 0
                     , mapSuccessors fix_lbl last
                     , concat [ blk | (_,_,_,blk) <- pps ]
                     , mapFromList [ (l, sm) | (l,_,sm,_) <- pps ] )

         -- For each successor of this block
         handleBranch :: BlockId -> UniqSM (BlockId, BlockId, StackMap, [CmmBlock])
         handleBranch :: BlockId -> UniqSM (BlockId, BlockId, StackMap, [CmmBlock])
    handleBranch BlockId
    l
            --   (a) if the successor already has a stackmap, we need to
            --       shuffle the current stack to make it look the same.
            --       We have to insert a new block to make this happen.
            | Just StackMap
    stack2 <- BlockId -> LabelMap StackMap -> Maybe StackMap
    forall a. BlockId -> LabelMap a -> Maybe a
    mapLookup BlockId
    l LabelMap StackMap
    stackmaps
            = do
                 let assigs :: [CmmNode O O]
    assigs = StackMap -> StackMap -> [CmmNode O O]
    fixupStack StackMap
    stack0 StackMap
    stack2
                 (tmp_lbl, block) <- CmmConfig
    -> WordOff
    -> BlockId
    -> StackMap
    -> CmmTickScope
    -> [CmmNode O O]
    -> UniqSM (BlockId, [CmmBlock])
    makeFixupBlock CmmConfig
    cfg WordOff
    sp0 BlockId
    l StackMap
    stack2 CmmTickScope
    tscp [CmmNode O O]
    assigs
                 return (l, tmp_lbl, stack2, block)

            --   (b) if the successor is a proc point, save everything
            --       on the stack.
            | BlockId
    l BlockId -> ProcPointSet -> Bool
    `setMember` ProcPointSet
    procpoints
            = do
                 let cont_args :: WordOff
    cont_args = WordOff -> BlockId -> LabelMap WordOff -> WordOff
    forall a. a -> BlockId -> LabelMap a -> a
    mapFindWithDefault WordOff
    0 BlockId
    l LabelMap WordOff
    cont_info
                     (StackMap
    stack2, [CmmNode O O]
    assigs) =
                          Platform
    -> BlockId
    -> BlockEntryLiveness LocalReg
    -> WordOff
    -> WordOff
    -> StackMap
    -> (StackMap, [CmmNode O O])
    setupStackFrame Platform
    platform BlockId
    l BlockEntryLiveness LocalReg
    liveness (StackMap -> WordOff
    sm_ret_off StackMap
    stack0)
                                                            WordOff
    cont_args StackMap
    stack0
                 (tmp_lbl, block) <- CmmConfig
    -> WordOff
    -> BlockId
    -> StackMap
    -> CmmTickScope
    -> [CmmNode O O]
    -> UniqSM (BlockId, [CmmBlock])
    makeFixupBlock CmmConfig
    cfg WordOff
    sp0 BlockId
    l StackMap
    stack2 CmmTickScope
    tscp [CmmNode O O]
    assigs
                 return (l, tmp_lbl, stack2, block)

            --   (c) otherwise, the current StackMap is the StackMap for
            --       the continuation.  But we must remember to remove any
            --       variables from the StackMap that are *not* live at
            --       the destination, because this StackMap might be used
            --       by fixupStack if this is a join point.
            | Bool
    otherwise = (BlockId, BlockId, StackMap, [CmmBlock])
    -> UniqSM (BlockId, BlockId, StackMap, [CmmBlock])
    forall a. a -> UniqSM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (BlockId
    l, BlockId
    l, StackMap
    stack1, [])
            where live :: CmmLocalLive
    live = CmmLocalLive
    -> BlockId -> BlockEntryLiveness LocalReg -> CmmLocalLive
    forall a. a -> BlockId -> LabelMap a -> a
    mapFindWithDefault (String -> CmmLocalLive
    forall a. HasCallStack => String -> a
    panic String
    "handleBranch") BlockId
    l BlockEntryLiveness LocalReg
    liveness
                  stack1 :: StackMap
    stack1 = StackMap
    stack0 { sm_regs = filterUFM is_live (sm_regs stack0) }
                  is_live :: (LocalReg, WordOff) -> Bool
    is_live (LocalReg
    r,WordOff
    _) = LocalReg
    r LocalReg -> CmmLocalLive -> Bool
    forall r. Ord r => r -> RegSet r -> Bool
    `elemRegSet` CmmLocalLive
    live

    makeFixupBlock :: CmmConfig -> ByteOff -> Label -> StackMap
                   -> CmmTickScope -> [CmmNode O O]
                   -> UniqSM (Label, [CmmBlock])
    makeFixupBlock :: CmmConfig
    -> WordOff
    -> BlockId
    -> StackMap
    -> CmmTickScope
    -> [CmmNode O O]
    -> UniqSM (BlockId, [CmmBlock])
    makeFixupBlock CmmConfig
    cfg WordOff
    sp0 BlockId
    l StackMap
    stack CmmTickScope
    tscope [CmmNode O O]
    assigs
      | [CmmNode O O] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [CmmNode O O]
    assigs Bool -> Bool -> Bool
    && WordOff
    sp0 WordOff -> WordOff -> Bool
    forall a. Eq a => a -> a -> Bool
    == StackMap -> WordOff
    sm_sp StackMap
    stack = (BlockId, [CmmBlock]) -> UniqSM (BlockId, [CmmBlock])
    forall a. a -> UniqSM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (BlockId
    l, [])
      | Bool
    otherwise = do
        tmp_lbl <- UniqSM BlockId
    forall (m :: * -> *). MonadUnique m => m BlockId
    newBlockId
        let sp_off = WordOff
    sp0 WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    - StackMap -> WordOff
    sm_sp StackMap
    stack
            block = CmmNode C O -> Block CmmNode O O -> CmmNode O C -> CmmBlock
    forall (n :: Extensibility -> Extensibility -> *).
    n C O -> Block n O O -> n O C -> Block n C C
    blockJoin (BlockId -> CmmTickScope -> CmmNode C O
    CmmEntry BlockId
    tmp_lbl CmmTickScope
    tscope)
                              ( CmmConfig
    -> WordOff -> WordOff -> Block CmmNode O O -> Block CmmNode O O
    maybeAddSpAdj CmmConfig
    cfg WordOff
    sp0 WordOff
    sp_off
                               (Block CmmNode O O -> Block CmmNode O O)
    -> Block CmmNode O O -> Block CmmNode O O
    forall a b. (a -> b) -> a -> b
    $ [CmmNode O O] -> Block CmmNode O O
    forall (n :: Extensibility -> Extensibility -> *).
    [n O O] -> Block n O O
    blockFromList [CmmNode O O]
    assigs )
                              (BlockId -> CmmNode O C
    CmmBranch BlockId
    l)
        return (tmp_lbl, [block])

    -- Sp is currently pointing to current_sp,
    -- we want it to point to
    --    (sm_sp cont_stack - sm_args cont_stack + args)
    -- so the difference is
    --    sp0 - (sm_sp cont_stack - sm_args cont_stack + args)
    spOffsetForCall :: ByteOff -> StackMap -> ByteOff -> ByteOff
    spOffsetForCall :: WordOff -> StackMap -> WordOff -> WordOff
    spOffsetForCall WordOff
    current_sp StackMap
    cont_stack WordOff
    args
      = WordOff
    current_sp WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    - (StackMap -> WordOff
    sm_sp StackMap
    cont_stack WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    - StackMap -> WordOff
    sm_args StackMap
    cont_stack WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    + WordOff
    args)

    -- | create a sequence of assignments to establish the new StackMap,
    -- given the old StackMap.
    fixupStack :: StackMap -> StackMap -> [CmmNode O O]
    fixupStack :: StackMap -> StackMap -> [CmmNode O O]
    fixupStack StackMap
    old_stack StackMap
    new_stack = ((LocalReg, WordOff) -> [CmmNode O O])
    -> [(LocalReg, WordOff)] -> [CmmNode O O]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (LocalReg, WordOff) -> [CmmNode O O]
    move [(LocalReg, WordOff)]
    new_locs
     where
         old_map :: UniqFM LocalReg (LocalReg, WordOff)
    old_map  = StackMap -> UniqFM LocalReg (LocalReg, WordOff)
    sm_regs StackMap
    old_stack
         new_locs :: [(LocalReg, WordOff)]
    new_locs = StackMap -> [(LocalReg, WordOff)]
    stackSlotRegs StackMap
    new_stack

         move :: (LocalReg, WordOff) -> [CmmNode O O]
    move (LocalReg
    r,WordOff
    n)
           | Just (LocalReg
    _,WordOff
    m) <- UniqFM LocalReg (LocalReg, WordOff)
    -> LocalReg -> Maybe (LocalReg, WordOff)
    forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
    lookupUFM UniqFM LocalReg (LocalReg, WordOff)
    old_map LocalReg
    r, WordOff
    n WordOff -> WordOff -> Bool
    forall a. Eq a => a -> a -> Bool
    == WordOff
    m = []
           | Bool
    otherwise = [CmmExpr -> CmmExpr -> AlignmentSpec -> CmmNode O O
    CmmStore (Area -> WordOff -> CmmExpr
    CmmStackSlot Area
    Old WordOff
    n)
                                   (CmmReg -> CmmExpr
    CmmReg (LocalReg -> CmmReg
    CmmLocal LocalReg
    r))
                                   AlignmentSpec
    NaturallyAligned]

    setupStackFrame
                 :: Platform
                 -> BlockId                 -- label of continuation
                 -> LabelMap CmmLocalLive   -- liveness
                 -> ByteOff      -- updfr
                 -> ByteOff      -- bytes of return values on stack
                 -> StackMap     -- current StackMap
                 -> (StackMap, [CmmNode O O])

    setupStackFrame :: Platform
    -> BlockId
    -> BlockEntryLiveness LocalReg
    -> WordOff
    -> WordOff
    -> StackMap
    -> (StackMap, [CmmNode O O])
    setupStackFrame Platform
    platform BlockId
    lbl BlockEntryLiveness LocalReg
    liveness WordOff
    updfr_off WordOff
    ret_args StackMap
    stack0
      = (StackMap
    cont_stack, [CmmNode O O]
    assignments)
      where
          -- get the set of LocalRegs live in the continuation
          live :: CmmLocalLive
    live = CmmLocalLive
    -> BlockId -> BlockEntryLiveness LocalReg -> CmmLocalLive
    forall a. a -> BlockId -> LabelMap a -> a
    mapFindWithDefault CmmLocalLive
    forall a. Set a
    Set.empty BlockId
    lbl BlockEntryLiveness LocalReg
    liveness

          -- the stack from the base to updfr_off is off-limits.
          -- our new stack frame contains:
          --   * saved live variables
          --   * the return address [young(C) + 8]
          --   * the args for the call,
          --     which are replaced by the return values at the return
          --     point.

          -- everything up to updfr_off is off-limits
          -- stack1 contains updfr_off, plus everything we need to save
          (StackMap
    stack1, [CmmNode O O]
    assignments) = Platform
    -> WordOff -> CmmLocalLive -> StackMap -> (StackMap, [CmmNode O O])
    allocate Platform
    platform WordOff
    updfr_off CmmLocalLive
    live StackMap
    stack0

          -- And the Sp at the continuation is:
          --   sm_sp stack1 + ret_args
          cont_stack :: StackMap
    cont_stack = StackMap
    stack1{ sm_sp = sm_sp stack1 + ret_args
                             , sm_args = ret_args
                             , sm_ret_off = updfr_off
                             }

    -- Note [diamond proc point]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~
    -- This special case looks for the pattern we get from a typical
    -- tagged case expression:
    --
    --    Sp[young(L1)] = L1
    --    if (R1 & 7) != 0 goto L1 else goto L2
    --  L2:
    --    call [R1] returns to L1
    --  L1: live: {y}
    --    x = R1
    --
    -- If we let the generic case handle this, we get
    --
    --    Sp[-16] = L1
    --    if (R1 & 7) != 0 goto L1a else goto L2
    --  L2:
    --    Sp[-8] = y
    --    Sp = Sp - 16
    --    call [R1] returns to L1
    --  L1a:
    --    Sp[-8] = y
    --    Sp = Sp - 16
    --    goto L1
    --  L1:
    --    x = R1
    --
    -- The code for saving the live vars is duplicated in each branch, and
    -- furthermore there is an extra jump in the fast path (assuming L1 is
    -- a proc point, which it probably is if there is a heap check).
    --
    -- So to fix this we want to set up the stack frame before the
    -- conditional jump.  How do we know when to do this, and when it is
    -- safe?  The basic idea is, when we see the assignment
    --
    --   Sp[young(L)] = L
    --
    -- we know that
    --   * we are definitely heading for L
    --   * there can be no more reads from another stack area, because young(L)
    --     overlaps with it.
    --
    -- We don't necessarily know that everything live at L is live now
    -- (some might be assigned between here and the jump to L).  So we
    -- simplify and only do the optimisation when we see
    --
    --   (1) a block containing an assignment of a return address L
    --   (2) ending in a branch where one (and only) continuation goes to L,
    --       and no other continuations go to proc points.
    --
    -- then we allocate the stack frame for L at the end of the block,
    -- before the branch.
    --
    -- We could generalise (2), but that would make it a bit more
    -- complicated to handle, and this currently catches the common case.

    futureContinuation :: Block CmmNode O O -> Maybe BlockId
    futureContinuation :: Block CmmNode O O -> Maybe BlockId
    futureContinuation Block CmmNode O O
    middle = (forall (e :: Extensibility) (x :: Extensibility).
     CmmNode e x -> Maybe BlockId -> Maybe BlockId)
    -> forall (e :: Extensibility) (x :: Extensibility).
       Block CmmNode e x
       -> IndexedCO x (Maybe BlockId) (Maybe BlockId)
       -> IndexedCO e (Maybe BlockId) (Maybe BlockId)
    forall (n :: Extensibility -> Extensibility -> *) a.
    (forall (e :: Extensibility) (x :: Extensibility). n e x -> a -> a)
    -> forall (e :: Extensibility) (x :: Extensibility).
       Block n e x -> IndexedCO x a a -> IndexedCO e a a
    foldBlockNodesB CmmNode e x -> Maybe BlockId -> Maybe BlockId
    forall (e :: Extensibility) (x :: Extensibility).
    CmmNode e x -> Maybe BlockId -> Maybe BlockId
    f Block CmmNode O O
    middle Maybe BlockId
    IndexedCO O (Maybe BlockId) (Maybe BlockId)
    forall a. Maybe a
    Nothing
       where f :: CmmNode a b -> Maybe BlockId -> Maybe BlockId
             f :: forall (e :: Extensibility) (x :: Extensibility).
    CmmNode e x -> Maybe BlockId -> Maybe BlockId
    f (CmmStore (CmmStackSlot (Young BlockId
    l) WordOff
    _) (CmmLit (CmmBlock BlockId
    _)) AlignmentSpec
    _) Maybe BlockId
    _
                   = BlockId -> Maybe BlockId
    forall a. a -> Maybe a
    Just BlockId
    l
             f CmmNode a b
    _ Maybe BlockId
    r = Maybe BlockId
    r

    -- -----------------------------------------------------------------------------
    -- Saving live registers

    -- | Given a set of live registers and a StackMap, save all the registers
    -- on the stack and return the new StackMap and the assignments to do
    -- the saving.
    --
    allocate :: Platform -> ByteOff -> LocalRegSet -> StackMap
             -> (StackMap, [CmmNode O O])
    allocate :: Platform
    -> WordOff -> CmmLocalLive -> StackMap -> (StackMap, [CmmNode O O])
    allocate Platform
    platform WordOff
    ret_off CmmLocalLive
    live stackmap :: StackMap
    stackmap@StackMap{ sm_sp :: StackMap -> WordOff
    sm_sp = WordOff
    sp0
                                                  , sm_regs :: StackMap -> UniqFM LocalReg (LocalReg, WordOff)
    sm_regs = UniqFM LocalReg (LocalReg, WordOff)
    regs0 }
     =
       -- we only have to save regs that are not already in a slot
       let to_save :: [LocalReg]
    to_save = (LocalReg -> Bool) -> [LocalReg] -> [LocalReg]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (LocalReg -> Bool) -> LocalReg -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (LocalReg -> UniqFM LocalReg (LocalReg, WordOff) -> Bool
    forall key elt. Uniquable key => key -> UniqFM key elt -> Bool
    `elemUFM` UniqFM LocalReg (LocalReg, WordOff)
    regs0)) (CmmLocalLive -> [LocalReg]
    forall a. Set a -> [a]
    Set.elems CmmLocalLive
    live)
           regs1 :: UniqFM LocalReg (LocalReg, WordOff)
    regs1   = ((LocalReg, WordOff) -> Bool)
    -> UniqFM LocalReg (LocalReg, WordOff)
    -> UniqFM LocalReg (LocalReg, WordOff)
    forall {k} elt (key :: k).
    (elt -> Bool) -> UniqFM key elt -> UniqFM key elt
    filterUFM (\(LocalReg
    r,WordOff
    _) -> LocalReg -> CmmLocalLive -> Bool
    forall r. Ord r => r -> RegSet r -> Bool
    elemRegSet LocalReg
    r CmmLocalLive
    live) UniqFM LocalReg (LocalReg, WordOff)
    regs0
       in

       -- make a map of the stack
       let stack :: [StackSlot]
    stack = [StackSlot] -> [StackSlot]
    forall a. [a] -> [a]
    reverse ([StackSlot] -> [StackSlot]) -> [StackSlot] -> [StackSlot]
    forall a b. (a -> b) -> a -> b
    $ Array WordOff StackSlot -> [StackSlot]
    forall i e. Array i e -> [e]
    Array.elems (Array WordOff StackSlot -> [StackSlot])
    -> Array WordOff StackSlot -> [StackSlot]
    forall a b. (a -> b) -> a -> b
    $
                   (StackSlot -> StackSlot -> StackSlot)
    -> StackSlot
    -> (WordOff, WordOff)
    -> [(WordOff, StackSlot)]
    -> Array WordOff StackSlot
    forall i e a.
    Ix i =>
    (e -> a -> e) -> e -> (i, i) -> [(i, a)] -> Array i e
    accumArray (\StackSlot
    _ StackSlot
    x -> StackSlot
    x) StackSlot
    Empty (WordOff
    1, Platform -> WordOff -> WordOff
    toWords Platform
    platform (WordOff -> WordOff -> WordOff
    forall a. Ord a => a -> a -> a
    max WordOff
    sp0 WordOff
    ret_off)) ([(WordOff, StackSlot)] -> Array WordOff StackSlot)
    -> [(WordOff, StackSlot)] -> Array WordOff StackSlot
    forall a b. (a -> b) -> a -> b
    $
                     [(WordOff, StackSlot)]
    ret_words [(WordOff, StackSlot)]
    -> [(WordOff, StackSlot)] -> [(WordOff, StackSlot)]
    forall a. [a] -> [a] -> [a]
    ++ [(WordOff, StackSlot)]
    live_words
                where ret_words :: [(WordOff, StackSlot)]
    ret_words =
                       [ (WordOff
    x, StackSlot
    Occupied)
                       | WordOff
    x <- [ WordOff
    1 .. Platform -> WordOff -> WordOff
    toWords Platform
    platform WordOff
    ret_off] ]
                      live_words :: [(WordOff, StackSlot)]
    live_words =
                       [ (Platform -> WordOff -> WordOff
    toWords Platform
    platform WordOff
    x, StackSlot
    Occupied)
                       | (LocalReg
    r,WordOff
    off) <- UniqFM LocalReg (LocalReg, WordOff) -> [(LocalReg, WordOff)]
    forall {k} (key :: k) elt. UniqFM key elt -> [elt]
    nonDetEltsUFM UniqFM LocalReg (LocalReg, WordOff)
    regs1,
                       -- See Note [Unique Determinism and code generation]
                         let w :: WordOff
    w = Platform -> LocalReg -> WordOff
    localRegBytes Platform
    platform LocalReg
    r,
                         WordOff
    x <- [ WordOff
    off, WordOff
    off WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    - Platform -> WordOff
    platformWordSizeInBytes Platform
    platform .. WordOff
    off WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    - WordOff
    w WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    + WordOff
    1] ]
       in

       -- Pass over the stack: find slots to save all the new live variables,
       -- choosing the oldest slots first (hence a foldr).
       let
           save :: StackSlot
    -> ([LocalReg], [StackSlot], WordOff, [CmmNode O O],
        [(LocalReg, (LocalReg, WordOff))])
    -> ([LocalReg], [StackSlot], WordOff, [CmmNode O O],
        [(LocalReg, (LocalReg, WordOff))])
    save StackSlot
    slot ([], [StackSlot]
    stack, WordOff
    n, [CmmNode O O]
    assigs, [(LocalReg, (LocalReg, WordOff))]
    regs) -- no more regs to save
              = ([], StackSlot
    slotStackSlot -> [StackSlot] -> [StackSlot]
    forall a. a -> [a] -> [a]
    :[StackSlot]
    stack, Platform -> WordOff -> WordOff -> WordOff
    plusW Platform
    platform WordOff
    n WordOff
    1, [CmmNode O O]
    assigs, [(LocalReg, (LocalReg, WordOff))]
    regs)
           save StackSlot
    slot ([LocalReg]
    to_save, [StackSlot]
    stack, WordOff
    n, [CmmNode O O]
    assigs, [(LocalReg, (LocalReg, WordOff))]
    regs)
              = case StackSlot
    slot of
                   StackSlot
    Occupied ->  ([LocalReg]
    to_save, StackSlot
    OccupiedStackSlot -> [StackSlot] -> [StackSlot]
    forall a. a -> [a] -> [a]
    :[StackSlot]
    stack, Platform -> WordOff -> WordOff -> WordOff
    plusW Platform
    platform WordOff
    n WordOff
    1, [CmmNode O O]
    assigs, [(LocalReg, (LocalReg, WordOff))]
    regs)
                   StackSlot
    Empty
                     | Just ([StackSlot]
    stack', LocalReg
    r, [LocalReg]
    to_save') <-
                           [LocalReg]
    -> [StackSlot] -> Maybe ([StackSlot], LocalReg, [LocalReg])
    select_save [LocalReg]
    to_save (StackSlot
    slotStackSlot -> [StackSlot] -> [StackSlot]
    forall a. a -> [a] -> [a]
    :[StackSlot]
    stack)
                     -> let assig :: CmmNode O O
    assig = CmmExpr -> CmmExpr -> AlignmentSpec -> CmmNode O O
    CmmStore (Area -> WordOff -> CmmExpr
    CmmStackSlot Area
    Old WordOff
    n')
                                             (CmmReg -> CmmExpr
    CmmReg (LocalReg -> CmmReg
    CmmLocal LocalReg
    r))
                                             AlignmentSpec
    NaturallyAligned
                            n' :: WordOff
    n' = Platform -> WordOff -> WordOff -> WordOff
    plusW Platform
    platform WordOff
    n WordOff
    1
                       in
                            ([LocalReg]
    to_save', [StackSlot]
    stack', WordOff
    n', CmmNode O O
    assig CmmNode O O -> [CmmNode O O] -> [CmmNode O O]
    forall a. a -> [a] -> [a]
    : [CmmNode O O]
    assigs, (LocalReg
    r,(LocalReg
    r,WordOff
    n'))(LocalReg, (LocalReg, WordOff))
    -> [(LocalReg, (LocalReg, WordOff))]
    -> [(LocalReg, (LocalReg, WordOff))]
    forall a. a -> [a] -> [a]
    :[(LocalReg, (LocalReg, WordOff))]
    regs)

                     | Bool
    otherwise
                     -> ([LocalReg]
    to_save, StackSlot
    slotStackSlot -> [StackSlot] -> [StackSlot]
    forall a. a -> [a] -> [a]
    :[StackSlot]
    stack, Platform -> WordOff -> WordOff -> WordOff
    plusW Platform
    platform WordOff
    n WordOff
    1, [CmmNode O O]
    assigs, [(LocalReg, (LocalReg, WordOff))]
    regs)

           -- we should do better here: right now we'll fit the smallest first,
           -- but it would make more sense to fit the biggest first.
           select_save :: [LocalReg] -> [StackSlot]
                       -> Maybe ([StackSlot], LocalReg, [LocalReg])
           select_save :: [LocalReg]
    -> [StackSlot] -> Maybe ([StackSlot], LocalReg, [LocalReg])
    select_save [LocalReg]
    regs [StackSlot]
    stack = [LocalReg]
    -> [LocalReg] -> Maybe ([StackSlot], LocalReg, [LocalReg])
    go [LocalReg]
    regs []
             where go :: [LocalReg]
    -> [LocalReg] -> Maybe ([StackSlot], LocalReg, [LocalReg])
    go []     [LocalReg]
    _no_fit = Maybe ([StackSlot], LocalReg, [LocalReg])
    forall a. Maybe a
    Nothing
                   go (LocalReg
    r:[LocalReg]
    rs) [LocalReg]
    no_fit
                     | Just [StackSlot]
    rest <- WordOff -> [StackSlot] -> Maybe [StackSlot]
    dropEmpty WordOff
    words [StackSlot]
    stack
                     = ([StackSlot], LocalReg, [LocalReg])
    -> Maybe ([StackSlot], LocalReg, [LocalReg])
    forall a. a -> Maybe a
    Just (WordOff -> StackSlot -> [StackSlot]
    forall a. WordOff -> a -> [a]
    replicate WordOff
    words StackSlot
    Occupied [StackSlot] -> [StackSlot] -> [StackSlot]
    forall a. [a] -> [a] -> [a]
    ++ [StackSlot]
    rest, LocalReg
    r, [LocalReg]
    rs[LocalReg] -> [LocalReg] -> [LocalReg]
    forall a. [a] -> [a] -> [a]
    ++[LocalReg]
    no_fit)
                     | Bool
    otherwise
                     = [LocalReg]
    -> [LocalReg] -> Maybe ([StackSlot], LocalReg, [LocalReg])
    go [LocalReg]
    rs (LocalReg
    rLocalReg -> [LocalReg] -> [LocalReg]
    forall a. a -> [a] -> [a]
    :[LocalReg]
    no_fit)
                     where words :: WordOff
    words = Platform -> LocalReg -> WordOff
    localRegWords Platform
    platform LocalReg
    r

           -- fill in empty slots as much as possible
           ([LocalReg]
    still_to_save, [StackSlot]
    save_stack, WordOff
    n, [CmmNode O O]
    save_assigs, [(LocalReg, (LocalReg, WordOff))]
    save_regs)
              = (StackSlot
     -> ([LocalReg], [StackSlot], WordOff, [CmmNode O O],
         [(LocalReg, (LocalReg, WordOff))])
     -> ([LocalReg], [StackSlot], WordOff, [CmmNode O O],
         [(LocalReg, (LocalReg, WordOff))]))
    -> ([LocalReg], [StackSlot], WordOff, [CmmNode O O],
        [(LocalReg, (LocalReg, WordOff))])
    -> [StackSlot]
    -> ([LocalReg], [StackSlot], WordOff, [CmmNode O O],
        [(LocalReg, (LocalReg, WordOff))])
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr StackSlot
    -> ([LocalReg], [StackSlot], WordOff, [CmmNode O O],
        [(LocalReg, (LocalReg, WordOff))])
    -> ([LocalReg], [StackSlot], WordOff, [CmmNode O O],
        [(LocalReg, (LocalReg, WordOff))])
    save ([LocalReg]
    to_save, [], WordOff
    0, [], []) [StackSlot]
    stack

           -- push any remaining live vars on the stack
           (WordOff
    push_sp, [CmmNode O O]
    push_assigs, [(LocalReg, (LocalReg, WordOff))]
    push_regs)
              = (LocalReg
     -> (WordOff, [CmmNode O O], [(LocalReg, (LocalReg, WordOff))])
     -> (WordOff, [CmmNode O O], [(LocalReg, (LocalReg, WordOff))]))
    -> (WordOff, [CmmNode O O], [(LocalReg, (LocalReg, WordOff))])
    -> [LocalReg]
    -> (WordOff, [CmmNode O O], [(LocalReg, (LocalReg, WordOff))])
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr LocalReg
    -> (WordOff, [CmmNode O O], [(LocalReg, (LocalReg, WordOff))])
    -> (WordOff, [CmmNode O O], [(LocalReg, (LocalReg, WordOff))])
    push (WordOff
    n, [], []) [LocalReg]
    still_to_save
              where
                  push :: LocalReg
    -> (WordOff, [CmmNode O O], [(LocalReg, (LocalReg, WordOff))])
    -> (WordOff, [CmmNode O O], [(LocalReg, (LocalReg, WordOff))])
    push LocalReg
    r (WordOff
    n, [CmmNode O O]
    assigs, [(LocalReg, (LocalReg, WordOff))]
    regs)
                    = (WordOff
    n', CmmNode O O
    assig CmmNode O O -> [CmmNode O O] -> [CmmNode O O]
    forall a. a -> [a] -> [a]
    : [CmmNode O O]
    assigs, (LocalReg
    r,(LocalReg
    r,WordOff
    n')) (LocalReg, (LocalReg, WordOff))
    -> [(LocalReg, (LocalReg, WordOff))]
    -> [(LocalReg, (LocalReg, WordOff))]
    forall a. a -> [a] -> [a]
    : [(LocalReg, (LocalReg, WordOff))]
    regs)
                    where
                      n' :: WordOff
    n' = WordOff
    n WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    + Platform -> LocalReg -> WordOff
    localRegBytes Platform
    platform LocalReg
    r
                      assig :: CmmNode O O
    assig = CmmExpr -> CmmExpr -> AlignmentSpec -> CmmNode O O
    CmmStore (Area -> WordOff -> CmmExpr
    CmmStackSlot Area
    Old WordOff
    n')
                                       (CmmReg -> CmmExpr
    CmmReg (LocalReg -> CmmReg
    CmmLocal LocalReg
    r))
                                       AlignmentSpec
    NaturallyAligned

           trim_sp :: WordOff
    trim_sp
              | Bool -> Bool
    not ([(LocalReg, (LocalReg, WordOff))] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(LocalReg, (LocalReg, WordOff))]
    push_regs) = WordOff
    push_sp
              | Bool
    otherwise
              = Platform -> WordOff -> WordOff -> WordOff
    plusW Platform
    platform WordOff
    n (- [StackSlot] -> WordOff
    forall a. [a] -> WordOff
    forall (t :: * -> *) a. Foldable t => t a -> WordOff
    length ((StackSlot -> Bool) -> [StackSlot] -> [StackSlot]
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile StackSlot -> Bool
    isEmpty [StackSlot]
    save_stack))

           final_regs :: UniqFM LocalReg (LocalReg, WordOff)
    final_regs = UniqFM LocalReg (LocalReg, WordOff)
    regs1 UniqFM LocalReg (LocalReg, WordOff)
    -> [(LocalReg, (LocalReg, WordOff))]
    -> UniqFM LocalReg (LocalReg, WordOff)
    forall key elt.
    Uniquable key =>
    UniqFM key elt -> [(key, elt)] -> UniqFM key elt
    `addListToUFM` [(LocalReg, (LocalReg, WordOff))]
    push_regs
                              UniqFM LocalReg (LocalReg, WordOff)
    -> [(LocalReg, (LocalReg, WordOff))]
    -> UniqFM LocalReg (LocalReg, WordOff)
    forall key elt.
    Uniquable key =>
    UniqFM key elt -> [(key, elt)] -> UniqFM key elt
    `addListToUFM` [(LocalReg, (LocalReg, WordOff))]
    save_regs

       in
      -- XXX should be an assert
       if ( WordOff
    n WordOff -> WordOff -> Bool
    forall a. Eq a => a -> a -> Bool
    /= WordOff -> WordOff -> WordOff
    forall a. Ord a => a -> a -> a
    max WordOff
    sp0 WordOff
    ret_off ) then String -> SDoc -> (StackMap, [CmmNode O O])
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "allocate" (WordOff -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr WordOff
    n SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> WordOff -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr WordOff
    sp0 SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> WordOff -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr WordOff
    ret_off) else

       if (WordOff
    trim_sp WordOff -> WordOff -> WordOff
    forall a. Bits a => a -> a -> a
    .&. (Platform -> WordOff
    platformWordSizeInBytes Platform
    platform WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    - WordOff
    1)) WordOff -> WordOff -> Bool
    forall a. Eq a => a -> a -> Bool
    /= WordOff
    0  then String -> SDoc -> (StackMap, [CmmNode O O])
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "allocate2" (WordOff -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr WordOff
    trim_sp SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> UniqFM LocalReg (LocalReg, WordOff) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr UniqFM LocalReg (LocalReg, WordOff)
    final_regs SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> WordOff -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr WordOff
    push_sp) else

       ( StackMap
    stackmap { sm_regs = final_regs , sm_sp = trim_sp }
       , [CmmNode O O]
    push_assigs [CmmNode O O] -> [CmmNode O O] -> [CmmNode O O]
    forall a. [a] -> [a] -> [a]
    ++ [CmmNode O O]
    save_assigs )

    -- -----------------------------------------------------------------------------
    -- Manifesting Sp

    -- | Manifest Sp: turn all the CmmStackSlots into CmmLoads from Sp.  The
    -- block looks like this:
    --
    --    middle_pre       -- the middle nodes
    --    Sp = Sp + sp_off -- Sp adjustment goes here
    --    last             -- the last node
    --
    -- And we have some extra blocks too (that don't contain Sp adjustments)
    --
    -- The adjustment for middle_pre will be different from that for
    -- middle_post, because the Sp adjustment intervenes.
    --
    manifestSp
       :: CmmConfig
       -> LabelMap StackMap  -- StackMaps for other blocks
       -> StackMap           -- StackMap for this block
       -> ByteOff            -- Sp on entry to the block
       -> ByteOff            -- SpHigh
       -> CmmNode C O        -- first node
       -> [CmmNode O O]      -- middle
       -> ByteOff            -- sp_off
       -> CmmNode O C        -- last node
       -> [CmmBlock]         -- new blocks
       -> [CmmBlock]         -- final blocks with Sp manifest

    manifestSp :: CmmConfig
    -> LabelMap StackMap
    -> StackMap
    -> WordOff
    -> WordOff
    -> CmmNode C O
    -> [CmmNode O O]
    -> WordOff
    -> CmmNode O C
    -> [CmmBlock]
    -> [CmmBlock]
    manifestSp CmmConfig
    cfg LabelMap StackMap
    stackmaps StackMap
    stack0 WordOff
    sp0 WordOff
    sp_high
               CmmNode C O
    first [CmmNode O O]
    middle_pre WordOff
    sp_off CmmNode O C
    last [CmmBlock]
    fixup_blocks
      = CmmBlock
    final_block CmmBlock -> [CmmBlock] -> [CmmBlock]
    forall a. a -> [a] -> [a]
    : [CmmBlock]
    fixup_blocks'
      where
        area_off :: Area -> WordOff
    area_off = LabelMap StackMap -> Area -> WordOff
    getAreaOff LabelMap StackMap
    stackmaps
        platform :: Platform
    platform = CmmConfig -> Platform
    cmmPlatform CmmConfig
    cfg

        adj_pre_sp, adj_post_sp :: CmmNode e x -> CmmNode e x
        adj_pre_sp :: forall (e :: Extensibility) (x :: Extensibility).
    CmmNode e x -> CmmNode e x
    adj_pre_sp  = (CmmExpr -> CmmExpr) -> CmmNode e x -> CmmNode e x
    forall (e :: Extensibility) (x :: Extensibility).
    (CmmExpr -> CmmExpr) -> CmmNode e x -> CmmNode e x
    mapExpDeep (Platform
    -> WordOff -> WordOff -> (Area -> WordOff) -> CmmExpr -> CmmExpr
    areaToSp Platform
    platform WordOff
    sp0            WordOff
    sp_high Area -> WordOff
    area_off)
        adj_post_sp :: forall (e :: Extensibility) (x :: Extensibility).
    CmmNode e x -> CmmNode e x
    adj_post_sp = (CmmExpr -> CmmExpr) -> CmmNode e x -> CmmNode e x
    forall (e :: Extensibility) (x :: Extensibility).
    (CmmExpr -> CmmExpr) -> CmmNode e x -> CmmNode e x
    mapExpDeep (Platform
    -> WordOff -> WordOff -> (Area -> WordOff) -> CmmExpr -> CmmExpr
    areaToSp Platform
    platform (WordOff
    sp0 WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    - WordOff
    sp_off) WordOff
    sp_high Area -> WordOff
    area_off)

        final_middle :: Block CmmNode O O
    final_middle = CmmConfig
    -> WordOff -> WordOff -> Block CmmNode O O -> Block CmmNode O O
    maybeAddSpAdj CmmConfig
    cfg WordOff
    sp0 WordOff
    sp_off
                     (Block CmmNode O O -> Block CmmNode O O)
    -> ([CmmNode O O] -> Block CmmNode O O)
    -> [CmmNode O O]
    -> Block CmmNode O O
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [CmmNode O O] -> Block CmmNode O O
    forall (n :: Extensibility -> Extensibility -> *).
    [n O O] -> Block n O O
    blockFromList
                     ([CmmNode O O] -> Block CmmNode O O)
    -> ([CmmNode O O] -> [CmmNode O O])
    -> [CmmNode O O]
    -> Block CmmNode O O
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (CmmNode O O -> CmmNode O O) -> [CmmNode O O] -> [CmmNode O O]
    forall a b. (a -> b) -> [a] -> [b]
    map CmmNode O O -> CmmNode O O
    forall (e :: Extensibility) (x :: Extensibility).
    CmmNode e x -> CmmNode e x
    adj_pre_sp
                     ([CmmNode O O] -> [CmmNode O O])
    -> ([CmmNode O O] -> [CmmNode O O])
    -> [CmmNode O O]
    -> [CmmNode O O]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StackMap
    -> LabelMap StackMap
    -> (Area -> WordOff)
    -> [CmmNode O O]
    -> [CmmNode O O]
    elimStackStores StackMap
    stack0 LabelMap StackMap
    stackmaps Area -> WordOff
    area_off
                     ([CmmNode O O] -> Block CmmNode O O)
    -> [CmmNode O O] -> Block CmmNode O O
    forall a b. (a -> b) -> a -> b
    $ [CmmNode O O]
    middle_pre
        final_last :: CmmNode O C
    final_last    = CmmNode O C -> CmmNode O C
    optStackCheck (CmmNode O C -> CmmNode O C
    forall (e :: Extensibility) (x :: Extensibility).
    CmmNode e x -> CmmNode e x
    adj_post_sp CmmNode O C
    last)

        final_block :: CmmBlock
    final_block   = CmmNode C O -> Block CmmNode O O -> CmmNode O C -> CmmBlock
    forall (n :: Extensibility -> Extensibility -> *).
    n C O -> Block n O O -> n O C -> Block n C C
    blockJoin CmmNode C O
    first Block CmmNode O O
    final_middle CmmNode O C
    final_last

        fixup_blocks' :: [CmmBlock]
    fixup_blocks' = (CmmBlock -> CmmBlock) -> [CmmBlock] -> [CmmBlock]
    forall a b. (a -> b) -> [a] -> [b]
    map ((CmmNode C O -> CmmNode C O, CmmNode O O -> CmmNode O O,
     CmmNode O C -> CmmNode O C)
    -> CmmBlock -> CmmBlock
    forall (n :: Extensibility -> Extensibility -> *)
           (n' :: Extensibility -> Extensibility -> *) (e :: Extensibility)
           (x :: Extensibility).
    (n C O -> n' C O, n O O -> n' O O, n O C -> n' O C)
    -> Block n e x -> Block n' e x
    mapBlock3' (CmmNode C O -> CmmNode C O
    forall a. a -> a
    id, CmmNode O O -> CmmNode O O
    forall (e :: Extensibility) (x :: Extensibility).
    CmmNode e x -> CmmNode e x
    adj_post_sp, CmmNode O C -> CmmNode O C
    forall a. a -> a
    id)) [CmmBlock]
    fixup_blocks

    getAreaOff :: LabelMap StackMap -> (Area -> StackLoc)
    getAreaOff :: LabelMap StackMap -> Area -> WordOff
    getAreaOff LabelMap StackMap
    _ Area
    Old = WordOff
    0
    getAreaOff LabelMap StackMap
    stackmaps (Young BlockId
    l) =
      case BlockId -> LabelMap StackMap -> Maybe StackMap
    forall a. BlockId -> LabelMap a -> Maybe a
    mapLookup BlockId
    l LabelMap StackMap
    stackmaps of
        Just StackMap
    sm -> StackMap -> WordOff
    sm_sp StackMap
    sm WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    - StackMap -> WordOff
    sm_args StackMap
    sm
        Maybe StackMap
    Nothing -> String -> SDoc -> WordOff
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "getAreaOff" (BlockId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr BlockId
    l)

    maybeAddSpAdj
      :: CmmConfig -> ByteOff -> ByteOff -> Block CmmNode O O -> Block CmmNode O O
    maybeAddSpAdj :: CmmConfig
    -> WordOff -> WordOff -> Block CmmNode O O -> Block CmmNode O O
    maybeAddSpAdj CmmConfig
    cfg WordOff
    sp0 WordOff
    sp_off Block CmmNode O O
    block =
      Block CmmNode O O -> Block CmmNode O O
    add_initial_unwind (Block CmmNode O O -> Block CmmNode O O)
    -> Block CmmNode O O -> Block CmmNode O O
    forall a b. (a -> b) -> a -> b
    $ Block CmmNode O O -> Block CmmNode O O
    add_adj_unwind (Block CmmNode O O -> Block CmmNode O O)
    -> Block CmmNode O O -> Block CmmNode O O
    forall a b. (a -> b) -> a -> b
    $ Block CmmNode O O -> Block CmmNode O O
    adj Block CmmNode O O
    block
      where
        platform :: Platform
    platform             = CmmConfig -> Platform
    cmmPlatform            CmmConfig
    cfg
        do_stk_unwinding_gen :: Bool
    do_stk_unwinding_gen = CmmConfig -> Bool
    cmmGenStackUnwindInstr CmmConfig
    cfg
        adj :: Block CmmNode O O -> Block CmmNode O O
    adj Block CmmNode O O
    block
          | WordOff
    sp_off WordOff -> WordOff -> Bool
    forall a. Eq a => a -> a -> Bool
    /= WordOff
    0
          = Block CmmNode O O
    block Block CmmNode O O -> CmmNode O O -> Block CmmNode O O
    forall (n :: Extensibility -> Extensibility -> *)
           (e :: Extensibility).
    Block n e O -> n O O -> Block n e O
    `blockSnoc` CmmReg -> CmmExpr -> CmmNode O O
    CmmAssign (Platform -> CmmReg
    spReg Platform
    platform) (Platform -> CmmExpr -> WordOff -> CmmExpr
    cmmOffset Platform
    platform (Platform -> CmmExpr
    spExpr Platform
    platform) WordOff
    sp_off)
          | Bool
    otherwise = Block CmmNode O O
    block
        -- Add unwind pseudo-instruction at the beginning of each block to
        -- document Sp level for debugging
        add_initial_unwind :: Block CmmNode O O -> Block CmmNode O O
    add_initial_unwind Block CmmNode O O
    block
          | Bool
    do_stk_unwinding_gen
          = [(GlobalReg, Maybe CmmExpr)] -> CmmNode O O
    CmmUnwind [(GlobalReg
    Sp, CmmExpr -> Maybe CmmExpr
    forall a. a -> Maybe a
    Just CmmExpr
    sp_unwind)] CmmNode O O -> Block CmmNode O O -> Block CmmNode O O
    forall (n :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    n O O -> Block n O x -> Block n O x
    `blockCons` Block CmmNode O O
    block
          | Bool
    otherwise
          = Block CmmNode O O
    block
          where sp_unwind :: CmmExpr
    sp_unwind = CmmReg -> WordOff -> CmmExpr
    CmmRegOff (Platform -> CmmReg
    spReg Platform
    platform) (WordOff
    sp0 WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    - Platform -> WordOff
    platformWordSizeInBytes Platform
    platform)

        -- Add unwind pseudo-instruction right after the Sp adjustment
        -- if there is one.
        add_adj_unwind :: Block CmmNode O O -> Block CmmNode O O
    add_adj_unwind Block CmmNode O O
    block
          | Bool
    do_stk_unwinding_gen
          , WordOff
    sp_off WordOff -> WordOff -> Bool
    forall a. Eq a => a -> a -> Bool
    /= WordOff
    0
          = Block CmmNode O O
    block Block CmmNode O O -> CmmNode O O -> Block CmmNode O O
    forall (n :: Extensibility -> Extensibility -> *)
           (e :: Extensibility).
    Block n e O -> n O O -> Block n e O
    `blockSnoc` [(GlobalReg, Maybe CmmExpr)] -> CmmNode O O
    CmmUnwind [(GlobalReg
    Sp, CmmExpr -> Maybe CmmExpr
    forall a. a -> Maybe a
    Just CmmExpr
    sp_unwind)]
          | Bool
    otherwise
          = Block CmmNode O O
    block
          where sp_unwind :: CmmExpr
    sp_unwind = CmmReg -> WordOff -> CmmExpr
    CmmRegOff (Platform -> CmmReg
    spReg Platform
    platform) (WordOff
    sp0 WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    - Platform -> WordOff
    platformWordSizeInBytes Platform
    platform WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    - WordOff
    sp_off)

    {- Note [SP old/young offsets]
       ~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Sp(L) is the Sp offset on entry to block L relative to the base of the
    OLD area.

    SpArgs(L) is the size of the young area for L, i.e. the number of
    arguments.

     - in block L, each reference to [old + N] turns into
       [Sp + Sp(L) - N]

     - in block L, each reference to [young(L') + N] turns into
       [Sp + Sp(L) - Sp(L') + SpArgs(L') - N]

     - be careful with the last node of each block: Sp has already been adjusted
       to be Sp + Sp(L) - Sp(L')
    -}

    areaToSp :: Platform -> ByteOff -> ByteOff -> (Area -> StackLoc) -> CmmExpr -> CmmExpr

    areaToSp :: Platform
    -> WordOff -> WordOff -> (Area -> WordOff) -> CmmExpr -> CmmExpr
    areaToSp Platform
    platform WordOff
    sp_old WordOff
    _sp_hwm Area -> WordOff
    area_off (CmmStackSlot Area
    area WordOff
    n)
      = Platform -> CmmExpr -> WordOff -> CmmExpr
    cmmOffset Platform
    platform (Platform -> CmmExpr
    spExpr Platform
    platform) (WordOff
    sp_old WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    - Area -> WordOff
    area_off Area
    area WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    - WordOff
    n)
        -- Replace (CmmStackSlot area n) with an offset from Sp

    areaToSp Platform
    platform WordOff
    _ WordOff
    sp_hwm Area -> WordOff
    _ (CmmLit CmmLit
    CmmHighStackMark)
      = Platform -> WordOff -> CmmExpr
    mkIntExpr Platform
    platform WordOff
    sp_hwm
        -- Replace CmmHighStackMark with the number of bytes of stack used,
        -- the sp_hwm.   See Note [Stack usage] in GHC.StgToCmm.Heap

    areaToSp Platform
    platform WordOff
    _ WordOff
    _ Area -> WordOff
    _ (CmmMachOp (MO_U_Lt Width
    _) [CmmExpr]
    args)
      | [CmmExpr] -> Bool
    falseStackCheck [CmmExpr]
    args
      = Platform -> CmmExpr
    zeroExpr Platform
    platform
    areaToSp Platform
    platform WordOff
    _ WordOff
    _ Area -> WordOff
    _ (CmmMachOp (MO_U_Ge Width
    _) [CmmExpr]
    args)
      | [CmmExpr] -> Bool
    falseStackCheck [CmmExpr]
    args
      = Platform -> WordOff -> CmmExpr
    mkIntExpr Platform
    platform WordOff
    1
        -- Replace a stack-overflow test that cannot fail with a no-op
        -- See Note [Always false stack check]

    areaToSp Platform
    _ WordOff
    _ WordOff
    _ Area -> WordOff
    _ CmmExpr
    other = CmmExpr
    other

    -- | Determine whether a stack check cannot fail.
    falseStackCheck :: [CmmExpr] -> Bool
    falseStackCheck :: [CmmExpr] -> Bool
    falseStackCheck [ CmmMachOp (MO_Sub Width
    _)
                          [ CmmRegOff (CmmGlobal (GlobalRegUse GlobalReg
    Sp CmmType
    _)) WordOff
    x_off
                          , CmmLit (CmmInt Integer
    y_lit Width
    _)]
                    , CmmReg (CmmGlobal (GlobalRegUse GlobalReg
    SpLim CmmType
    _))]
      = WordOff -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral WordOff
    x_off Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Integer
    y_lit
    falseStackCheck [CmmExpr]
    _ = Bool
    False

    -- Note [Always false stack check]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    -- We can optimise stack checks of the form
    --
    --   if ((Sp + x) - y < SpLim) then .. else ..
    --
    -- where are non-negative integer byte offsets.  Since we know that
    -- SpLim <= Sp (remember the stack grows downwards), this test must
    -- yield False if (x >= y), so we can rewrite the comparison to False.
    -- A subsequent sinking pass will later drop the dead code.
    -- Optimising this away depends on knowing that SpLim <= Sp, so it is
    -- really the job of the stack layout algorithm, hence we do it now.
    --
    -- The control flow optimiser may negate a conditional to increase
    -- the likelihood of a fallthrough if the branch is not taken.  But
    -- not every conditional is inverted as the control flow optimiser
    -- places some requirements on the predecessors of both branch targets.
    -- So we better look for the inverted comparison too.

    optStackCheck :: CmmNode O C -> CmmNode O C
    optStackCheck :: CmmNode O C -> CmmNode O C
    optStackCheck CmmNode O C
    n = -- Note [Always false stack check]
     case CmmNode O C
    n of
       CmmCondBranch (CmmLit (CmmInt Integer
    0 Width
    _)) BlockId
    _true BlockId
    false Maybe Bool
    _ -> BlockId -> CmmNode O C
    CmmBranch BlockId
    false
       CmmCondBranch (CmmLit (CmmInt Integer
    _ Width
    _)) BlockId
    true BlockId
    _false Maybe Bool
    _ -> BlockId -> CmmNode O C
    CmmBranch BlockId
    true
       CmmNode O C
    other -> CmmNode O C
    other

    -- -----------------------------------------------------------------------------

    -- | Eliminate stores of the form
    --
    --    Sp[area+n] = r
    --
    -- when we know that r is already in the same slot as Sp[area+n].  We
    -- could do this in a later optimisation pass, but that would involve
    -- a separate analysis and we already have the information to hand
    -- here.  It helps clean up some extra stack stores in common cases.
    --
    -- Note that we may have to modify the StackMap as we walk through the
    -- code using procMiddle, since an assignment to a variable in the
    -- StackMap will invalidate its mapping there.
    --
    elimStackStores :: StackMap
                    -> LabelMap StackMap
                    -> (Area -> ByteOff)
                    -> [CmmNode O O]
                    -> [CmmNode O O]
    elimStackStores :: StackMap
    -> LabelMap StackMap
    -> (Area -> WordOff)
    -> [CmmNode O O]
    -> [CmmNode O O]
    elimStackStores StackMap
    stackmap LabelMap StackMap
    stackmaps Area -> WordOff
    area_off [CmmNode O O]
    nodes
      = StackMap -> [CmmNode O O] -> [CmmNode O O]
    go StackMap
    stackmap [CmmNode O O]
    nodes
      where
        go :: StackMap -> [CmmNode O O] -> [CmmNode O O]
    go StackMap
    _stackmap [] = []
        go StackMap
    stackmap (CmmNode O O
    n:[CmmNode O O]
    ns)
         = case CmmNode O O
    n of
             CmmStore (CmmStackSlot Area
    area WordOff
    m) (CmmReg (CmmLocal LocalReg
    r)) AlignmentSpec
    _
                | Just (LocalReg
    _,WordOff
    off) <- UniqFM LocalReg (LocalReg, WordOff)
    -> LocalReg -> Maybe (LocalReg, WordOff)
    forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
    lookupUFM (StackMap -> UniqFM LocalReg (LocalReg, WordOff)
    sm_regs StackMap
    stackmap) LocalReg
    r
                , Area -> WordOff
    area_off Area
    area WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    + WordOff
    m WordOff -> WordOff -> Bool
    forall a. Eq a => a -> a -> Bool
    == WordOff
    off
                -> StackMap -> [CmmNode O O] -> [CmmNode O O]
    go StackMap
    stackmap [CmmNode O O]
    ns
             CmmNode O O
    _otherwise
                -> CmmNode O O
    n CmmNode O O -> [CmmNode O O] -> [CmmNode O O]
    forall a. a -> [a] -> [a]
    : StackMap -> [CmmNode O O] -> [CmmNode O O]
    go (LabelMap StackMap -> CmmNode O O -> StackMap -> StackMap
    forall (e :: Extensibility) (x :: Extensibility).
    LabelMap StackMap -> CmmNode e x -> StackMap -> StackMap
    procMiddle LabelMap StackMap
    stackmaps CmmNode O O
    n StackMap
    stackmap) [CmmNode O O]
    ns

    -- -----------------------------------------------------------------------------
    -- Update info tables to include stack liveness

    setInfoTableStackMap :: Platform -> LabelMap StackMap -> CmmDecl -> CmmDecl
    setInfoTableStackMap :: Platform -> LabelMap StackMap -> CmmDecl -> CmmDecl
    setInfoTableStackMap Platform
    platform LabelMap StackMap
    stackmaps (CmmProc top_info :: CmmTopInfo
    top_info@TopInfo{LabelMap CmmInfoTable
    CmmStackInfo
    info_tbls :: LabelMap CmmInfoTable
    stack_info :: CmmStackInfo
    stack_info :: CmmTopInfo -> CmmStackInfo
    info_tbls :: CmmTopInfo -> LabelMap CmmInfoTable
    ..} CLabel
    l [GlobalReg]
    v CmmGraph
    g)
      = CmmTopInfo -> CLabel -> [GlobalReg] -> CmmGraph -> CmmDecl
    forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
    CmmProc CmmTopInfo
    top_info{ info_tbls = mapMapWithKey fix_info info_tbls } CLabel
    l [GlobalReg]
    v CmmGraph
    g
      where
        fix_info :: BlockId -> CmmInfoTable -> CmmInfoTable
    fix_info BlockId
    lbl info_tbl :: CmmInfoTable
    info_tbl@CmmInfoTable{ cit_rep :: CmmInfoTable -> SMRep
    cit_rep = StackRep Liveness
    _ } =
           CmmInfoTable
    info_tbl { cit_rep = StackRep (get_liveness lbl) }
        fix_info BlockId
    _ CmmInfoTable
    other = CmmInfoTable
    other

        get_liveness :: BlockId -> Liveness
        get_liveness :: BlockId -> Liveness
    get_liveness BlockId
    lbl
          = case BlockId -> LabelMap StackMap -> Maybe StackMap
    forall a. BlockId -> LabelMap a -> Maybe a
    mapLookup BlockId
    lbl LabelMap StackMap
    stackmaps of
              Maybe StackMap
    Nothing -> String -> SDoc -> Liveness
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "setInfoTableStackMap" (BlockId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr BlockId
    lbl SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Platform -> LabelMap CmmInfoTable -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform LabelMap CmmInfoTable
    info_tbls)
              Just StackMap
    sm -> Platform -> StackMap -> Liveness
    stackMapToLiveness Platform
    platform StackMap
    sm

    setInfoTableStackMap Platform
    _ LabelMap StackMap
    _ CmmDecl
    d = CmmDecl
    d

    stackMapToLiveness :: Platform -> StackMap -> Liveness
    stackMapToLiveness :: Platform -> StackMap -> Liveness
    stackMapToLiveness Platform
    platform StackMap{WordOff
    UniqFM LocalReg (LocalReg, WordOff)
    sm_sp :: StackMap -> WordOff
    sm_args :: StackMap -> WordOff
    sm_ret_off :: StackMap -> WordOff
    sm_regs :: StackMap -> UniqFM LocalReg (LocalReg, WordOff)
    sm_sp :: WordOff
    sm_args :: WordOff
    sm_ret_off :: WordOff
    sm_regs :: UniqFM LocalReg (LocalReg, WordOff)
    ..} =
       Liveness -> Liveness
    forall a. [a] -> [a]
    reverse (Liveness -> Liveness) -> Liveness -> Liveness
    forall a b. (a -> b) -> a -> b
    $ Array WordOff Bool -> Liveness
    forall i e. Array i e -> [e]
    Array.elems (Array WordOff Bool -> Liveness) -> Array WordOff Bool -> Liveness
    forall a b. (a -> b) -> a -> b
    $
            (Bool -> Bool -> Bool)
    -> Bool
    -> (WordOff, WordOff)
    -> [(WordOff, Bool)]
    -> Array WordOff Bool
    forall i e a.
    Ix i =>
    (e -> a -> e) -> e -> (i, i) -> [(i, a)] -> Array i e
    accumArray (\Bool
    _ Bool
    x -> Bool
    x) Bool
    True (Platform -> WordOff -> WordOff
    toWords Platform
    platform WordOff
    sm_ret_off WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    + WordOff
    1,
                                         Platform -> WordOff -> WordOff
    toWords Platform
    platform (WordOff
    sm_sp WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    - WordOff
    sm_args)) [(WordOff, Bool)]
    live_words
       where
         live_words :: [(WordOff, Bool)]
    live_words =  [ (Platform -> WordOff -> WordOff
    toWords Platform
    platform WordOff
    off, Bool
    False)
                       | (LocalReg
    r,WordOff
    off) <- UniqFM LocalReg (LocalReg, WordOff) -> [(LocalReg, WordOff)]
    forall {k} (key :: k) elt. UniqFM key elt -> [elt]
    nonDetEltsUFM UniqFM LocalReg (LocalReg, WordOff)
    sm_regs
                       , CmmType -> Bool
    isGcPtrType (LocalReg -> CmmType
    localRegType LocalReg
    r) ]
                       -- See Note [Unique Determinism and code generation]

    -- -----------------------------------------------------------------------------
    -- Pass 2
    -- -----------------------------------------------------------------------------

    insertReloadsAsNeeded
        :: Platform
        -> ProcPointSet
        -> LabelMap StackMap
        -> BlockId
        -> [CmmBlock]
        -> UniqSM [CmmBlock]
    insertReloadsAsNeeded :: Platform
    -> ProcPointSet
    -> LabelMap StackMap
    -> BlockId
    -> [CmmBlock]
    -> UniqSM [CmmBlock]
    insertReloadsAsNeeded Platform
    platform ProcPointSet
    procpoints LabelMap StackMap
    final_stackmaps BlockId
    entry [CmmBlock]
    blocks =
        CmmGraph -> [CmmBlock]
    toBlockList (CmmGraph -> [CmmBlock])
    -> ((CmmGraph, BlockEntryLiveness LocalReg) -> CmmGraph)
    -> (CmmGraph, BlockEntryLiveness LocalReg)
    -> [CmmBlock]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (CmmGraph, BlockEntryLiveness LocalReg) -> CmmGraph
    forall a b. (a, b) -> a
    fst ((CmmGraph, BlockEntryLiveness LocalReg) -> [CmmBlock])
    -> UniqSM (CmmGraph, BlockEntryLiveness LocalReg)
    -> UniqSM [CmmBlock]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
            DataflowLattice CmmLocalLive
    -> RewriteFun' CmmNode CmmLocalLive
    -> CmmGraph
    -> BlockEntryLiveness LocalReg
    -> UniqSM (CmmGraph, BlockEntryLiveness LocalReg)
    forall (node :: Extensibility -> Extensibility -> *) f.
    NonLocal node =>
    DataflowLattice f
    -> RewriteFun' node f
    -> GenCmmGraph node
    -> FactBase f
    -> UniqSM (GenCmmGraph node, FactBase f)
    rewriteCmmBwd DataflowLattice CmmLocalLive
    forall r. Ord r => DataflowLattice (CmmLive r)
    liveLattice RewriteFun' CmmNode CmmLocalLive
    rewriteCC (BlockId -> [CmmBlock] -> CmmGraph
    ofBlockList BlockId
    entry [CmmBlock]
    blocks) BlockEntryLiveness LocalReg
    forall v. LabelMap v
    mapEmpty
      where
        rewriteCC :: RewriteFun CmmLocalLive
        rewriteCC :: RewriteFun' CmmNode CmmLocalLive
    rewriteCC (BlockCC CmmNode C O
    e_node Block CmmNode O O
    middle0 CmmNode O C
    x_node) BlockEntryLiveness LocalReg
    fact_base0 = do
            let entry_label :: BlockId
    entry_label = CmmNode C O -> BlockId
    forall (x :: Extensibility). CmmNode C x -> BlockId
    forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> BlockId
    entryLabel CmmNode C O
    e_node
                stackmap :: StackMap
    stackmap = case BlockId -> LabelMap StackMap -> Maybe StackMap
    forall a. BlockId -> LabelMap a -> Maybe a
    mapLookup BlockId
    entry_label LabelMap StackMap
    final_stackmaps of
                    Just StackMap
    sm -> StackMap
    sm
                    Maybe StackMap
    Nothing -> String -> StackMap
    forall a. HasCallStack => String -> a
    panic String
    "insertReloadsAsNeeded: rewriteCC: stackmap"

                -- Merge the liveness from successor blocks and analyse the last
                -- node.
                joined :: CmmLocalLive
    joined = Platform -> CmmNode O C -> CmmLocalLive -> CmmLocalLive
    forall r n.
    (DefinerOfRegs r n, UserOfRegs r n) =>
    Platform -> n -> CmmLive r -> CmmLive r
    gen_kill Platform
    platform CmmNode O C
    x_node (CmmLocalLive -> CmmLocalLive) -> CmmLocalLive -> CmmLocalLive
    forall a b. (a -> b) -> a -> b
    $!
                             DataflowLattice CmmLocalLive
    -> CmmNode O C -> BlockEntryLiveness LocalReg -> CmmLocalLive
    forall (n :: Extensibility -> Extensibility -> *) f
           (e :: Extensibility).
    NonLocal n =>
    DataflowLattice f -> n e C -> FactBase f -> f
    joinOutFacts DataflowLattice CmmLocalLive
    forall r. Ord r => DataflowLattice (CmmLive r)
    liveLattice CmmNode O C
    x_node BlockEntryLiveness LocalReg
    fact_base0
                -- What is live at the start of middle0.
                live_at_middle0 :: CmmLocalLive
    live_at_middle0 = (CmmNode O O -> CmmLocalLive -> CmmLocalLive)
    -> Block CmmNode O O -> CmmLocalLive -> CmmLocalLive
    forall (node :: Extensibility -> Extensibility -> *) f.
    (node O O -> f -> f) -> Block node O O -> f -> f
    foldNodesBwdOO (Platform -> CmmNode O O -> CmmLocalLive -> CmmLocalLive
    forall r n.
    (DefinerOfRegs r n, UserOfRegs r n) =>
    Platform -> n -> CmmLive r -> CmmLive r
    gen_kill Platform
    platform) Block CmmNode O O
    middle0 CmmLocalLive
    joined

                -- If this is a procpoint we need to add the reloads, but only if
                -- they're actually live. Furthermore, nothing is live at the entry
                -- to a proc point.
                (Block CmmNode O O
    middle1, CmmLocalLive
    live_with_reloads)
                    | BlockId
    entry_label BlockId -> ProcPointSet -> Bool
    `setMember` ProcPointSet
    procpoints
                    = let reloads :: [CmmNode O O]
    reloads = Platform -> StackMap -> CmmLocalLive -> [CmmNode O O]
    insertReloads Platform
    platform StackMap
    stackmap CmmLocalLive
    live_at_middle0
                      in ((CmmNode O O -> Block CmmNode O O -> Block CmmNode O O)
    -> Block CmmNode O O -> [CmmNode O O] -> Block CmmNode O O
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr CmmNode O O -> Block CmmNode O O -> Block CmmNode O O
    forall (n :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    n O O -> Block n O x -> Block n O x
    blockCons Block CmmNode O O
    middle0 [CmmNode O O]
    reloads, CmmLocalLive
    forall a. Set a
    emptyRegSet)
                    | Bool
    otherwise
                    = (Block CmmNode O O
    middle0, CmmLocalLive
    live_at_middle0)

                -- Final liveness for this block.
                !fact_base2 :: BlockEntryLiveness LocalReg
    fact_base2 = BlockId -> CmmLocalLive -> BlockEntryLiveness LocalReg
    forall v. BlockId -> v -> LabelMap v
    mapSingleton BlockId
    entry_label CmmLocalLive
    live_with_reloads

            (CmmBlock, BlockEntryLiveness LocalReg)
    -> UniqSM (CmmBlock, BlockEntryLiveness LocalReg)
    forall a. a -> UniqSM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CmmNode C O -> Block CmmNode O O -> CmmNode O C -> CmmBlock
    forall (n :: Extensibility -> Extensibility -> *).
    n C O -> Block n O O -> n O C -> Block n C C
    BlockCC CmmNode C O
    e_node Block CmmNode O O
    middle1 CmmNode O C
    x_node, BlockEntryLiveness LocalReg
    fact_base2)

    insertReloads :: Platform -> StackMap -> CmmLocalLive -> [CmmNode O O]
    insertReloads :: Platform -> StackMap -> CmmLocalLive -> [CmmNode O O]
    insertReloads Platform
    platform StackMap
    stackmap CmmLocalLive
    live =
         [ CmmReg -> CmmExpr -> CmmNode O O
    CmmAssign (LocalReg -> CmmReg
    CmmLocal LocalReg
    reg)
                     -- This cmmOffset basically corresponds to manifesting
                     -- @CmmStackSlot Old sp_off@, see Note [SP old/young offsets]
                     (CmmExpr -> CmmType -> AlignmentSpec -> CmmExpr
    CmmLoad (Platform -> CmmExpr -> WordOff -> CmmExpr
    cmmOffset Platform
    platform (Platform -> CmmExpr
    spExpr Platform
    platform) (WordOff
    sp_off WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    - WordOff
    reg_off))
                              (LocalReg -> CmmType
    localRegType LocalReg
    reg)
                              AlignmentSpec
    NaturallyAligned)
         | (LocalReg
    reg, WordOff
    reg_off) <- StackMap -> [(LocalReg, WordOff)]
    stackSlotRegs StackMap
    stackmap
         , LocalReg
    reg LocalReg -> CmmLocalLive -> Bool
    forall r. Ord r => r -> RegSet r -> Bool
    `elemRegSet` CmmLocalLive
    live
         ]
       where
         sp_off :: WordOff
    sp_off = StackMap -> WordOff
    sm_sp StackMap
    stackmap

    -- -----------------------------------------------------------------------------
    -- Lowering safe foreign calls

    {-
    Note [Lower safe foreign calls]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We start with

       Sp[young(L1)] = L1
     ,-----------------------
     | r1 = foo(x,y,z) returns to L1
     '-----------------------
     L1:
       R1 = r1 -- copyIn, inserted by mkSafeCall
       ...

    the stack layout algorithm will arrange to save and reload everything
    live across the call.  Our job now is to expand the call so we get

       Sp[young(L1)] = L1
     ,-----------------------
     | SAVE_THREAD_STATE()
     | token = suspendThread(BaseReg, interruptible)
     | r = foo(x,y,z)
     | BaseReg = resumeThread(token)
     | LOAD_THREAD_STATE()
     | R1 = r  -- copyOut
     | jump Sp[0]
     '-----------------------
     L1:
       r = R1 -- copyIn, inserted by mkSafeCall
       ...

    Note the copyOut, which saves the results in the places that L1 is
    expecting them (see Note [safe foreign call convention]). Note also
    that safe foreign call is replace by an unsafe one in the Cmm graph.
    -}

    lowerSafeForeignCall :: Profile -> CmmBlock -> UniqSM CmmBlock
    lowerSafeForeignCall :: Profile -> CmmBlock -> UniqSM CmmBlock
    lowerSafeForeignCall Profile
    profile CmmBlock
    block
      | (entry :: CmmNode C O
    entry@(CmmEntry BlockId
    _ CmmTickScope
    tscp), Block CmmNode O O
    middle, CmmForeignCall { Bool
    WordOff
    [LocalReg]
    [CmmExpr]
    BlockId
    ForeignTarget
    intrbl :: CmmNode O C -> Bool
    ret_off :: CmmNode O C -> WordOff
    ret_args :: CmmNode O C -> WordOff
    succ :: CmmNode O C -> BlockId
    args :: CmmNode O C -> [CmmExpr]
    res :: CmmNode O C -> [LocalReg]
    tgt :: CmmNode O C -> ForeignTarget
    tgt :: ForeignTarget
    res :: [LocalReg]
    args :: [CmmExpr]
    succ :: BlockId
    ret_args :: WordOff
    ret_off :: WordOff
    intrbl :: Bool
    .. }) <- CmmBlock -> (CmmNode C O, Block CmmNode O O, CmmNode O C)
    forall (n :: Extensibility -> Extensibility -> *).
    Block n C C -> (n C O, Block n O O, n O C)
    blockSplit CmmBlock
    block
      = do
        let platform :: Platform
    platform = Profile -> Platform
    profilePlatform Profile
    profile
        -- Both 'id' and 'new_base' are KindNonPtr because they're
        -- RTS-only objects and are not subject to garbage collection
        id <- CmmType -> UniqSM LocalReg
    forall (m :: * -> *). MonadUnique m => CmmType -> m LocalReg
    newTemp (Platform -> CmmType
    bWord Platform
    platform)
        new_base <- newTemp (cmmRegType $ baseReg platform)
        let (caller_save, caller_load) = callerSaveVolatileRegs platform
        save_state_code <- saveThreadState profile
        load_state_code <- loadThreadState profile
        let suspend = CmmAGraph
    save_state_code  CmmAGraph -> CmmAGraph -> CmmAGraph
    <*>
                      CmmAGraph
    caller_save CmmAGraph -> CmmAGraph -> CmmAGraph
    <*>
                      CmmNode O O -> CmmAGraph
    mkMiddle (Platform -> LocalReg -> Bool -> CmmNode O O
    callSuspendThread Platform
    platform LocalReg
    id Bool
    intrbl)
            midCall = ForeignTarget -> [LocalReg] -> [CmmExpr] -> CmmAGraph
    mkUnsafeCall ForeignTarget
    tgt [LocalReg]
    res [CmmExpr]
    args
            resume  = CmmNode O O -> CmmAGraph
    mkMiddle (LocalReg -> LocalReg -> CmmNode O O
    callResumeThread LocalReg
    new_base LocalReg
    id) CmmAGraph -> CmmAGraph -> CmmAGraph
    <*>
                      -- Assign the result to BaseReg: we
                      -- might now have a different Capability!
                      CmmReg -> CmmExpr -> CmmAGraph
    mkAssign (Platform -> CmmReg
    baseReg Platform
    platform) (CmmReg -> CmmExpr
    CmmReg (LocalReg -> CmmReg
    CmmLocal LocalReg
    new_base)) CmmAGraph -> CmmAGraph -> CmmAGraph
    <*>
                      CmmAGraph
    caller_load CmmAGraph -> CmmAGraph -> CmmAGraph
    <*>
                      CmmAGraph
    load_state_code

            (_, regs, copyout) =
                 copyOutOflow profile NativeReturn Jump (Young succ)
                                (map (CmmReg . CmmLocal) res)
                                ret_off []

            -- NB. after resumeThread returns, the top-of-stack probably contains
            -- the stack frame for succ, but it might not: if the current thread
            -- received an exception during the call, then the stack might be
            -- different.  Hence we continue by jumping to the top stack frame,
            -- not by jumping to succ.
            jump = CmmCall { cml_target :: CmmExpr
    cml_target    = Platform -> CmmExpr -> CmmExpr
    entryCode Platform
    platform (CmmExpr -> CmmExpr) -> CmmExpr -> CmmExpr
    forall a b. (a -> b) -> a -> b
    $
                                             Platform -> CmmExpr -> CmmExpr
    cmmLoadBWord Platform
    platform (Platform -> CmmExpr
    spExpr Platform
    platform)
                           , cml_cont :: Maybe BlockId
    cml_cont      = BlockId -> Maybe BlockId
    forall a. a -> Maybe a
    Just BlockId
    succ
                           , cml_args_regs :: [GlobalReg]
    cml_args_regs = [GlobalReg]
    regs
                           , cml_args :: WordOff
    cml_args      = Width -> WordOff
    widthInBytes (Platform -> Width
    wordWidth Platform
    platform)
                           , cml_ret_args :: WordOff
    cml_ret_args  = WordOff
    ret_args
                           , cml_ret_off :: WordOff
    cml_ret_off   = WordOff
    ret_off }

        graph' <- lgraphOfAGraph ( suspend <*>
                                   midCall <*>
                                   resume  <*>
                                   copyout <*>
                                   mkLast jump, tscp)

        case toBlockList graph' of
          [CmmBlock
    one] -> let (CmmNode C O
    _, Block CmmNode O O
    middle', CmmNode O C
    last) = CmmBlock -> (CmmNode C O, Block CmmNode O O, CmmNode O C)
    forall (n :: Extensibility -> Extensibility -> *).
    Block n C C -> (n C O, Block n O O, n O C)
    blockSplit CmmBlock
    one
                   in CmmBlock -> UniqSM CmmBlock
    forall a. a -> UniqSM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CmmNode C O -> Block CmmNode O O -> CmmNode O C -> CmmBlock
    forall (n :: Extensibility -> Extensibility -> *).
    n C O -> Block n O O -> n O C -> Block n C C
    blockJoin CmmNode C O
    entry (Block CmmNode O O
    middle Block CmmNode O O -> Block CmmNode O O -> Block CmmNode O O
    forall (n :: Extensibility -> Extensibility -> *)
           (e :: Extensibility) (x :: Extensibility).
    Block n e O -> Block n O x -> Block n e x
    `blockAppend` Block CmmNode O O
    middle') CmmNode O C
    last)
          [CmmBlock]
    _ -> String -> UniqSM CmmBlock
    forall a. HasCallStack => String -> a
    panic String
    "lowerSafeForeignCall0"

      -- Block doesn't end in a safe foreign call:
      | Bool
    otherwise = CmmBlock -> UniqSM CmmBlock
    forall a. a -> UniqSM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CmmBlock
    block

    callSuspendThread :: Platform -> LocalReg -> Bool -> CmmNode O O
    callSuspendThread :: Platform -> LocalReg -> Bool -> CmmNode O O
    callSuspendThread Platform
    platform LocalReg
    id Bool
    intrbl =
      ForeignTarget -> [LocalReg] -> [CmmExpr] -> CmmNode O O
    CmmUnsafeForeignCall (CallishMachOp -> ForeignTarget
    PrimTarget CallishMachOp
    MO_SuspendThread)
           [LocalReg
    id] [Platform -> CmmExpr
    baseExpr Platform
    platform, Platform -> WordOff -> CmmExpr
    mkIntExpr Platform
    platform (Bool -> WordOff
    forall a. Enum a => a -> WordOff
    fromEnum Bool
    intrbl)]

    callResumeThread :: LocalReg -> LocalReg -> CmmNode O O
    callResumeThread :: LocalReg -> LocalReg -> CmmNode O O
    callResumeThread LocalReg
    new_base LocalReg
    id =
      ForeignTarget -> [LocalReg] -> [CmmExpr] -> CmmNode O O
    CmmUnsafeForeignCall (CallishMachOp -> ForeignTarget
    PrimTarget CallishMachOp
    MO_ResumeThread)
           [LocalReg
    new_base] [CmmReg -> CmmExpr
    CmmReg (LocalReg -> CmmReg
    CmmLocal LocalReg
    id)]

    -- -----------------------------------------------------------------------------

    plusW :: Platform -> ByteOff -> WordOff -> ByteOff
    plusW :: Platform -> WordOff -> WordOff -> WordOff
    plusW Platform
    platform WordOff
    b WordOff
    w = WordOff
    b WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    + WordOff
    w WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    * Platform -> WordOff
    platformWordSizeInBytes Platform
    platform

    data StackSlot = Occupied | Empty
         -- Occupied: a return address or part of an update frame

    instance Outputable StackSlot where
      ppr :: StackSlot -> SDoc
    ppr StackSlot
    Occupied = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "XXX"
      ppr StackSlot
    Empty    = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "---"

    dropEmpty :: WordOff -> [StackSlot] -> Maybe [StackSlot]
    dropEmpty :: WordOff -> [StackSlot] -> Maybe [StackSlot]
    dropEmpty WordOff
    0 [StackSlot]
    ss           = [StackSlot] -> Maybe [StackSlot]
    forall a. a -> Maybe a
    Just [StackSlot]
    ss
    dropEmpty WordOff
    n (StackSlot
    Empty : [StackSlot]
    ss) = WordOff -> [StackSlot] -> Maybe [StackSlot]
    dropEmpty (WordOff
    nWordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    -WordOff
    1) [StackSlot]
    ss
    dropEmpty WordOff
    _ [StackSlot]
    _            = Maybe [StackSlot]
    forall a. Maybe a
    Nothing

    isEmpty :: StackSlot -> Bool
    isEmpty :: StackSlot -> Bool
    isEmpty StackSlot
    Empty = Bool
    True
    isEmpty StackSlot
    _ = Bool
    False

    localRegBytes :: Platform -> LocalReg -> ByteOff
    localRegBytes :: Platform -> LocalReg -> WordOff
    localRegBytes Platform
    platform LocalReg
    r
        = Platform -> WordOff -> WordOff
    roundUpToWords Platform
    platform (Width -> WordOff
    widthInBytes (CmmType -> Width
    typeWidth (LocalReg -> CmmType
    localRegType LocalReg
    r)))

    localRegWords :: Platform -> LocalReg -> WordOff
    localRegWords :: Platform -> LocalReg -> WordOff
    localRegWords Platform
    platform = Platform -> WordOff -> WordOff
    toWords Platform
    platform (WordOff -> WordOff)
    -> (LocalReg -> WordOff) -> LocalReg -> WordOff
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Platform -> LocalReg -> WordOff
    localRegBytes Platform
    platform

    toWords :: Platform -> ByteOff -> WordOff
    toWords :: Platform -> WordOff -> WordOff
    toWords Platform
    platform WordOff
    x = WordOff
    x WordOff -> WordOff -> WordOff
    forall a. Integral a => a -> a -> a
    `quot` Platform -> WordOff
    platformWordSizeInBytes Platform
    platform

    stackSlotRegs :: StackMap -> [(LocalReg, StackLoc)]
    stackSlotRegs :: StackMap -> [(LocalReg, WordOff)]
    stackSlotRegs StackMap
    sm = UniqFM LocalReg (LocalReg, WordOff) -> [(LocalReg, WordOff)]
    forall {k} (key :: k) elt. UniqFM key elt -> [elt]
    nonDetEltsUFM (StackMap -> UniqFM LocalReg (LocalReg, WordOff)
    sm_regs StackMap
    sm)
      -- See Note [Unique Determinism and code generation]