    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE CPP #-}

    -----------------------------------------------------------------------------
    --
    -- Building info tables.
    --
    -- (c) The University of Glasgow 2004-2006
    --
    -----------------------------------------------------------------------------

    module GHC.StgToCmm.Layout (
            mkArgDescr,
            emitCall, emitReturn, adjustHpBackwards,

            emitClosureProcAndInfoTable,
            emitClosureAndInfoTable,

            slowCall, directCall,

            FieldOffOrPadding(..),
            ClosureHeader(..),
            mkVirtHeapOffsets,
            mkVirtHeapOffsetsWithPadding,
            mkVirtConstrOffsets,
            mkVirtConstrSizes,
            getHpRelOffset,

            ArgRep(..), toArgRep, argRepSizeW, -- re-exported from GHC.StgToCmm.ArgRep
            getArgAmode, getNonVoidArgAmodes
      ) where

    #include "HsVersions.h"

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

    import GHC.Driver.Session
    import GHC.Driver.Ppr

    import GHC.StgToCmm.Closure
    import GHC.StgToCmm.Env
    import GHC.StgToCmm.ArgRep -- notably: ( slowCallPattern )
    import GHC.StgToCmm.Ticky
    import GHC.StgToCmm.Monad
    import GHC.StgToCmm.Lit
    import GHC.StgToCmm.Utils

    import GHC.Cmm.Graph
    import GHC.Runtime.Heap.Layout
    import GHC.Cmm.BlockId
    import GHC.Cmm
    import GHC.Cmm.Utils
    import GHC.Cmm.Info
    import GHC.Cmm.CLabel
    import GHC.Stg.Syntax
    import GHC.Types.Id
    import GHC.Core.TyCon    ( PrimRep(..), primRepSizeB )
    import GHC.Types.Basic   ( RepArity )
    import GHC.Platform
    import GHC.Platform.Profile
    import GHC.Unit

    import GHC.Utils.Misc
    import Data.List (mapAccumL, partition)
    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import GHC.Data.FastString
    import Control.Monad

    ------------------------------------------------------------------------
    --                Call and return sequences
    ------------------------------------------------------------------------

    -- | Return multiple values to the sequel
    --
    -- If the sequel is @Return@
    --
    -- >     return (x,y)
    --
    -- If the sequel is @AssignTo [p,q]@
    --
    -- >    p=x; q=y;
    --
    emitReturn :: [CmmExpr] -> FCode ReturnKind
    emitReturn :: [CmmExpr] -> FCode ReturnKind
    emitReturn [CmmExpr]
    results
      = do { Profile
    profile   <- FCode Profile
    getProfile
           ; Platform
    platform  <- FCode Platform
    getPlatform
           ; Sequel
    sequel    <- FCode Sequel
    getSequel
           ; Int
    updfr_off <- FCode Int
    getUpdFrameOff
           ; case Sequel
    sequel of
               Sequel
    Return ->
                 do { FCode ()
    adjustHpBackwards
                    ; let e :: CmmExpr
    e = Platform -> CmmExpr -> CmmExpr
    cmmLoadGCWord Platform
    platform (Area -> Int -> CmmExpr
    CmmStackSlot Area
    Old Int
    updfr_off)
                    ; CmmAGraph -> FCode ()
    emit (Profile -> CmmExpr -> [CmmExpr] -> Int -> CmmAGraph
    mkReturn Profile
    profile (Platform -> CmmExpr -> CmmExpr
    entryCode Platform
    platform CmmExpr
    e) [CmmExpr]
    results Int
    updfr_off)
                    }
               AssignTo [LocalReg]
    regs Bool
    adjust ->
                 do { forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    adjust FCode ()
    adjustHpBackwards
                    ; [LocalReg] -> [CmmExpr] -> FCode ()
    emitMultiAssign  [LocalReg]
    regs [CmmExpr]
    results }
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return ReturnKind
    AssignedDirectly
           }

    -- | @emitCall conv fun args@ makes a call to the entry-code of @fun@,
    -- using the call/return convention @conv@, passing @args@, and
    -- returning the results to the current sequel.
    --
    emitCall :: (Convention, Convention) -> CmmExpr -> [CmmExpr] -> FCode ReturnKind
    emitCall :: (Convention, Convention)
    -> CmmExpr -> [CmmExpr] -> FCode ReturnKind
    emitCall (Convention, Convention)
    convs CmmExpr
    fun [CmmExpr]
    args
      = (Convention, Convention)
    -> CmmExpr -> [CmmExpr] -> [CmmExpr] -> FCode ReturnKind
    emitCallWithExtraStack (Convention, Convention)
    convs CmmExpr
    fun [CmmExpr]
    args [CmmExpr]
    noExtraStack

    -- | @emitCallWithExtraStack conv fun args stack@ makes a call to the
    -- entry-code of @fun@, using the call/return convention @conv@,
    -- passing @args@, pushing some extra stack frames described by
    -- @stack@, and returning the results to the current sequel.
    --
    emitCallWithExtraStack
       :: (Convention, Convention) -> CmmExpr -> [CmmExpr]
       -> [CmmExpr] -> FCode ReturnKind
    emitCallWithExtraStack :: (Convention, Convention)
    -> CmmExpr -> [CmmExpr] -> [CmmExpr] -> FCode ReturnKind
    emitCallWithExtraStack (Convention
    callConv, Convention
    retConv) CmmExpr
    fun [CmmExpr]
    args [CmmExpr]
    extra_stack
      = do  { Profile
    profile <- FCode Profile
    getProfile
            ; FCode ()
    adjustHpBackwards
            ; Sequel
    sequel <- FCode Sequel
    getSequel
            ; Int
    updfr_off <- FCode Int
    getUpdFrameOff
            ; case Sequel
    sequel of
                Sequel
    Return -> do
                  CmmAGraph -> FCode ()
    emit forall a b. (a -> b) -> a -> b
    $ Profile
    -> Convention
    -> CmmExpr
    -> [CmmExpr]
    -> Int
    -> [CmmExpr]
    -> CmmAGraph
    mkJumpExtra Profile
    profile Convention
    callConv CmmExpr
    fun [CmmExpr]
    args Int
    updfr_off [CmmExpr]
    extra_stack
                  forall (m :: * -> *) a. Monad m => a -> m a
    return ReturnKind
    AssignedDirectly
                AssignTo [LocalReg]
    res_regs Bool
    _ -> do
                  BlockId
    k <- forall (m :: * -> *). MonadUnique m => m BlockId
    newBlockId
                  let area :: Area
    area = BlockId -> Area
    Young BlockId
    k
                      (Int
    off, [GlobalReg]
    _, CmmAGraph
    copyin) = Profile
    -> Convention
    -> Area
    -> [LocalReg]
    -> [LocalReg]
    -> (Int, [GlobalReg], CmmAGraph)
    copyInOflow Profile
    profile Convention
    retConv Area
    area [LocalReg]
    res_regs []
                      copyout :: CmmAGraph
    copyout = Profile
    -> CmmExpr
    -> Convention
    -> [CmmExpr]
    -> BlockId
    -> Int
    -> Int
    -> [CmmExpr]
    -> CmmAGraph
    mkCallReturnsTo Profile
    profile CmmExpr
    fun Convention
    callConv [CmmExpr]
    args BlockId
    k Int
    off Int
    updfr_off
                                       [CmmExpr]
    extra_stack
                  CmmTickScope
    tscope <- FCode CmmTickScope
    getTickScope
                  CmmAGraph -> FCode ()
    emit (CmmAGraph
    copyout CmmAGraph -> CmmAGraph -> CmmAGraph
    <*> BlockId -> CmmTickScope -> CmmAGraph
    mkLabel BlockId
    k CmmTickScope
    tscope CmmAGraph -> CmmAGraph -> CmmAGraph
    <*> CmmAGraph
    copyin)
                  forall (m :: * -> *) a. Monad m => a -> m a
    return (BlockId -> Int -> ReturnKind
    ReturnedTo BlockId
    k Int
    off)
          }

    adjustHpBackwards :: FCode ()
    -- This function adjusts the heap pointer just before a tail call or
    -- return.  At a call or return, the virtual heap pointer may be less
    -- than the real Hp, because the latter was advanced to deal with
    -- the worst-case branch of the code, and we may be in a better-case
    -- branch.  In that case, move the real Hp *back* and retract some
    -- ticky allocation count.
    --
    -- It *does not* deal with high-water-mark adjustment.  That's done by
    -- functions which allocate heap.
    adjustHpBackwards :: FCode ()
    adjustHpBackwards
      = do  { HeapUsage
    hp_usg <- FCode HeapUsage
    getHpUsage
            ; let rHp :: Int
    rHp = HeapUsage -> Int
    realHp HeapUsage
    hp_usg
                  vHp :: Int
    vHp = HeapUsage -> Int
    virtHp HeapUsage
    hp_usg
                  adjust_words :: Int
    adjust_words = Int
    vHp forall a. Num a => a -> a -> a
    -Int
    rHp
            ; CmmExpr
    new_hp <- Int -> FCode CmmExpr
    getHpRelOffset Int
    vHp

            ; CmmAGraph -> FCode ()
    emit (if Int
    adjust_words forall a. Eq a => a -> a -> Bool
    == Int
    0
                    then CmmAGraph
    mkNop
                    else CmmReg -> CmmExpr -> CmmAGraph
    mkAssign CmmReg
    hpReg CmmExpr
    new_hp) -- Generates nothing when vHp==rHp

            ; Bool -> Int -> FCode ()
    tickyAllocHeap Bool
    False Int
    adjust_words -- ...ditto

            ; Int -> FCode ()
    setRealHp Int
    vHp
            }

    -------------------------------------------------------------------------
    --        Making calls: directCall and slowCall
    -------------------------------------------------------------------------

    -- General plan is:
    --   - we'll make *one* fast call, either to the function itself
    --     (directCall) or to stg_ap_<pat>_fast (slowCall)
    --     Any left-over arguments will be pushed on the stack,
    --
    --     e.g. Sp[old+8]  = arg1
    --          Sp[old+16] = arg2
    --          Sp[old+32] = stg_ap_pp_info
    --          R2 = arg3
    --          R3 = arg4
    --          call f() return to Nothing updfr_off: 32

    directCall :: Convention -> CLabel -> RepArity -> [StgArg] -> FCode ReturnKind
    -- (directCall f n args)
    -- calls f(arg1, ..., argn), and applies the result to the remaining args
    -- The function f has arity n, and there are guaranteed at least n args
    -- Both arity and args include void args
    directCall :: Convention -> CLabel -> Int -> [StgArg] -> FCode ReturnKind
    directCall Convention
    conv CLabel
    lbl Int
    arity [StgArg]
    stg_args
      = do  { [(ArgRep, Maybe CmmExpr)]
    argreps <- [StgArg] -> FCode [(ArgRep, Maybe CmmExpr)]
    getArgRepsAmodes [StgArg]
    stg_args
            ; String
    -> Convention
    -> CLabel
    -> Int
    -> [(ArgRep, Maybe CmmExpr)]
    -> FCode ReturnKind
    direct_call String
    "directCall" Convention
    conv CLabel
    lbl Int
    arity [(ArgRep, Maybe CmmExpr)]
    argreps }

    slowCall :: CmmExpr -> [StgArg] -> FCode ReturnKind
    -- (slowCall fun args) applies fun to args, returning the results to Sequel
    slowCall :: CmmExpr -> [StgArg] -> FCode ReturnKind
    slowCall CmmExpr
    fun [StgArg]
    stg_args
      = do  DynFlags
    dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
            Profile
    profile <- FCode Profile
    getProfile
            let platform :: Platform
    platform = Profile -> Platform
    profilePlatform Profile
    profile
            [(ArgRep, Maybe CmmExpr)]
    argsreps <- [StgArg] -> FCode [(ArgRep, Maybe CmmExpr)]
    getArgRepsAmodes [StgArg]
    stg_args
            let (FastString
    rts_fun, Int
    arity) = [ArgRep] -> (FastString, Int)
    slowCallPattern (forall a b. (a -> b) -> [a] -> [b]
    map forall a b. (a, b) -> a
    fst [(ArgRep, Maybe CmmExpr)]
    argsreps)

            (ReturnKind
    r, CmmAGraph
    slow_code) <- forall a. FCode a -> FCode (a, CmmAGraph)
    getCodeR forall a b. (a -> b) -> a -> b
    $ do
               ReturnKind
    r <- String
    -> Convention
    -> CLabel
    -> Int
    -> [(ArgRep, Maybe CmmExpr)]
    -> FCode ReturnKind
    direct_call String
    "slow_call" Convention
    NativeNodeCall
                     (FastString -> CLabel
    mkRtsApFastLabel FastString
    rts_fun) Int
    arity ((ArgRep
    P,forall a. a -> Maybe a
    Just CmmExpr
    fun)forall a. a -> [a] -> [a]
    :[(ArgRep, Maybe CmmExpr)]
    argsreps)
               FastString -> FCode ()
    emitComment forall a b. (a -> b) -> a -> b
    $ String -> FastString
    mkFastString (String
    "slow_call for " forall a. [a] -> [a] -> [a]
    ++
                                          DynFlags -> SDoc -> String
    showSDoc DynFlags
    dflags (forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CmmExpr
    fun) forall a. [a] -> [a] -> [a]
    ++
                                          String
    " with pat " forall a. [a] -> [a] -> [a]
    ++ FastString -> String
    unpackFS FastString
    rts_fun)
               forall (m :: * -> *) a. Monad m => a -> m a
    return ReturnKind
    r

            -- Note [avoid intermediate PAPs]
            let n_args :: Int
    n_args = forall (t :: * -> *) a. Foldable t => t a -> Int
    length [StgArg]
    stg_args
            if Int
    n_args forall a. Ord a => a -> a -> Bool
    > Int
    arity Bool -> Bool -> Bool
    && DynFlags -> Int
    optLevel DynFlags
    dflags forall a. Ord a => a -> a -> Bool
    >= Int
    2
               then do
                 PtrOpts
    ptr_opts <- FCode PtrOpts
    getPtrOpts
                 CmmExpr
    funv <- (CmmReg -> CmmExpr
    CmmReg forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LocalReg -> CmmReg
    CmmLocal) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` CmmExpr -> FCode LocalReg
    assignTemp CmmExpr
    fun
                 CmmExpr
    fun_iptr <- (CmmReg -> CmmExpr
    CmmReg forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LocalReg -> CmmReg
    CmmLocal) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap`
                        CmmExpr -> FCode LocalReg
    assignTemp (PtrOpts -> CmmExpr -> CmmExpr
    closureInfoPtr PtrOpts
    ptr_opts (Platform -> CmmExpr -> CmmExpr
    cmmUntag Platform
    platform CmmExpr
    funv))

                 -- ToDo: we could do slightly better here by reusing the
                 -- continuation from the slow call, which we have in r.
                 -- Also we'd like to push the continuation on the stack
                 -- before the branch, so that we only get one copy of the
                 -- code that saves all the live variables across the
                 -- call, but that might need some improvements to the
                 -- special case in the stack layout code to handle this
                 -- (see Note [diamond proc point]).

                 CmmAGraph
    fast_code <- forall a. FCode a -> FCode CmmAGraph
    getCode forall a b. (a -> b) -> a -> b
    $
                    (Convention, Convention)
    -> CmmExpr -> [CmmExpr] -> FCode ReturnKind
    emitCall (Convention
    NativeNodeCall, Convention
    NativeReturn)
                      (Platform -> CmmExpr -> CmmExpr
    entryCode Platform
    platform CmmExpr
    fun_iptr)
                      ([(ArgRep, Maybe CmmExpr)] -> [CmmExpr]
    nonVArgs ((ArgRep
    P,forall a. a -> Maybe a
    Just CmmExpr
    funv)forall a. a -> [a] -> [a]
    :[(ArgRep, Maybe CmmExpr)]
    argsreps))

                 BlockId
    slow_lbl <- forall (m :: * -> *). MonadUnique m => m BlockId
    newBlockId
                 BlockId
    fast_lbl <- forall (m :: * -> *). MonadUnique m => m BlockId
    newBlockId
                 BlockId
    is_tagged_lbl <- forall (m :: * -> *). MonadUnique m => m BlockId
    newBlockId
                 BlockId
    end_lbl <- forall (m :: * -> *). MonadUnique m => m BlockId
    newBlockId

                 let correct_arity :: CmmExpr
    correct_arity = Platform -> CmmExpr -> CmmExpr -> CmmExpr
    cmmEqWord Platform
    platform (Profile -> CmmExpr -> CmmExpr
    funInfoArity Profile
    profile CmmExpr
    fun_iptr)
                                                        (Platform -> Int -> CmmExpr
    mkIntExpr Platform
    platform Int
    n_args)

                 CmmTickScope
    tscope <- FCode CmmTickScope
    getTickScope
                 CmmAGraph -> FCode ()
    emit (CmmExpr -> BlockId -> BlockId -> Maybe Bool -> CmmAGraph
    mkCbranch (Platform -> CmmExpr -> CmmExpr
    cmmIsTagged Platform
    platform CmmExpr
    funv)
                                 BlockId
    is_tagged_lbl BlockId
    slow_lbl (forall a. a -> Maybe a
    Just Bool
    True)
                       CmmAGraph -> CmmAGraph -> CmmAGraph
    <*> BlockId -> CmmTickScope -> CmmAGraph
    mkLabel BlockId
    is_tagged_lbl CmmTickScope
    tscope
                       CmmAGraph -> CmmAGraph -> CmmAGraph
    <*> CmmExpr -> BlockId -> BlockId -> Maybe Bool -> CmmAGraph
    mkCbranch CmmExpr
    correct_arity BlockId
    fast_lbl BlockId
    slow_lbl (forall a. a -> Maybe a
    Just Bool
    True)
                       CmmAGraph -> CmmAGraph -> CmmAGraph
    <*> BlockId -> CmmTickScope -> CmmAGraph
    mkLabel BlockId
    fast_lbl CmmTickScope
    tscope
                       CmmAGraph -> CmmAGraph -> CmmAGraph
    <*> CmmAGraph
    fast_code
                       CmmAGraph -> CmmAGraph -> CmmAGraph
    <*> BlockId -> CmmAGraph
    mkBranch BlockId
    end_lbl
                       CmmAGraph -> CmmAGraph -> CmmAGraph
    <*> BlockId -> CmmTickScope -> CmmAGraph
    mkLabel BlockId
    slow_lbl CmmTickScope
    tscope
                       CmmAGraph -> CmmAGraph -> CmmAGraph
    <*> CmmAGraph
    slow_code
                       CmmAGraph -> CmmAGraph -> CmmAGraph
    <*> BlockId -> CmmTickScope -> CmmAGraph
    mkLabel BlockId
    end_lbl CmmTickScope
    tscope)
                 forall (m :: * -> *) a. Monad m => a -> m a
    return ReturnKind
    r

               else do
                 CmmAGraph -> FCode ()
    emit CmmAGraph
    slow_code
                 forall (m :: * -> *) a. Monad m => a -> m a
    return ReturnKind
    r

    -- Note [avoid intermediate PAPs]
    --
    -- A slow call which needs multiple generic apply patterns will be
    -- almost guaranteed to create one or more intermediate PAPs when
    -- applied to a function that takes the correct number of arguments.
    -- We try to avoid this situation by generating code to test whether
    -- we are calling a function with the correct number of arguments
    -- first, i.e.:
    --
    --   if (TAG(f) != 0} {  // f is not a thunk
    --      if (f->info.arity == n) {
    --         ... make a fast call to f ...
    --      }
    --   }
    --   ... otherwise make the slow call ...
    --
    -- We *only* do this when the call requires multiple generic apply
    -- functions, which requires pushing extra stack frames and probably
    -- results in intermediate PAPs.  (I say probably, because it might be
    -- that we're over-applying a function, but that seems even less
    -- likely).
    --
    -- This very rarely applies, but if it does happen in an inner loop it
    -- can have a severe impact on performance (#6084).

    --------------
    direct_call :: String
                -> Convention     -- e.g. NativeNodeCall or NativeDirectCall
                -> CLabel -> RepArity
                -> [(ArgRep,Maybe CmmExpr)] -> FCode ReturnKind
    direct_call :: String
    -> Convention
    -> CLabel
    -> Int
    -> [(ArgRep, Maybe CmmExpr)]
    -> FCode ReturnKind
    direct_call String
    caller Convention
    call_conv CLabel
    lbl Int
    arity [(ArgRep, Maybe CmmExpr)]
    args
      | Bool
    debugIsOn Bool -> Bool -> Bool
    && [(ArgRep, Maybe CmmExpr)]
    args forall a. [a] -> Int -> Bool
    `lengthLessThan` Int
    real_arity  -- Too few args
      = do -- Caller should ensure that there enough args!
           Platform
    platform <- FCode Platform
    getPlatform
           forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "direct_call" forall a b. (a -> b) -> a -> b
    $
                String -> SDoc
    text String
    caller SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr Int
    arity SDoc -> SDoc -> SDoc
    <+>
                forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CLabel
    lbl SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr (forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(ArgRep, Maybe CmmExpr)]
    args) SDoc -> SDoc -> SDoc
    <+>
                forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform (forall a b. (a -> b) -> [a] -> [b]
    map forall a b. (a, b) -> b
    snd [(ArgRep, Maybe CmmExpr)]
    args) SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr (forall a b. (a -> b) -> [a] -> [b]
    map forall a b. (a, b) -> a
    fst [(ArgRep, Maybe CmmExpr)]
    args)

      | forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(ArgRep, Maybe CmmExpr)]
    rest_args  -- Precisely the right number of arguments
      = (Convention, Convention)
    -> CmmExpr -> [CmmExpr] -> FCode ReturnKind
    emitCall (Convention
    call_conv, Convention
    NativeReturn) CmmExpr
    target ([(ArgRep, Maybe CmmExpr)] -> [CmmExpr]
    nonVArgs [(ArgRep, Maybe CmmExpr)]
    args)

      | Bool
    otherwise       -- Note [over-saturated calls]
      = do DynFlags
    dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
           (Convention, Convention)
    -> CmmExpr -> [CmmExpr] -> [CmmExpr] -> FCode ReturnKind
    emitCallWithExtraStack (Convention
    call_conv, Convention
    NativeReturn)
                                  CmmExpr
    target
                                  ([(ArgRep, Maybe CmmExpr)] -> [CmmExpr]
    nonVArgs [(ArgRep, Maybe CmmExpr)]
    fast_args)
                                  ([(ArgRep, Maybe CmmExpr)] -> [CmmExpr]
    nonVArgs (DynFlags -> [(ArgRep, Maybe CmmExpr)]
    stack_args DynFlags
    dflags))
      where
        target :: CmmExpr
    target = CmmLit -> CmmExpr
    CmmLit (CLabel -> CmmLit
    CmmLabel CLabel
    lbl)
        ([(ArgRep, Maybe CmmExpr)]
    fast_args, [(ArgRep, Maybe CmmExpr)]
    rest_args) = forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    real_arity [(ArgRep, Maybe CmmExpr)]
    args
        stack_args :: DynFlags -> [(ArgRep, Maybe CmmExpr)]
    stack_args DynFlags
    dflags = DynFlags -> [(ArgRep, Maybe CmmExpr)] -> [(ArgRep, Maybe CmmExpr)]
    slowArgs DynFlags
    dflags [(ArgRep, Maybe CmmExpr)]
    rest_args
        real_arity :: Int
    real_arity = case Convention
    call_conv of
                       Convention
    NativeNodeCall -> Int
    arityforall a. Num a => a -> a -> a
    +Int
    1
                       Convention
    _              -> Int
    arity

    -- When constructing calls, it is easier to keep the ArgReps and the
    -- CmmExprs zipped together.  However, a void argument has no
    -- representation, so we need to use Maybe CmmExpr (the alternative of
    -- using zeroCLit or even undefined would work, but would be ugly).
    --
    getArgRepsAmodes :: [StgArg] -> FCode [(ArgRep, Maybe CmmExpr)]
    getArgRepsAmodes :: [StgArg] -> FCode [(ArgRep, Maybe CmmExpr)]
    getArgRepsAmodes [StgArg]
    args = do
       Platform
    platform <- Profile -> Platform
    profilePlatform forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FCode Profile
    getProfile
       forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (Platform -> StgArg -> FCode (ArgRep, Maybe CmmExpr)
    getArgRepAmode Platform
    platform) [StgArg]
    args
      where getArgRepAmode :: Platform -> StgArg -> FCode (ArgRep, Maybe CmmExpr)
    getArgRepAmode Platform
    platform StgArg
    arg
               | ArgRep
    V <- ArgRep
    rep  = forall (m :: * -> *) a. Monad m => a -> m a
    return (ArgRep
    V, forall a. Maybe a
    Nothing)
               | Bool
    otherwise = do CmmExpr
    expr <- NonVoid StgArg -> FCode CmmExpr
    getArgAmode (forall a. a -> NonVoid a
    NonVoid StgArg
    arg)
                                forall (m :: * -> *) a. Monad m => a -> m a
    return (ArgRep
    rep, forall a. a -> Maybe a
    Just CmmExpr
    expr)
               where rep :: ArgRep
    rep = Platform -> PrimRep -> ArgRep
    toArgRep Platform
    platform (StgArg -> PrimRep
    argPrimRep StgArg
    arg)

    nonVArgs :: [(ArgRep, Maybe CmmExpr)] -> [CmmExpr]
    nonVArgs :: [(ArgRep, Maybe CmmExpr)] -> [CmmExpr]
    nonVArgs [] = []
    nonVArgs ((ArgRep
    _,Maybe CmmExpr
    Nothing)  : [(ArgRep, Maybe CmmExpr)]
    args) = [(ArgRep, Maybe CmmExpr)] -> [CmmExpr]
    nonVArgs [(ArgRep, Maybe CmmExpr)]
    args
    nonVArgs ((ArgRep
    _,Just CmmExpr
    arg) : [(ArgRep, Maybe CmmExpr)]
    args) = CmmExpr
    arg forall a. a -> [a] -> [a]
    : [(ArgRep, Maybe CmmExpr)] -> [CmmExpr]
    nonVArgs [(ArgRep, Maybe CmmExpr)]
    args

    {-
    Note [over-saturated calls]

    The natural thing to do for an over-saturated call would be to call
    the function with the correct number of arguments, and then apply the
    remaining arguments to the value returned, e.g.

      f a b c d   (where f has arity 2)
      -->
      r = call f(a,b)
      call r(c,d)

    but this entails
      - saving c and d on the stack
      - making a continuation info table
      - at the continuation, loading c and d off the stack into regs
      - finally, call r

    Note that since there are a fixed number of different r's
    (e.g.  stg_ap_pp_fast), we can also pre-compile continuations
    that correspond to each of them, rather than generating a fresh
    one for each over-saturated call.

    Not only does this generate much less code, it is faster too.  We will
    generate something like:

    Sp[old+16] = c
    Sp[old+24] = d
    Sp[old+32] = stg_ap_pp_info
    call f(a,b) -- usual calling convention

    For the purposes of the CmmCall node, we count this extra stack as
    just more arguments that we are passing on the stack (cml_args).
    -}

    -- | 'slowArgs' takes a list of function arguments and prepares them for
    -- pushing on the stack for "extra" arguments to a function which requires
    -- fewer arguments than we currently have.
    slowArgs :: DynFlags -> [(ArgRep, Maybe CmmExpr)] -> [(ArgRep, Maybe CmmExpr)]
    slowArgs :: DynFlags -> [(ArgRep, Maybe CmmExpr)] -> [(ArgRep, Maybe CmmExpr)]
    slowArgs DynFlags
    _ [] = []
    slowArgs DynFlags
    dflags [(ArgRep, Maybe CmmExpr)]
    args -- careful: reps contains voids (V), but args does not
      | DynFlags -> Bool
    sccProfilingEnabled DynFlags
    dflags
                  = [(ArgRep, Maybe CmmExpr)]
    save_cccs forall a. [a] -> [a] -> [a]
    ++ [(ArgRep, Maybe CmmExpr)]
    this_pat forall a. [a] -> [a] -> [a]
    ++ DynFlags -> [(ArgRep, Maybe CmmExpr)] -> [(ArgRep, Maybe CmmExpr)]
    slowArgs DynFlags
    dflags [(ArgRep, Maybe CmmExpr)]
    rest_args
      | Bool
    otherwise =              [(ArgRep, Maybe CmmExpr)]
    this_pat forall a. [a] -> [a] -> [a]
    ++ DynFlags -> [(ArgRep, Maybe CmmExpr)] -> [(ArgRep, Maybe CmmExpr)]
    slowArgs DynFlags
    dflags [(ArgRep, Maybe CmmExpr)]
    rest_args
      where
        (FastString
    arg_pat, Int
    n)            = [ArgRep] -> (FastString, Int)
    slowCallPattern (forall a b. (a -> b) -> [a] -> [b]
    map forall a b. (a, b) -> a
    fst [(ArgRep, Maybe CmmExpr)]
    args)
        ([(ArgRep, Maybe CmmExpr)]
    call_args, [(ArgRep, Maybe CmmExpr)]
    rest_args)  = forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    n [(ArgRep, Maybe CmmExpr)]
    args

        stg_ap_pat :: CLabel
    stg_ap_pat = UnitId -> FastString -> CLabel
    mkCmmRetInfoLabel UnitId
    rtsUnitId FastString
    arg_pat
        this_pat :: [(ArgRep, Maybe CmmExpr)]
    this_pat   = (ArgRep
    N, forall a. a -> Maybe a
    Just (CLabel -> CmmExpr
    mkLblExpr CLabel
    stg_ap_pat)) forall a. a -> [a] -> [a]
    : [(ArgRep, Maybe CmmExpr)]
    call_args
        save_cccs :: [(ArgRep, Maybe CmmExpr)]
    save_cccs  = [(ArgRep
    N, forall a. a -> Maybe a
    Just (CLabel -> CmmExpr
    mkLblExpr CLabel
    save_cccs_lbl)), (ArgRep
    N, forall a. a -> Maybe a
    Just CmmExpr
    cccsExpr)]
        save_cccs_lbl :: CLabel
    save_cccs_lbl = UnitId -> FastString -> CLabel
    mkCmmRetInfoLabel UnitId
    rtsUnitId (String -> FastString
    fsLit String
    "stg_restore_cccs")

    -------------------------------------------------------------------------
    ----        Laying out objects on the heap and stack
    -------------------------------------------------------------------------

    -- The heap always grows upwards, so hpRel is easy to compute
    hpRel :: VirtualHpOffset         -- virtual offset of Hp
          -> VirtualHpOffset         -- virtual offset of The Thing
          -> WordOff                -- integer word offset
    hpRel :: Int -> Int -> Int
    hpRel Int
    hp Int
    off = Int
    off forall a. Num a => a -> a -> a
    - Int
    hp

    getHpRelOffset :: VirtualHpOffset -> FCode CmmExpr
    -- See Note [Virtual and real heap pointers] in GHC.StgToCmm.Monad
    getHpRelOffset :: Int -> FCode CmmExpr
    getHpRelOffset Int
    virtual_offset
      = do Platform
    platform <- FCode Platform
    getPlatform
           HeapUsage
    hp_usg <- FCode HeapUsage
    getHpUsage
           forall (m :: * -> *) a. Monad m => a -> m a
    return (Platform -> CmmReg -> Int -> CmmExpr
    cmmRegOffW Platform
    platform CmmReg
    hpReg (Int -> Int -> Int
    hpRel (HeapUsage -> Int
    realHp HeapUsage
    hp_usg) Int
    virtual_offset))

    data FieldOffOrPadding a
        = FieldOff (NonVoid a) -- Something that needs an offset.
                   ByteOff     -- Offset in bytes.
        | Padding ByteOff  -- Length of padding in bytes.
                  ByteOff  -- Offset in bytes.

    -- | Used to tell the various @mkVirtHeapOffsets@ functions what kind
    -- of header the object has.  This will be accounted for in the
    -- offsets of the fields returned.
    data ClosureHeader
      = NoHeader
      | StdHeader
      | ThunkHeader

    mkVirtHeapOffsetsWithPadding
      :: Profile
      -> ClosureHeader            -- What kind of header to account for
      -> [NonVoid (PrimRep, a)]   -- Things to make offsets for
      -> ( WordOff                -- Total number of words allocated
         , WordOff                -- Number of words allocated for *pointers*
         , [FieldOffOrPadding a]  -- Either an offset or padding.
         )

    -- Things with their offsets from start of object in order of
    -- increasing offset; BUT THIS MAY BE DIFFERENT TO INPUT ORDER
    -- First in list gets lowest offset, which is initial offset + 1.
    --
    -- mkVirtHeapOffsetsWithPadding always returns boxed things with smaller offsets
    -- than the unboxed things

    mkVirtHeapOffsetsWithPadding :: forall a.
    Profile
    -> ClosureHeader
    -> [NonVoid (PrimRep, a)]
    -> (Int, Int, [FieldOffOrPadding a])
    mkVirtHeapOffsetsWithPadding Profile
    profile ClosureHeader
    header [NonVoid (PrimRep, a)]
    things =
        ASSERT(not (any (isVoidRep . fst . fromNonVoid) things))
        ( Int
    tot_wds
        , Platform -> Int -> Int
    bytesToWordsRoundUp Platform
    platform Int
    bytes_of_ptrs
        , forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[FieldOffOrPadding a]]
    ptrs_w_offsets forall a. [a] -> [a] -> [a]
    ++ [[FieldOffOrPadding a]]
    non_ptrs_w_offsets) forall a. [a] -> [a] -> [a]
    ++ [FieldOffOrPadding a]
    final_pad
        )
      where
        platform :: Platform
    platform = Profile -> Platform
    profilePlatform Profile
    profile
        hdr_words :: Int
    hdr_words = case ClosureHeader
    header of
          ClosureHeader
    NoHeader -> Int
    0
          ClosureHeader
    StdHeader -> Profile -> Int
    fixedHdrSizeW Profile
    profile
          ClosureHeader
    ThunkHeader -> Profile -> Int
    thunkHdrSize Profile
    profile
        hdr_bytes :: Int
    hdr_bytes = forall a. Num a => Platform -> a -> a
    wordsToBytes Platform
    platform Int
    hdr_words

        ([NonVoid (PrimRep, a)]
    ptrs, [NonVoid (PrimRep, a)]
    non_ptrs) = forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition (PrimRep -> Bool
    isGcPtrRep forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall a b. (a, b) -> a
    fst forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall a. NonVoid a -> a
    fromNonVoid) [NonVoid (PrimRep, a)]
    things

        (Int
    bytes_of_ptrs, [[FieldOffOrPadding a]]
    ptrs_w_offsets) =
           forall (t :: * -> *) s a b.
    Traversable t =>
    (s -> a -> (s, b)) -> s -> t a -> (s, t b)
    mapAccumL Int -> NonVoid (PrimRep, a) -> (Int, [FieldOffOrPadding a])
    computeOffset Int
    0 [NonVoid (PrimRep, a)]
    ptrs
        (Int
    tot_bytes, [[FieldOffOrPadding a]]
    non_ptrs_w_offsets) =
           forall (t :: * -> *) s a b.
    Traversable t =>
    (s -> a -> (s, b)) -> s -> t a -> (s, t b)
    mapAccumL Int -> NonVoid (PrimRep, a) -> (Int, [FieldOffOrPadding a])
    computeOffset Int
    bytes_of_ptrs [NonVoid (PrimRep, a)]
    non_ptrs

        tot_wds :: Int
    tot_wds = Platform -> Int -> Int
    bytesToWordsRoundUp Platform
    platform Int
    tot_bytes

        final_pad_size :: Int
    final_pad_size = Int
    tot_wds forall a. Num a => a -> a -> a
    * Int
    word_size forall a. Num a => a -> a -> a
    - Int
    tot_bytes
        final_pad :: [FieldOffOrPadding a]
    final_pad
            | Int
    final_pad_size forall a. Ord a => a -> a -> Bool
    > Int
    0 = [(forall a. Int -> Int -> FieldOffOrPadding a
    Padding Int
    final_pad_size
                                             (Int
    hdr_bytes forall a. Num a => a -> a -> a
    + Int
    tot_bytes))]
            | Bool
    otherwise          = []

        word_size :: Int
    word_size = Platform -> Int
    platformWordSizeInBytes Platform
    platform

        computeOffset :: Int -> NonVoid (PrimRep, a) -> (Int, [FieldOffOrPadding a])
    computeOffset Int
    bytes_so_far NonVoid (PrimRep, a)
    nv_thing =
            (Int
    new_bytes_so_far, FieldOffOrPadding a -> [FieldOffOrPadding a]
    with_padding FieldOffOrPadding a
    field_off)
          where
            (PrimRep
    rep, a
    thing) = forall a. NonVoid a -> a
    fromNonVoid NonVoid (PrimRep, a)
    nv_thing

            -- Size of the field in bytes.
            !sizeB :: Int
    sizeB = Platform -> PrimRep -> Int
    primRepSizeB Platform
    platform PrimRep
    rep

            -- Align the start offset (eg, 2-byte value should be 2-byte aligned).
            -- But not more than to a word.
            !align :: Int
    align = forall a. Ord a => a -> a -> a
    min Int
    word_size Int
    sizeB
            !start :: Int
    start = Int -> Int -> Int
    roundUpTo Int
    bytes_so_far Int
    align
            !padding :: Int
    padding = Int
    start forall a. Num a => a -> a -> a
    - Int
    bytes_so_far

            -- Final offset is:
            --   size of header + bytes_so_far + padding
            !final_offset :: Int
    final_offset = Int
    hdr_bytes forall a. Num a => a -> a -> a
    + Int
    bytes_so_far forall a. Num a => a -> a -> a
    + Int
    padding
            !new_bytes_so_far :: Int
    new_bytes_so_far = Int
    start forall a. Num a => a -> a -> a
    + Int
    sizeB
            field_off :: FieldOffOrPadding a
    field_off = forall a. NonVoid a -> Int -> FieldOffOrPadding a
    FieldOff (forall a. a -> NonVoid a
    NonVoid a
    thing) Int
    final_offset

            with_padding :: FieldOffOrPadding a -> [FieldOffOrPadding a]
    with_padding FieldOffOrPadding a
    field_off
                | Int
    padding forall a. Eq a => a -> a -> Bool
    == Int
    0 = [FieldOffOrPadding a
    field_off]
                | Bool
    otherwise    = [ forall a. Int -> Int -> FieldOffOrPadding a
    Padding Int
    padding (Int
    hdr_bytes forall a. Num a => a -> a -> a
    + Int
    bytes_so_far)
                                 , FieldOffOrPadding a
    field_off
                                 ]

    mkVirtHeapOffsets
      :: Profile
      -> ClosureHeader            -- What kind of header to account for
      -> [NonVoid (PrimRep,a)]    -- Things to make offsets for
      -> (WordOff,                -- _Total_ number of words allocated
          WordOff,                -- Number of words allocated for *pointers*
          [(NonVoid a, ByteOff)])
    mkVirtHeapOffsets :: forall a.
    Profile
    -> ClosureHeader
    -> [NonVoid (PrimRep, a)]
    -> (Int, Int, [(NonVoid a, Int)])
    mkVirtHeapOffsets Profile
    profile ClosureHeader
    header [NonVoid (PrimRep, a)]
    things =
        ( Int
    tot_wds
        , Int
    ptr_wds
        , [ (NonVoid a
    field, Int
    offset) | (FieldOff NonVoid a
    field Int
    offset) <- [FieldOffOrPadding a]
    things_offsets ]
        )
      where
       (Int
    tot_wds, Int
    ptr_wds, [FieldOffOrPadding a]
    things_offsets) =
           forall a.
    Profile
    -> ClosureHeader
    -> [NonVoid (PrimRep, a)]
    -> (Int, Int, [FieldOffOrPadding a])
    mkVirtHeapOffsetsWithPadding Profile
    profile ClosureHeader
    header [NonVoid (PrimRep, a)]
    things

    -- | Just like mkVirtHeapOffsets, but for constructors
    mkVirtConstrOffsets
      :: Profile -> [NonVoid (PrimRep, a)]
      -> (WordOff, WordOff, [(NonVoid a, ByteOff)])
    mkVirtConstrOffsets :: forall a.
    Profile -> [NonVoid (PrimRep, a)] -> (Int, Int, [(NonVoid a, Int)])
    mkVirtConstrOffsets Profile
    profile = forall a.
    Profile
    -> ClosureHeader
    -> [NonVoid (PrimRep, a)]
    -> (Int, Int, [(NonVoid a, Int)])
    mkVirtHeapOffsets Profile
    profile ClosureHeader
    StdHeader

    -- | Just like mkVirtConstrOffsets, but used when we don't have the actual
    -- arguments. Useful when e.g. generating info tables; we just need to know
    -- sizes of pointer and non-pointer fields.
    mkVirtConstrSizes :: Profile -> [NonVoid PrimRep] -> (WordOff, WordOff)
    mkVirtConstrSizes :: Profile -> [NonVoid PrimRep] -> (Int, Int)
    mkVirtConstrSizes Profile
    profile [NonVoid PrimRep]
    field_reps
      = (Int
    tot_wds, Int
    ptr_wds)
      where
        (Int
    tot_wds, Int
    ptr_wds, [(NonVoid (), Int)]
    _) =
           forall a.
    Profile -> [NonVoid (PrimRep, a)] -> (Int, Int, [(NonVoid a, Int)])
    mkVirtConstrOffsets Profile
    profile
             (forall a b. (a -> b) -> [a] -> [b]
    map (\NonVoid PrimRep
    nv_rep -> forall a. a -> NonVoid a
    NonVoid (forall a. NonVoid a -> a
    fromNonVoid NonVoid PrimRep
    nv_rep, ())) [NonVoid PrimRep]
    field_reps)

    -------------------------------------------------------------------------
    --
    --        Making argument descriptors
    --
    --  An argument descriptor describes the layout of args on the stack,
    --  both for         * GC (stack-layout) purposes, and
    --                * saving/restoring registers when a heap-check fails
    --
    -- Void arguments aren't important, therefore (contrast constructSlowCall)
    --
    -------------------------------------------------------------------------

    -- bring in ARG_P, ARG_N, etc.
    #include "../includes/rts/storage/FunTypes.h"

    mkArgDescr :: Platform -> [Id] -> ArgDescr
    mkArgDescr :: Platform -> [Id] -> ArgDescr
    mkArgDescr Platform
    platform [Id]
    args
      = let arg_bits :: [Bool]
    arg_bits = Platform -> [ArgRep] -> [Bool]
    argBits Platform
    platform [ArgRep]
    arg_reps
            arg_reps :: [ArgRep]
    arg_reps = forall a. (a -> Bool) -> [a] -> [a]
    filter ArgRep -> Bool
    isNonV (forall a b. (a -> b) -> [a] -> [b]
    map (Platform -> Id -> ArgRep
    idArgRep Platform
    platform) [Id]
    args)
               -- Getting rid of voids eases matching of standard patterns
        in case [ArgRep] -> Maybe Int
    stdPattern [ArgRep]
    arg_reps of
             Just Int
    spec_id -> Int -> ArgDescr
    ArgSpec Int
    spec_id
             Maybe Int
    Nothing      -> [Bool] -> ArgDescr
    ArgGen  [Bool]
    arg_bits

    argBits :: Platform -> [ArgRep] -> [Bool]        -- True for non-ptr, False for ptr
    argBits :: Platform -> [ArgRep] -> [Bool]
    argBits Platform
    _         []           = []
    argBits Platform
    platform (ArgRep
    P   : [ArgRep]
    args) = Bool
    False forall a. a -> [a] -> [a]
    : Platform -> [ArgRep] -> [Bool]
    argBits Platform
    platform [ArgRep]
    args
    argBits Platform
    platform (ArgRep
    arg : [ArgRep]
    args) = forall a. Int -> [a] -> [a]
    take (Platform -> ArgRep -> Int
    argRepSizeW Platform
    platform ArgRep
    arg) (forall a. a -> [a]
    repeat Bool
    True)
                                     forall a. [a] -> [a] -> [a]
    ++ Platform -> [ArgRep] -> [Bool]
    argBits Platform
    platform [ArgRep]
    args

    ----------------------
    stdPattern :: [ArgRep] -> Maybe Int
    stdPattern :: [ArgRep] -> Maybe Int
    stdPattern [ArgRep]
    reps
      = case [ArgRep]
    reps of
            []    -> forall a. a -> Maybe a
    Just ARG_NONE        -- just void args, probably
            [ArgRep
    N]   -> forall a. a -> Maybe a
    Just ARG_N
            [ArgRep
    P]   -> forall a. a -> Maybe a
    Just ARG_P
            [ArgRep
    F]   -> forall a. a -> Maybe a
    Just ARG_F
            [ArgRep
    D]   -> forall a. a -> Maybe a
    Just ARG_D
            [ArgRep
    L]   -> forall a. a -> Maybe a
    Just ARG_L
            [ArgRep
    V16] -> forall a. a -> Maybe a
    Just ARG_V16
            [ArgRep
    V32] -> forall a. a -> Maybe a
    Just ARG_V32
            [ArgRep
    V64] -> forall a. a -> Maybe a
    Just ARG_V64

            [ArgRep
    N,ArgRep
    N] -> forall a. a -> Maybe a
    Just ARG_NN
            [ArgRep
    N,ArgRep
    P] -> forall a. a -> Maybe a
    Just ARG_NP
            [ArgRep
    P,ArgRep
    N] -> forall a. a -> Maybe a
    Just ARG_PN
            [ArgRep
    P,ArgRep
    P] -> forall a. a -> Maybe a
    Just ARG_PP

            [ArgRep
    N,ArgRep
    N,ArgRep
    N] -> forall a. a -> Maybe a
    Just ARG_NNN
            [ArgRep
    N,ArgRep
    N,ArgRep
    P] -> forall a. a -> Maybe a
    Just ARG_NNP
            [ArgRep
    N,ArgRep
    P,ArgRep
    N] -> forall a. a -> Maybe a
    Just ARG_NPN
            [ArgRep
    N,ArgRep
    P,ArgRep
    P] -> forall a. a -> Maybe a
    Just ARG_NPP
            [ArgRep
    P,ArgRep
    N,ArgRep
    N] -> forall a. a -> Maybe a
    Just ARG_PNN
            [ArgRep
    P,ArgRep
    N,ArgRep
    P] -> forall a. a -> Maybe a
    Just ARG_PNP
            [ArgRep
    P,ArgRep
    P,ArgRep
    N] -> forall a. a -> Maybe a
    Just ARG_PPN
            [ArgRep
    P,ArgRep
    P,ArgRep
    P] -> forall a. a -> Maybe a
    Just ARG_PPP

            [ArgRep
    P,ArgRep
    P,ArgRep
    P,ArgRep
    P]     -> forall a. a -> Maybe a
    Just ARG_PPPP
            [ArgRep
    P,ArgRep
    P,ArgRep
    P,ArgRep
    P,ArgRep
    P]   -> forall a. a -> Maybe a
    Just ARG_PPPPP
            [ArgRep
    P,ArgRep
    P,ArgRep
    P,ArgRep
    P,ArgRep
    P,ArgRep
    P] -> forall a. a -> Maybe a
    Just ARG_PPPPPP

            [ArgRep]
    _ -> forall a. Maybe a
    Nothing

    -------------------------------------------------------------------------
    --        Amodes for arguments
    -------------------------------------------------------------------------

    getArgAmode :: NonVoid StgArg -> FCode CmmExpr
    getArgAmode :: NonVoid StgArg -> FCode CmmExpr
    getArgAmode (NonVoid (StgVarArg Id
    var)) = CgIdInfo -> CmmExpr
    idInfoToAmode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Id -> FCode CgIdInfo
    getCgIdInfo Id
    var
    getArgAmode (NonVoid (StgLitArg Literal
    lit)) = Literal -> FCode CmmExpr
    cgLit Literal
    lit

    getNonVoidArgAmodes :: [StgArg] -> FCode [CmmExpr]
    -- NB: Filters out void args,
    --     so the result list may be shorter than the argument list
    getNonVoidArgAmodes :: [StgArg] -> FCode [CmmExpr]
    getNonVoidArgAmodes [] = forall (m :: * -> *) a. Monad m => a -> m a
    return []
    getNonVoidArgAmodes (StgArg
    arg:[StgArg]
    args)
      | PrimRep -> Bool
    isVoidRep (StgArg -> PrimRep
    argPrimRep StgArg
    arg) = [StgArg] -> FCode [CmmExpr]
    getNonVoidArgAmodes [StgArg]
    args
      | Bool
    otherwise = do { CmmExpr
    amode  <- NonVoid StgArg -> FCode CmmExpr
    getArgAmode (forall a. a -> NonVoid a
    NonVoid StgArg
    arg)
                       ; [CmmExpr]
    amodes <- [StgArg] -> FCode [CmmExpr]
    getNonVoidArgAmodes [StgArg]
    args
                       ; forall (m :: * -> *) a. Monad m => a -> m a
    return ( CmmExpr
    amode forall a. a -> [a] -> [a]
    : [CmmExpr]
    amodes ) }

    -------------------------------------------------------------------------
    --
    --        Generating the info table and code for a closure
    --
    -------------------------------------------------------------------------

    -- Here we make an info table of type 'CmmInfo'.  The concrete
    -- representation as a list of 'CmmAddr' is handled later
    -- in the pipeline by 'cmmToRawCmm'.
    -- When loading the free variables, a function closure pointer may be tagged,
    -- so we must take it into account.

    emitClosureProcAndInfoTable :: Bool                    -- top-level?
                                -> Id                      -- name of the closure
                                -> LambdaFormInfo
                                -> CmmInfoTable
                                -> [NonVoid Id]            -- incoming arguments
                                -> ((Int, LocalReg, [LocalReg]) -> FCode ()) -- function body
                                -> FCode ()
    emitClosureProcAndInfoTable :: Bool
    -> Id
    -> LambdaFormInfo
    -> CmmInfoTable
    -> [NonVoid Id]
    -> ((Int, LocalReg, [LocalReg]) -> FCode ())
    -> FCode ()
    emitClosureProcAndInfoTable Bool
    top_lvl Id
    bndr LambdaFormInfo
    lf_info CmmInfoTable
    info_tbl [NonVoid Id]
    args (Int, LocalReg, [LocalReg]) -> FCode ()
    body
     = do   { Profile
    profile <- FCode Profile
    getProfile
            ; Platform
    platform <- FCode Platform
    getPlatform
            -- Bind the binder itself, but only if it's not a top-level
            -- binding. We need non-top let-bindings to refer to the
            -- top-level binding, which this binding would incorrectly shadow.
            ; LocalReg
    node <- if Bool
    top_lvl then forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ Platform -> NonVoid Id -> LocalReg
    idToReg Platform
    platform (forall a. a -> NonVoid a
    NonVoid Id
    bndr)
                      else NonVoid Id -> LambdaFormInfo -> FCode LocalReg
    bindToReg (forall a. a -> NonVoid a
    NonVoid Id
    bndr) LambdaFormInfo
    lf_info
            ; let node_points :: Bool
    node_points = Profile -> LambdaFormInfo -> Bool
    nodeMustPointToIt Profile
    profile LambdaFormInfo
    lf_info
            ; [LocalReg]
    arg_regs <- [NonVoid Id] -> FCode [LocalReg]
    bindArgsToRegs [NonVoid Id]
    args
            ; let args' :: [LocalReg]
    args' = if Bool
    node_points then (LocalReg
    node forall a. a -> [a] -> [a]
    : [LocalReg]
    arg_regs) else [LocalReg]
    arg_regs
                  conv :: Convention
    conv  = if Profile -> LambdaFormInfo -> Bool
    nodeMustPointToIt Profile
    profile LambdaFormInfo
    lf_info then Convention
    NativeNodeCall
                                                              else Convention
    NativeDirectCall
                  (Int
    offset, [GlobalReg]
    _, CmmAGraph
    _) = Profile
    -> Convention
    -> [LocalReg]
    -> [LocalReg]
    -> (Int, [GlobalReg], CmmAGraph)
    mkCallEntry Profile
    profile Convention
    conv [LocalReg]
    args' []
            ; Platform
    -> CmmInfoTable -> Convention -> [LocalReg] -> FCode () -> FCode ()
    emitClosureAndInfoTable (Profile -> Platform
    profilePlatform Profile
    profile) CmmInfoTable
    info_tbl Convention
    conv [LocalReg]
    args' forall a b. (a -> b) -> a -> b
    $ (Int, LocalReg, [LocalReg]) -> FCode ()
    body (Int
    offset, LocalReg
    node, [LocalReg]
    arg_regs)
            }

    -- Data constructors need closures, but not with all the argument handling
    -- needed for functions. The shared part goes here.
    emitClosureAndInfoTable
       :: Platform -> CmmInfoTable -> Convention -> [LocalReg] -> FCode () -> FCode ()
    emitClosureAndInfoTable :: Platform
    -> CmmInfoTable -> Convention -> [LocalReg] -> FCode () -> FCode ()
    emitClosureAndInfoTable Platform
    platform CmmInfoTable
    info_tbl Convention
    conv [LocalReg]
    args FCode ()
    body
      = do { (()
    _, CmmAGraphScoped
    blks) <- forall a. FCode a -> FCode (a, CmmAGraphScoped)
    getCodeScoped FCode ()
    body
           ; let entry_lbl :: CLabel
    entry_lbl = Platform -> CLabel -> CLabel
    toEntryLbl Platform
    platform (CmmInfoTable -> CLabel
    cit_lbl CmmInfoTable
    info_tbl)
           ; Convention
    -> Maybe CmmInfoTable
    -> CLabel
    -> [LocalReg]
    -> CmmAGraphScoped
    -> FCode ()
    emitProcWithConvention Convention
    conv (forall a. a -> Maybe a
    Just CmmInfoTable
    info_tbl) CLabel
    entry_lbl [LocalReg]
    args CmmAGraphScoped
    blks
           }