    {-# LANGUAGE CPP #-}
    module GHC.Cmm.Info (
      mkEmptyContInfoTable,
      cmmToRawCmm,
      srtEscape,

      -- info table accessors
      PtrOpts (..),
      closureInfoPtr,
      entryCode,
      getConstrTag,
      cmmGetClosureType,
      infoTable,
      infoTableConstrTag,
      infoTableSrtBitmap,
      infoTableClosureType,
      infoTablePtrs,
      infoTableNonPtrs,
      funInfoTable,
      funInfoArity,

      -- info table sizes and offsets
      stdInfoTableSizeW,
      fixedInfoTableSizeW,
      profInfoTableSizeW,
      maxStdInfoTableSizeW,
      maxRetInfoTableSizeW,
      stdInfoTableSizeB,
      conInfoTableSizeB,
      stdSrtBitmapOffset,
      stdClosureTypeOffset,
      stdPtrsOffset, stdNonPtrsOffset,
    ) where

    #include "HsVersions.h"

    import GHC.Prelude

    import GHC.Cmm
    import GHC.Cmm.Utils
    import GHC.Cmm.CLabel
    import GHC.Runtime.Heap.Layout
    import GHC.Data.Bitmap
    import GHC.Data.Stream (Stream)
    import qualified GHC.Data.Stream as Stream
    import GHC.Cmm.Dataflow.Collections

    import GHC.Platform
    import GHC.Platform.Profile
    import GHC.Data.Maybe
    import GHC.Driver.Session
    import GHC.Utils.Error (withTimingSilent)
    import GHC.Utils.Panic
    import GHC.Types.Unique.Supply
    import GHC.Utils.Logger
    import GHC.Utils.Monad
    import GHC.Utils.Misc
    import GHC.Utils.Outputable

    import Data.ByteString (ByteString)

    -- When we split at proc points, we need an empty info table.
    mkEmptyContInfoTable :: CLabel -> CmmInfoTable
    mkEmptyContInfoTable :: CLabel -> CmmInfoTable
    mkEmptyContInfoTable CLabel
    info_lbl
      = CmmInfoTable { cit_lbl :: CLabel
    cit_lbl  = CLabel
    info_lbl
                     , cit_rep :: SMRep
    cit_rep  = [Bool] -> SMRep
    mkStackRep []
                     , cit_prof :: ProfilingInfo
    cit_prof = ProfilingInfo
    NoProfilingInfo
                     , cit_srt :: Maybe CLabel
    cit_srt  = Maybe CLabel
    forall a. Maybe a
    Nothing
                     , cit_clo :: Maybe (Id, CostCentreStack)
    cit_clo  = Maybe (Id, CostCentreStack)
    forall a. Maybe a
    Nothing }

    cmmToRawCmm :: Logger -> DynFlags -> Stream IO CmmGroupSRTs a
                -> IO (Stream IO RawCmmGroup a)
    cmmToRawCmm :: forall a.
    Logger
    -> DynFlags
    -> Stream IO CmmGroupSRTs a
    -> IO (Stream IO RawCmmGroup a)
    cmmToRawCmm Logger
    logger DynFlags
    dflags Stream IO CmmGroupSRTs a
    cmms
      = do {
           ; let do_one :: [CmmDeclSRTs] -> IO [RawCmmDecl]
                 do_one :: CmmGroupSRTs -> IO RawCmmGroup
    do_one CmmGroupSRTs
    cmm = do
                   UniqSupply
    uniqs <- Char -> IO UniqSupply
    mkSplitUniqSupply Char
    'i'
                   -- NB. strictness fixes a space leak.  DO NOT REMOVE.
                   Logger
    -> DynFlags
    -> SDoc
    -> (RawCmmGroup -> ())
    -> IO RawCmmGroup
    -> IO RawCmmGroup
    forall (m :: * -> *) a.
    MonadIO m =>
    Logger -> DynFlags -> SDoc -> (a -> ()) -> m a -> m a
    withTimingSilent Logger
    logger DynFlags
    dflags (String -> SDoc
    text String
    "Cmm -> Raw Cmm")
                              (\RawCmmGroup
    x -> RawCmmGroup -> () -> ()
    forall a b. [a] -> b -> b
    seqList RawCmmGroup
    x ())
                      -- TODO: It might be better to make `mkInfoTable` run in
                      -- IO as well so we don't have to pass around
                      -- a UniqSupply (see #16843)
                     (RawCmmGroup -> IO RawCmmGroup
    forall (m :: * -> *) a. Monad m => a -> m a
    return (RawCmmGroup -> IO RawCmmGroup) -> RawCmmGroup -> IO RawCmmGroup
    forall a b. (a -> b) -> a -> b
    $ UniqSupply -> UniqSM RawCmmGroup -> RawCmmGroup
    forall a. UniqSupply -> UniqSM a -> a
    initUs_ UniqSupply
    uniqs (UniqSM RawCmmGroup -> RawCmmGroup)
    -> UniqSM RawCmmGroup -> RawCmmGroup
    forall a b. (a -> b) -> a -> b
    $ (CmmDeclSRTs -> UniqSM RawCmmGroup)
    -> CmmGroupSRTs -> UniqSM RawCmmGroup
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
    concatMapM (DynFlags -> CmmDeclSRTs -> UniqSM RawCmmGroup
    mkInfoTable DynFlags
    dflags) CmmGroupSRTs
    cmm)
           ; Stream IO RawCmmGroup a -> IO (Stream IO RawCmmGroup a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((CmmGroupSRTs -> IO RawCmmGroup)
    -> Stream IO CmmGroupSRTs a -> Stream IO RawCmmGroup a
    forall (m :: * -> *) a b x.
    Monad m =>
    (a -> m b) -> Stream m a x -> Stream m b x
    Stream.mapM CmmGroupSRTs -> IO RawCmmGroup
    do_one Stream IO CmmGroupSRTs a
    cmms)
           }

    -- Make a concrete info table, represented as a list of CmmStatic
    -- (it can't be simply a list of Word, because the SRT field is
    -- represented by a label+offset expression).
    --
    -- With tablesNextToCode, the layout is
    --      <reversed variable part>
    --      <normal forward StgInfoTable, but without
    --              an entry point at the front>
    --      <code>
    --
    -- Without tablesNextToCode, the layout of an info table is
    --      <entry label>
    --      <normal forward rest of StgInfoTable>
    --      <forward variable part>
    --
    --      See includes/rts/storage/InfoTables.h
    --
    -- For return-points these are as follows
    --
    -- Tables next to code:
    --
    --                      <srt slot>
    --                      <standard info table>
    --      ret-addr -->    <entry code (if any)>
    --
    -- Not tables-next-to-code:
    --
    --      ret-addr -->    <ptr to entry code>
    --                      <standard info table>
    --                      <srt slot>
    --
    --  * The SRT slot is only there if there is SRT info to record

    mkInfoTable :: DynFlags -> CmmDeclSRTs -> UniqSM [RawCmmDecl]
    mkInfoTable :: DynFlags -> CmmDeclSRTs -> UniqSM RawCmmGroup
    mkInfoTable DynFlags
    _ (CmmData Section
    sec RawCmmStatics
    dat) = RawCmmGroup -> UniqSM RawCmmGroup
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Section
    -> RawCmmStatics
    -> GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
    forall d h g. Section -> d -> GenCmmDecl d h g
    CmmData Section
    sec RawCmmStatics
    dat]

    mkInfoTable DynFlags
    dflags proc :: CmmDeclSRTs
    proc@(CmmProc CmmTopInfo
    infos CLabel
    entry_lbl [GlobalReg]
    live CmmGraph
    blocks)
      --
      -- in the non-tables-next-to-code case, procs can have at most a
      -- single info table associated with the entry label of the proc.
      --
      | Bool -> Bool
    not (Platform -> Bool
    platformTablesNextToCode (DynFlags -> Platform
    targetPlatform DynFlags
    dflags))
      = case CmmDeclSRTs -> Maybe CmmInfoTable
    forall a (n :: Extensibility -> Extensibility -> *).
    GenCmmDecl a CmmTopInfo (GenCmmGraph n) -> Maybe CmmInfoTable
    topInfoTable CmmDeclSRTs
    proc of   --  must be at most one
          -- no info table
          Maybe CmmInfoTable
    Nothing ->
             RawCmmGroup -> UniqSM RawCmmGroup
    forall (m :: * -> *) a. Monad m => a -> m a
    return [LabelMap RawCmmStatics
    -> CLabel
    -> [GlobalReg]
    -> CmmGraph
    -> GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
    forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
    CmmProc LabelMap RawCmmStatics
    forall (map :: * -> *) a. IsMap map => map a
    mapEmpty CLabel
    entry_lbl [GlobalReg]
    live CmmGraph
    blocks]

          Just info :: CmmInfoTable
    info@CmmInfoTable { cit_lbl :: CmmInfoTable -> CLabel
    cit_lbl = CLabel
    info_lbl } -> do
            (RawCmmGroup
    top_decls, ([CmmLit]
    std_info, [CmmLit]
    extra_bits)) <-
                 DynFlags
    -> CmmInfoTable
    -> Maybe WordOff
    -> UniqSM (RawCmmGroup, InfoTableContents)
    mkInfoTableContents DynFlags
    dflags CmmInfoTable
    info Maybe WordOff
    forall a. Maybe a
    Nothing
            let
              rel_std_info :: [CmmLit]
    rel_std_info   = (CmmLit -> CmmLit) -> [CmmLit] -> [CmmLit]
    forall a b. (a -> b) -> [a] -> [b]
    map (Platform -> CLabel -> CmmLit -> CmmLit
    makeRelativeRefTo Platform
    platform CLabel
    info_lbl) [CmmLit]
    std_info
              rel_extra_bits :: [CmmLit]
    rel_extra_bits = (CmmLit -> CmmLit) -> [CmmLit] -> [CmmLit]
    forall a b. (a -> b) -> [a] -> [b]
    map (Platform -> CLabel -> CmmLit -> CmmLit
    makeRelativeRefTo Platform
    platform CLabel
    info_lbl) [CmmLit]
    extra_bits
            --
            -- Separately emit info table (with the function entry
            -- point as first entry) and the entry code
            --
            RawCmmGroup -> UniqSM RawCmmGroup
    forall (m :: * -> *) a. Monad m => a -> m a
    return (RawCmmGroup
    top_decls RawCmmGroup -> RawCmmGroup -> RawCmmGroup
    forall a. [a] -> [a] -> [a]
    ++
                    [LabelMap RawCmmStatics
    -> CLabel
    -> [GlobalReg]
    -> CmmGraph
    -> GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
    forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
    CmmProc LabelMap RawCmmStatics
    forall (map :: * -> *) a. IsMap map => map a
    mapEmpty CLabel
    entry_lbl [GlobalReg]
    live CmmGraph
    blocks,
                     CLabel
    -> [CmmLit]
    -> GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
    forall (raw :: Bool) info stmt.
    CLabel -> [CmmLit] -> GenCmmDecl (GenCmmStatics raw) info stmt
    mkRODataLits CLabel
    info_lbl
                        (CLabel -> CmmLit
    CmmLabel CLabel
    entry_lbl CmmLit -> [CmmLit] -> [CmmLit]
    forall a. a -> [a] -> [a]
    : [CmmLit]
    rel_std_info [CmmLit] -> [CmmLit] -> [CmmLit]
    forall a. [a] -> [a] -> [a]
    ++ [CmmLit]
    rel_extra_bits)])

      --
      -- With tables-next-to-code, we can have many info tables,
      -- associated with some of the BlockIds of the proc.  For each info
      -- table we need to turn it into CmmStatics, and collect any new
      -- CmmDecls that arise from doing so.
      --
      | Bool
    otherwise
      = do
        ([RawCmmGroup]
    top_declss, [(Label, RawCmmStatics)]
    raw_infos) <-
           [(RawCmmGroup, (Label, RawCmmStatics))]
    -> ([RawCmmGroup], [(Label, RawCmmStatics)])
    forall a b. [(a, b)] -> ([a], [b])
    unzip ([(RawCmmGroup, (Label, RawCmmStatics))]
     -> ([RawCmmGroup], [(Label, RawCmmStatics)]))
    -> UniqSM [(RawCmmGroup, (Label, RawCmmStatics))]
    -> UniqSM ([RawCmmGroup], [(Label, RawCmmStatics)])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` ((Label, CmmInfoTable)
     -> UniqSM (RawCmmGroup, (Label, RawCmmStatics)))
    -> [(Label, CmmInfoTable)]
    -> UniqSM [(RawCmmGroup, (Label, RawCmmStatics))]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (Label, CmmInfoTable)
    -> UniqSM (RawCmmGroup, (Label, RawCmmStatics))
    do_one_info (LabelMap CmmInfoTable -> [(KeyOf LabelMap, CmmInfoTable)]
    forall (map :: * -> *) a. IsMap map => map a -> [(KeyOf map, a)]
    mapToList (CmmTopInfo -> LabelMap CmmInfoTable
    info_tbls CmmTopInfo
    infos))
        RawCmmGroup -> UniqSM RawCmmGroup
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([RawCmmGroup] -> RawCmmGroup
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [RawCmmGroup]
    top_declss RawCmmGroup -> RawCmmGroup -> RawCmmGroup
    forall a. [a] -> [a] -> [a]
    ++
                [LabelMap RawCmmStatics
    -> CLabel
    -> [GlobalReg]
    -> CmmGraph
    -> GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
    forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
    CmmProc ([(KeyOf LabelMap, RawCmmStatics)] -> LabelMap RawCmmStatics
    forall (map :: * -> *) a. IsMap map => [(KeyOf map, a)] -> map a
    mapFromList [(KeyOf LabelMap, RawCmmStatics)]
    [(Label, RawCmmStatics)]
    raw_infos) CLabel
    entry_lbl [GlobalReg]
    live CmmGraph
    blocks])

      where
       platform :: Platform
    platform = DynFlags -> Platform
    targetPlatform DynFlags
    dflags
       do_one_info :: (Label, CmmInfoTable)
    -> UniqSM (RawCmmGroup, (Label, RawCmmStatics))
    do_one_info (Label
    lbl,CmmInfoTable
    itbl) = do
         (RawCmmGroup
    top_decls, ([CmmLit]
    std_info, [CmmLit]
    extra_bits)) <-
             DynFlags
    -> CmmInfoTable
    -> Maybe WordOff
    -> UniqSM (RawCmmGroup, InfoTableContents)
    mkInfoTableContents DynFlags
    dflags CmmInfoTable
    itbl Maybe WordOff
    forall a. Maybe a
    Nothing
         let
            info_lbl :: CLabel
    info_lbl = CmmInfoTable -> CLabel
    cit_lbl CmmInfoTable
    itbl
            rel_std_info :: [CmmLit]
    rel_std_info   = (CmmLit -> CmmLit) -> [CmmLit] -> [CmmLit]
    forall a b. (a -> b) -> [a] -> [b]
    map (Platform -> CLabel -> CmmLit -> CmmLit
    makeRelativeRefTo Platform
    platform CLabel
    info_lbl) [CmmLit]
    std_info
            rel_extra_bits :: [CmmLit]
    rel_extra_bits = (CmmLit -> CmmLit) -> [CmmLit] -> [CmmLit]
    forall a b. (a -> b) -> [a] -> [b]
    map (Platform -> CLabel -> CmmLit -> CmmLit
    makeRelativeRefTo Platform
    platform CLabel
    info_lbl) [CmmLit]
    extra_bits
         --
         (RawCmmGroup, (Label, RawCmmStatics))
    -> UniqSM (RawCmmGroup, (Label, RawCmmStatics))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (RawCmmGroup
    top_decls, (Label
    lbl, CLabel -> [CmmStatic] -> RawCmmStatics
    forall (a :: Bool). CLabel -> [CmmStatic] -> GenCmmStatics a
    CmmStaticsRaw CLabel
    info_lbl ([CmmStatic] -> RawCmmStatics) -> [CmmStatic] -> RawCmmStatics
    forall a b. (a -> b) -> a -> b
    $ (CmmLit -> CmmStatic) -> [CmmLit] -> [CmmStatic]
    forall a b. (a -> b) -> [a] -> [b]
    map CmmLit -> CmmStatic
    CmmStaticLit ([CmmLit] -> [CmmStatic]) -> [CmmLit] -> [CmmStatic]
    forall a b. (a -> b) -> a -> b
    $
                                  [CmmLit] -> [CmmLit]
    forall a. [a] -> [a]
    reverse [CmmLit]
    rel_extra_bits [CmmLit] -> [CmmLit] -> [CmmLit]
    forall a. [a] -> [a] -> [a]
    ++ [CmmLit]
    rel_std_info))

    -----------------------------------------------------
    type InfoTableContents = ( [CmmLit]          -- The standard part
                             , [CmmLit] )        -- The "extra bits"
    -- These Lits have *not* had mkRelativeTo applied to them

    mkInfoTableContents :: DynFlags
                        -> CmmInfoTable
                        -> Maybe Int               -- Override default RTS type tag?
                        -> UniqSM ([RawCmmDecl],             -- Auxiliary top decls
                                   InfoTableContents)       -- Info tbl + extra bits

    mkInfoTableContents :: DynFlags
    -> CmmInfoTable
    -> Maybe WordOff
    -> UniqSM (RawCmmGroup, InfoTableContents)
    mkInfoTableContents DynFlags
    dflags
                        info :: CmmInfoTable
    info@(CmmInfoTable { cit_lbl :: CmmInfoTable -> CLabel
    cit_lbl  = CLabel
    info_lbl
                                           , cit_rep :: CmmInfoTable -> SMRep
    cit_rep  = SMRep
    smrep
                                           , cit_prof :: CmmInfoTable -> ProfilingInfo
    cit_prof = ProfilingInfo
    prof
                                           , cit_srt :: CmmInfoTable -> Maybe CLabel
    cit_srt = Maybe CLabel
    srt })
                        Maybe WordOff
    mb_rts_tag
      | RTSRep WordOff
    rts_tag SMRep
    rep <- SMRep
    smrep
      = DynFlags
    -> CmmInfoTable
    -> Maybe WordOff
    -> UniqSM (RawCmmGroup, InfoTableContents)
    mkInfoTableContents DynFlags
    dflags CmmInfoTable
    info{cit_rep :: SMRep
    cit_rep = SMRep
    rep} (WordOff -> Maybe WordOff
    forall a. a -> Maybe a
    Just WordOff
    rts_tag)
        -- Completely override the rts_tag that mkInfoTableContents would
        -- otherwise compute, with the rts_tag stored in the RTSRep
        -- (which in turn came from a handwritten .cmm file)

      | StackRep [Bool]
    frame <- SMRep
    smrep
      = do { ((CmmLit, CmmLit)
    prof_lits, RawCmmGroup
    prof_data) <- Platform -> ProfilingInfo -> UniqSM ((CmmLit, CmmLit), RawCmmGroup)
    mkProfLits Platform
    platform ProfilingInfo
    prof
           ; let ([CmmLit]
    srt_label, CmmLit
    srt_bitmap) = Platform -> CLabel -> Maybe CLabel -> ([CmmLit], CmmLit)
    mkSRTLit Platform
    platform CLabel
    info_lbl Maybe CLabel
    srt
           ; (CmmLit
    liveness_lit, RawCmmGroup
    liveness_data) <- DynFlags -> [Bool] -> UniqSM (CmmLit, RawCmmGroup)
    mkLivenessBits DynFlags
    dflags [Bool]
    frame
           ; let
                 std_info :: [CmmLit]
    std_info = DynFlags
    -> (CmmLit, CmmLit) -> WordOff -> CmmLit -> CmmLit -> [CmmLit]
    mkStdInfoTable DynFlags
    dflags (CmmLit, CmmLit)
    prof_lits WordOff
    rts_tag CmmLit
    srt_bitmap CmmLit
    liveness_lit
                 rts_tag :: WordOff
    rts_tag | Just WordOff
    tag <- Maybe WordOff
    mb_rts_tag = WordOff
    tag
                         | RawCmmGroup -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null RawCmmGroup
    liveness_data     = WordOff
    rET_SMALL -- Fits in extra_bits
                         | Bool
    otherwise              = WordOff
    rET_BIG   -- Does not; extra_bits is
                                                              -- a label
           ; (RawCmmGroup, InfoTableContents)
    -> UniqSM (RawCmmGroup, InfoTableContents)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (RawCmmGroup
    prof_data RawCmmGroup -> RawCmmGroup -> RawCmmGroup
    forall a. [a] -> [a] -> [a]
    ++ RawCmmGroup
    liveness_data, ([CmmLit]
    std_info, [CmmLit]
    srt_label)) }

      | HeapRep Bool
    _ WordOff
    ptrs WordOff
    nonptrs ClosureTypeInfo
    closure_type <- SMRep
    smrep
      = do { let layout :: CmmLit
    layout  = Platform -> WordOff -> WordOff -> CmmLit
    packIntsCLit Platform
    platform WordOff
    ptrs WordOff
    nonptrs
           ; ((CmmLit, CmmLit)
    prof_lits, RawCmmGroup
    prof_data) <- Platform -> ProfilingInfo -> UniqSM ((CmmLit, CmmLit), RawCmmGroup)
    mkProfLits Platform
    platform ProfilingInfo
    prof
           ; let ([CmmLit]
    srt_label, CmmLit
    srt_bitmap) = Platform -> CLabel -> Maybe CLabel -> ([CmmLit], CmmLit)
    mkSRTLit Platform
    platform CLabel
    info_lbl Maybe CLabel
    srt
           ; (Maybe CmmLit
    mb_srt_field, Maybe CmmLit
    mb_layout, [CmmLit]
    extra_bits, RawCmmGroup
    ct_data)
                                    <- ClosureTypeInfo
    -> [CmmLit]
    -> UniqSM (Maybe CmmLit, Maybe CmmLit, [CmmLit], RawCmmGroup)
    mk_pieces ClosureTypeInfo
    closure_type [CmmLit]
    srt_label
           ; let std_info :: [CmmLit]
    std_info = DynFlags
    -> (CmmLit, CmmLit) -> WordOff -> CmmLit -> CmmLit -> [CmmLit]
    mkStdInfoTable DynFlags
    dflags (CmmLit, CmmLit)
    prof_lits
                                           (Maybe WordOff
    mb_rts_tag   Maybe WordOff -> WordOff -> WordOff
    forall a. Maybe a -> a -> a
    `orElse` SMRep -> WordOff
    rtsClosureType SMRep
    smrep)
                                           (Maybe CmmLit
    mb_srt_field Maybe CmmLit -> CmmLit -> CmmLit
    forall a. Maybe a -> a -> a
    `orElse` CmmLit
    srt_bitmap)
                                           (Maybe CmmLit
    mb_layout    Maybe CmmLit -> CmmLit -> CmmLit
    forall a. Maybe a -> a -> a
    `orElse` CmmLit
    layout)
           ; (RawCmmGroup, InfoTableContents)
    -> UniqSM (RawCmmGroup, InfoTableContents)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (RawCmmGroup
    prof_data RawCmmGroup -> RawCmmGroup -> RawCmmGroup
    forall a. [a] -> [a] -> [a]
    ++ RawCmmGroup
    ct_data, ([CmmLit]
    std_info, [CmmLit]
    extra_bits)) }
      where
        platform :: Platform
    platform = DynFlags -> Platform
    targetPlatform DynFlags
    dflags
        mk_pieces :: ClosureTypeInfo -> [CmmLit]
                  -> UniqSM ( Maybe CmmLit  -- Override the SRT field with this
                            , Maybe CmmLit  -- Override the layout field with this
                            , [CmmLit]           -- "Extra bits" for info table
                            , [RawCmmDecl])      -- Auxiliary data decls
        mk_pieces :: ClosureTypeInfo
    -> [CmmLit]
    -> UniqSM (Maybe CmmLit, Maybe CmmLit, [CmmLit], RawCmmGroup)
    mk_pieces (Constr WordOff
    con_tag ConstrDescription
    con_descr) [CmmLit]
    _no_srt    -- A data constructor
          = do { (CmmLit
    descr_lit, GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
    decl) <- ConstrDescription
    -> UniqSM
         (CmmLit,
          GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph)
    forall info stmt.
    ConstrDescription
    -> UniqSM (CmmLit, GenCmmDecl RawCmmStatics info stmt)
    newStringLit ConstrDescription
    con_descr
               ; (Maybe CmmLit, Maybe CmmLit, [CmmLit], RawCmmGroup)
    -> UniqSM (Maybe CmmLit, Maybe CmmLit, [CmmLit], RawCmmGroup)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ( CmmLit -> Maybe CmmLit
    forall a. a -> Maybe a
    Just (Integer -> Width -> CmmLit
    CmmInt (WordOff -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral WordOff
    con_tag)
                                       (Platform -> Width
    halfWordWidth Platform
    platform))
                        , Maybe CmmLit
    forall a. Maybe a
    Nothing, [CmmLit
    descr_lit], [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
    decl]) }

        mk_pieces ClosureTypeInfo
    Thunk [CmmLit]
    srt_label
          = (Maybe CmmLit, Maybe CmmLit, [CmmLit], RawCmmGroup)
    -> UniqSM (Maybe CmmLit, Maybe CmmLit, [CmmLit], RawCmmGroup)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe CmmLit
    forall a. Maybe a
    Nothing, Maybe CmmLit
    forall a. Maybe a
    Nothing, [CmmLit]
    srt_label, [])

        mk_pieces (ThunkSelector WordOff
    offset) [CmmLit]
    _no_srt
          = (Maybe CmmLit, Maybe CmmLit, [CmmLit], RawCmmGroup)
    -> UniqSM (Maybe CmmLit, Maybe CmmLit, [CmmLit], RawCmmGroup)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CmmLit -> Maybe CmmLit
    forall a. a -> Maybe a
    Just (Integer -> Width -> CmmLit
    CmmInt Integer
    0 (Platform -> Width
    halfWordWidth Platform
    platform)),
                    CmmLit -> Maybe CmmLit
    forall a. a -> Maybe a
    Just (Platform -> Integer -> CmmLit
    mkWordCLit Platform
    platform (WordOff -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral WordOff
    offset)), [], [])
             -- Layout known (one free var); we use the layout field for offset

        mk_pieces (Fun WordOff
    arity (ArgSpec WordOff
    fun_type)) [CmmLit]
    srt_label
          = do { let extra_bits :: [CmmLit]
    extra_bits = Platform -> WordOff -> WordOff -> CmmLit
    packIntsCLit Platform
    platform WordOff
    fun_type WordOff
    arity CmmLit -> [CmmLit] -> [CmmLit]
    forall a. a -> [a] -> [a]
    : [CmmLit]
    srt_label
               ; (Maybe CmmLit, Maybe CmmLit, [CmmLit], RawCmmGroup)
    -> UniqSM (Maybe CmmLit, Maybe CmmLit, [CmmLit], RawCmmGroup)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe CmmLit
    forall a. Maybe a
    Nothing, Maybe CmmLit
    forall a. Maybe a
    Nothing,  [CmmLit]
    extra_bits, []) }

        mk_pieces (Fun WordOff
    arity (ArgGen [Bool]
    arg_bits)) [CmmLit]
    srt_label
          = do { (CmmLit
    liveness_lit, RawCmmGroup
    liveness_data) <- DynFlags -> [Bool] -> UniqSM (CmmLit, RawCmmGroup)
    mkLivenessBits DynFlags
    dflags [Bool]
    arg_bits
               ; let fun_type :: WordOff
    fun_type | RawCmmGroup -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null RawCmmGroup
    liveness_data = WordOff
    aRG_GEN
                              | Bool
    otherwise          = WordOff
    aRG_GEN_BIG
                     extra_bits :: [CmmLit]
    extra_bits = [ Platform -> WordOff -> WordOff -> CmmLit
    packIntsCLit Platform
    platform WordOff
    fun_type WordOff
    arity ]
                               [CmmLit] -> [CmmLit] -> [CmmLit]
    forall a. [a] -> [a] -> [a]
    ++ (if Platform -> Bool
    inlineSRT Platform
    platform then [] else [ CmmLit
    srt_lit ])
                               [CmmLit] -> [CmmLit] -> [CmmLit]
    forall a. [a] -> [a] -> [a]
    ++ [ CmmLit
    liveness_lit, CmmLit
    slow_entry ]
               ; (Maybe CmmLit, Maybe CmmLit, [CmmLit], RawCmmGroup)
    -> UniqSM (Maybe CmmLit, Maybe CmmLit, [CmmLit], RawCmmGroup)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe CmmLit
    forall a. Maybe a
    Nothing, Maybe CmmLit
    forall a. Maybe a
    Nothing, [CmmLit]
    extra_bits, RawCmmGroup
    liveness_data) }
          where
            slow_entry :: CmmLit
    slow_entry = CLabel -> CmmLit
    CmmLabel (Platform -> CLabel -> CLabel
    toSlowEntryLbl Platform
    platform CLabel
    info_lbl)
            srt_lit :: CmmLit
    srt_lit = case [CmmLit]
    srt_label of
                        []          -> Platform -> WordOff -> CmmLit
    mkIntCLit Platform
    platform WordOff
    0
                        (CmmLit
    lit:[CmmLit]
    _rest) -> ASSERT( null _rest ) lit

        mk_pieces ClosureTypeInfo
    other [CmmLit]
    _ = String
    -> SDoc
    -> UniqSM (Maybe CmmLit, Maybe CmmLit, [CmmLit], RawCmmGroup)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "mk_pieces" (ClosureTypeInfo -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ClosureTypeInfo
    other)

    mkInfoTableContents DynFlags
    _ CmmInfoTable
    _ Maybe WordOff
    _ = String -> UniqSM (RawCmmGroup, InfoTableContents)
    forall a. String -> a
    panic String
    "mkInfoTableContents"   -- NonInfoTable dealt with earlier

    packIntsCLit :: Platform -> Int -> Int -> CmmLit
    packIntsCLit :: Platform -> WordOff -> WordOff -> CmmLit
    packIntsCLit Platform
    platform WordOff
    a WordOff
    b = Platform -> StgHalfWord -> StgHalfWord -> CmmLit
    packHalfWordsCLit Platform
    platform
                               (Platform -> Integer -> StgHalfWord
    toStgHalfWord Platform
    platform (WordOff -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral WordOff
    a))
                               (Platform -> Integer -> StgHalfWord
    toStgHalfWord Platform
    platform (WordOff -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral WordOff
    b))

    mkSRTLit :: Platform
             -> CLabel
             -> Maybe CLabel
             -> ([CmmLit],    -- srt_label, if any
                 CmmLit)      -- srt_bitmap
    mkSRTLit :: Platform -> CLabel -> Maybe CLabel -> ([CmmLit], CmmLit)
    mkSRTLit Platform
    platform CLabel
    info_lbl (Just CLabel
    lbl)
      | Platform -> Bool
    inlineSRT Platform
    platform
      = ([], CLabel -> CLabel -> WordOff -> Width -> CmmLit
    CmmLabelDiffOff CLabel
    lbl CLabel
    info_lbl WordOff
    0 (Platform -> Width
    halfWordWidth Platform
    platform))
    mkSRTLit Platform
    platform CLabel
    _ Maybe CLabel
    Nothing    = ([], Integer -> Width -> CmmLit
    CmmInt Integer
    0 (Platform -> Width
    halfWordWidth Platform
    platform))
    mkSRTLit Platform
    platform CLabel
    _ (Just CLabel
    lbl) = ([CLabel -> CmmLit
    CmmLabel CLabel
    lbl], Integer -> Width -> CmmLit
    CmmInt Integer
    1 (Platform -> Width
    halfWordWidth Platform
    platform))

    -- | Is the SRT offset field inline in the info table on this platform?
    --
    -- See the section "Referring to an SRT from the info table" in
    -- Note [SRTs] in "GHC.Cmm.Info.Build"
    inlineSRT :: Platform -> Bool
    inlineSRT :: Platform -> Bool
    inlineSRT Platform
    platform = Platform -> Arch
    platformArch Platform
    platform Arch -> Arch -> Bool
    forall a. Eq a => a -> a -> Bool
    == Arch
    ArchX86_64
      Bool -> Bool -> Bool
    && Platform -> Bool
    platformTablesNextToCode Platform
    platform

    -------------------------------------------------------------------------
    --
    --      Lay out the info table and handle relative offsets
    --
    -------------------------------------------------------------------------

    -- This function takes
    --   * the standard info table portion (StgInfoTable)
    --   * the "extra bits" (StgFunInfoExtraRev etc.)
    --   * the entry label
    --   * the code
    -- and lays them out in memory, producing a list of RawCmmDecl

    -------------------------------------------------------------------------
    --
    --      Position independent code
    --
    -------------------------------------------------------------------------
    -- In order to support position independent code, we mustn't put absolute
    -- references into read-only space. Info tables in the tablesNextToCode
    -- case must be in .text, which is read-only, so we doctor the CmmLits
    -- to use relative offsets instead.

    -- Note that this is done even when the -fPIC flag is not specified,
    -- as we want to keep binary compatibility between PIC and non-PIC.

    makeRelativeRefTo :: Platform -> CLabel -> CmmLit -> CmmLit
    makeRelativeRefTo :: Platform -> CLabel -> CmmLit -> CmmLit
    makeRelativeRefTo Platform
    platform CLabel
    info_lbl CmmLit
    lit
      = if Platform -> Bool
    platformTablesNextToCode Platform
    platform
          then case CmmLit
    lit of
             CmmLabel CLabel
    lbl        -> CLabel -> CLabel -> WordOff -> Width -> CmmLit
    CmmLabelDiffOff CLabel
    lbl CLabel
    info_lbl WordOff
    0   (Platform -> Width
    wordWidth Platform
    platform)
             CmmLabelOff CLabel
    lbl WordOff
    off -> CLabel -> CLabel -> WordOff -> Width -> CmmLit
    CmmLabelDiffOff CLabel
    lbl CLabel
    info_lbl WordOff
    off (Platform -> Width
    wordWidth Platform
    platform)
             CmmLit
    _                   -> CmmLit
    lit
          else CmmLit
    lit

    -------------------------------------------------------------------------
    --
    --              Build a liveness mask for the stack layout
    --
    -------------------------------------------------------------------------

    -- There are four kinds of things on the stack:
    --
    --      - pointer variables (bound in the environment)
    --      - non-pointer variables (bound in the environment)
    --      - free slots (recorded in the stack free list)
    --      - non-pointer data slots (recorded in the stack free list)
    --
    -- The first two are represented with a 'Just' of a 'LocalReg'.
    -- The last two with one or more 'Nothing' constructors.
    -- Each 'Nothing' represents one used word.
    --
    -- The head of the stack layout is the top of the stack and
    -- the least-significant bit.

    mkLivenessBits :: DynFlags -> Liveness -> UniqSM (CmmLit, [RawCmmDecl])
                  -- ^ Returns:
                  --   1. The bitmap (literal value or label)
                  --   2. Large bitmap CmmData if needed

    mkLivenessBits :: DynFlags -> [Bool] -> UniqSM (CmmLit, RawCmmGroup)
    mkLivenessBits DynFlags
    dflags [Bool]
    liveness
      | WordOff
    n_bits WordOff -> WordOff -> Bool
    forall a. Ord a => a -> a -> Bool
    > Platform -> WordOff
    mAX_SMALL_BITMAP_SIZE Platform
    platform -- does not fit in one word
      = do { Unique
    uniq <- UniqSM Unique
    forall (m :: * -> *). MonadUnique m => m Unique
    getUniqueM
           ; let bitmap_lbl :: CLabel
    bitmap_lbl = Unique -> CLabel
    mkBitmapLabel Unique
    uniq
           ; (CmmLit, RawCmmGroup) -> UniqSM (CmmLit, RawCmmGroup)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CLabel -> CmmLit
    CmmLabel CLabel
    bitmap_lbl,
                     [CLabel
    -> [CmmLit]
    -> GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
    forall (raw :: Bool) info stmt.
    CLabel -> [CmmLit] -> GenCmmDecl (GenCmmStatics raw) info stmt
    mkRODataLits CLabel
    bitmap_lbl [CmmLit]
    lits]) }

      | Bool
    otherwise -- Fits in one word
      = (CmmLit, RawCmmGroup) -> UniqSM (CmmLit, RawCmmGroup)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Platform -> StgWord -> CmmLit
    mkStgWordCLit Platform
    platform StgWord
    bitmap_word, [])
      where
        platform :: Platform
    platform = DynFlags -> Platform
    targetPlatform DynFlags
    dflags
        n_bits :: WordOff
    n_bits = [Bool] -> WordOff
    forall (t :: * -> *) a. Foldable t => t a -> WordOff
    length [Bool]
    liveness

        bitmap :: Bitmap
        bitmap :: Bitmap
    bitmap = Platform -> [Bool] -> Bitmap
    mkBitmap Platform
    platform [Bool]
    liveness

        small_bitmap :: StgWord
    small_bitmap = case Bitmap
    bitmap of
                         []  -> Platform -> Integer -> StgWord
    toStgWord Platform
    platform Integer
    0
                         [StgWord
    b] -> StgWord
    b
                         Bitmap
    _   -> String -> StgWord
    forall a. String -> a
    panic String
    "mkLiveness"
        bitmap_word :: StgWord
    bitmap_word = Platform -> Integer -> StgWord
    toStgWord Platform
    platform (WordOff -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral WordOff
    n_bits)
                  StgWord -> StgWord -> StgWord
    forall a. Bits a => a -> a -> a
    .|. (StgWord
    small_bitmap StgWord -> WordOff -> StgWord
    forall a. Bits a => a -> WordOff -> a
    `shiftL` PlatformConstants -> WordOff
    pc_BITMAP_BITS_SHIFT (Platform -> PlatformConstants
    platformConstants Platform
    platform))

        lits :: [CmmLit]
    lits = Platform -> Integer -> CmmLit
    mkWordCLit Platform
    platform (WordOff -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral WordOff
    n_bits)
             CmmLit -> [CmmLit] -> [CmmLit]
    forall a. a -> [a] -> [a]
    : (StgWord -> CmmLit) -> Bitmap -> [CmmLit]
    forall a b. (a -> b) -> [a] -> [b]
    map (Platform -> StgWord -> CmmLit
    mkStgWordCLit Platform
    platform) Bitmap
    bitmap
          -- The first word is the size.  The structure must match
          -- StgLargeBitmap in includes/rts/storage/InfoTable.h

    -------------------------------------------------------------------------
    --
    --      Generating a standard info table
    --
    -------------------------------------------------------------------------

    -- The standard bits of an info table.  This part of the info table
    -- corresponds to the StgInfoTable type defined in
    -- includes/rts/storage/InfoTables.h.
    --
    -- Its shape varies with ticky/profiling/tables next to code etc
    -- so we can't use constant offsets from Constants

    mkStdInfoTable
       :: DynFlags
       -> (CmmLit,CmmLit)   -- Closure type descr and closure descr  (profiling)
       -> Int               -- Closure RTS tag
       -> CmmLit            -- SRT length
       -> CmmLit            -- layout field
       -> [CmmLit]

    mkStdInfoTable :: DynFlags
    -> (CmmLit, CmmLit) -> WordOff -> CmmLit -> CmmLit -> [CmmLit]
    mkStdInfoTable DynFlags
    dflags (CmmLit
    type_descr, CmmLit
    closure_descr) WordOff
    cl_type CmmLit
    srt CmmLit
    layout_lit
     =      -- Parallel revertible-black hole field
        [CmmLit]
    prof_info
            -- Ticky info (none at present)
            -- Debug info (none at present)
     [CmmLit] -> [CmmLit] -> [CmmLit]
    forall a. [a] -> [a] -> [a]
    ++ [CmmLit
    layout_lit, CmmLit
    tag, CmmLit
    srt]

     where
        platform :: Platform
    platform = DynFlags -> Platform
    targetPlatform DynFlags
    dflags
        prof_info :: [CmmLit]
    prof_info
            | DynFlags -> Bool
    sccProfilingEnabled DynFlags
    dflags = [CmmLit
    type_descr, CmmLit
    closure_descr]
            | Bool
    otherwise = []

        tag :: CmmLit
    tag = Integer -> Width -> CmmLit
    CmmInt (WordOff -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral WordOff
    cl_type) (Platform -> Width
    halfWordWidth Platform
    platform)

    -------------------------------------------------------------------------
    --
    --      Making string literals
    --
    -------------------------------------------------------------------------

    mkProfLits :: Platform -> ProfilingInfo -> UniqSM ((CmmLit,CmmLit), [RawCmmDecl])
    mkProfLits :: Platform -> ProfilingInfo -> UniqSM ((CmmLit, CmmLit), RawCmmGroup)
    mkProfLits Platform
    platform ProfilingInfo
    NoProfilingInfo = ((CmmLit, CmmLit), RawCmmGroup)
    -> UniqSM ((CmmLit, CmmLit), RawCmmGroup)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Platform -> CmmLit
    zeroCLit Platform
    platform, Platform -> CmmLit
    zeroCLit Platform
    platform), [])
    mkProfLits Platform
    _ (ProfilingInfo ConstrDescription
    td ConstrDescription
    cd)
      = do { (CmmLit
    td_lit, GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
    td_decl) <- ConstrDescription
    -> UniqSM
         (CmmLit,
          GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph)
    forall info stmt.
    ConstrDescription
    -> UniqSM (CmmLit, GenCmmDecl RawCmmStatics info stmt)
    newStringLit ConstrDescription
    td
           ; (CmmLit
    cd_lit, GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
    cd_decl) <- ConstrDescription
    -> UniqSM
         (CmmLit,
          GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph)
    forall info stmt.
    ConstrDescription
    -> UniqSM (CmmLit, GenCmmDecl RawCmmStatics info stmt)
    newStringLit ConstrDescription
    cd
           ; ((CmmLit, CmmLit), RawCmmGroup)
    -> UniqSM ((CmmLit, CmmLit), RawCmmGroup)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((CmmLit
    td_lit,CmmLit
    cd_lit), [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
    td_decl,GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
    cd_decl]) }

    newStringLit :: ByteString -> UniqSM (CmmLit, GenCmmDecl RawCmmStatics info stmt)
    newStringLit :: forall info stmt.
    ConstrDescription
    -> UniqSM (CmmLit, GenCmmDecl RawCmmStatics info stmt)
    newStringLit ConstrDescription
    bytes
      = do { Unique
    uniq <- UniqSM Unique
    forall (m :: * -> *). MonadUnique m => m Unique
    getUniqueM
           ; (CmmLit, GenCmmDecl RawCmmStatics info stmt)
    -> UniqSM (CmmLit, GenCmmDecl RawCmmStatics info stmt)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CLabel
    -> ConstrDescription
    -> (CmmLit, GenCmmDecl RawCmmStatics info stmt)
    forall (raw :: Bool) info stmt.
    CLabel
    -> ConstrDescription
    -> (CmmLit, GenCmmDecl (GenCmmStatics raw) info stmt)
    mkByteStringCLit (Unique -> CLabel
    mkStringLitLabel Unique
    uniq) ConstrDescription
    bytes) }

    -- Misc utils

    -- | Value of the srt field of an info table when using an StgLargeSRT
    srtEscape :: Platform -> StgHalfWord
    srtEscape :: Platform -> StgHalfWord
    srtEscape Platform
    platform = Platform -> Integer -> StgHalfWord
    toStgHalfWord Platform
    platform (-Integer
    1)

    -------------------------------------------------------------------------
    --
    --      Accessing fields of an info table
    --
    -------------------------------------------------------------------------

    data PtrOpts = PtrOpts
       { PtrOpts -> Profile
    po_profile     :: !Profile -- ^ Platform profile
       , PtrOpts -> Bool
    po_align_check :: !Bool    -- ^ Insert alignment check (cf @-falignment-sanitisation@)
       }

    -- | Wrap a 'CmmExpr' in an alignment check when @-falignment-sanitisation@ is
    -- enabled.
    wordAligned :: PtrOpts -> CmmExpr -> CmmExpr
    wordAligned :: PtrOpts -> CmmExpr -> CmmExpr
    wordAligned PtrOpts
    opts CmmExpr
    e
      | PtrOpts -> Bool
    po_align_check PtrOpts
    opts
      = MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (WordOff -> Width -> MachOp
    MO_AlignmentCheck (Platform -> WordOff
    platformWordSizeInBytes Platform
    platform) (Platform -> Width
    wordWidth Platform
    platform)) [CmmExpr
    e]
      | Bool
    otherwise
      = CmmExpr
    e
      where platform :: Platform
    platform = Profile -> Platform
    profilePlatform (PtrOpts -> Profile
    po_profile PtrOpts
    opts)

    -- | Takes a closure pointer and returns the info table pointer
    closureInfoPtr :: PtrOpts -> CmmExpr -> CmmExpr
    closureInfoPtr :: PtrOpts -> CmmExpr -> CmmExpr
    closureInfoPtr PtrOpts
    opts CmmExpr
    e =
        CmmExpr -> CmmType -> CmmExpr
    CmmLoad (PtrOpts -> CmmExpr -> CmmExpr
    wordAligned PtrOpts
    opts CmmExpr
    e) (Platform -> CmmType
    bWord (Profile -> Platform
    profilePlatform (PtrOpts -> Profile
    po_profile PtrOpts
    opts)))

    -- | Takes an info pointer (the first word of a closure) and returns its entry
    -- code
    entryCode :: Platform -> CmmExpr -> CmmExpr
    entryCode :: Platform -> CmmExpr -> CmmExpr
    entryCode Platform
    platform CmmExpr
    e =
     if Platform -> Bool
    platformTablesNextToCode Platform
    platform
          then CmmExpr
    e
          else CmmExpr -> CmmType -> CmmExpr
    CmmLoad CmmExpr
    e (Platform -> CmmType
    bWord Platform
    platform)

    -- | Takes a closure pointer, and return the *zero-indexed*
    -- constructor tag obtained from the info table
    -- This lives in the SRT field of the info table
    -- (constructors don't need SRTs).
    getConstrTag :: PtrOpts -> CmmExpr -> CmmExpr
    getConstrTag :: PtrOpts -> CmmExpr -> CmmExpr
    getConstrTag PtrOpts
    opts CmmExpr
    closure_ptr
      = MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Width -> Width -> MachOp
    MO_UU_Conv (Platform -> Width
    halfWordWidth Platform
    platform) (Platform -> Width
    wordWidth Platform
    platform)) [Profile -> CmmExpr -> CmmExpr
    infoTableConstrTag Profile
    profile CmmExpr
    info_table]
      where
        info_table :: CmmExpr
    info_table = Profile -> CmmExpr -> CmmExpr
    infoTable Profile
    profile (PtrOpts -> CmmExpr -> CmmExpr
    closureInfoPtr PtrOpts
    opts CmmExpr
    closure_ptr)
        platform :: Platform
    platform   = Profile -> Platform
    profilePlatform Profile
    profile
        profile :: Profile
    profile    = PtrOpts -> Profile
    po_profile PtrOpts
    opts

    -- | Takes a closure pointer, and return the closure type
    -- obtained from the info table
    cmmGetClosureType :: PtrOpts -> CmmExpr -> CmmExpr
    cmmGetClosureType :: PtrOpts -> CmmExpr -> CmmExpr
    cmmGetClosureType PtrOpts
    opts CmmExpr
    closure_ptr
      = MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Width -> Width -> MachOp
    MO_UU_Conv (Platform -> Width
    halfWordWidth Platform
    platform) (Platform -> Width
    wordWidth Platform
    platform)) [Profile -> CmmExpr -> CmmExpr
    infoTableClosureType Profile
    profile CmmExpr
    info_table]
      where
        info_table :: CmmExpr
    info_table = Profile -> CmmExpr -> CmmExpr
    infoTable Profile
    profile (PtrOpts -> CmmExpr -> CmmExpr
    closureInfoPtr PtrOpts
    opts CmmExpr
    closure_ptr)
        platform :: Platform
    platform   = Profile -> Platform
    profilePlatform Profile
    profile
        profile :: Profile
    profile    = PtrOpts -> Profile
    po_profile PtrOpts
    opts

    -- | Takes an info pointer (the first word of a closure)
    -- and returns a pointer to the first word of the standard-form
    -- info table, excluding the entry-code word (if present)
    infoTable :: Profile -> CmmExpr -> CmmExpr
    infoTable :: Profile -> CmmExpr -> CmmExpr
    infoTable Profile
    profile CmmExpr
    info_ptr
      | Platform -> Bool
    platformTablesNextToCode Platform
    platform = Platform -> CmmExpr -> WordOff -> CmmExpr
    cmmOffsetB Platform
    platform CmmExpr
    info_ptr (- Profile -> WordOff
    stdInfoTableSizeB Profile
    profile)
      | Bool
    otherwise                         = Platform -> CmmExpr -> WordOff -> CmmExpr
    cmmOffsetW Platform
    platform CmmExpr
    info_ptr WordOff
    1 -- Past the entry code pointer
      where platform :: Platform
    platform = Profile -> Platform
    profilePlatform Profile
    profile

    -- | Takes an info table pointer (from infoTable) and returns the constr tag
    -- field of the info table (same as the srt_bitmap field)
    infoTableConstrTag :: Profile -> CmmExpr -> CmmExpr
    infoTableConstrTag :: Profile -> CmmExpr -> CmmExpr
    infoTableConstrTag = Profile -> CmmExpr -> CmmExpr
    infoTableSrtBitmap

    -- | Takes an info table pointer (from infoTable) and returns the srt_bitmap
    -- field of the info table
    infoTableSrtBitmap :: Profile -> CmmExpr -> CmmExpr
    infoTableSrtBitmap :: Profile -> CmmExpr -> CmmExpr
    infoTableSrtBitmap Profile
    profile CmmExpr
    info_tbl
      = CmmExpr -> CmmType -> CmmExpr
    CmmLoad (Platform -> CmmExpr -> WordOff -> CmmExpr
    cmmOffsetB Platform
    platform CmmExpr
    info_tbl (Profile -> WordOff
    stdSrtBitmapOffset Profile
    profile)) (Platform -> CmmType
    bHalfWord Platform
    platform)
        where platform :: Platform
    platform = Profile -> Platform
    profilePlatform Profile
    profile

    -- | Takes an info table pointer (from infoTable) and returns the closure type
    -- field of the info table.
    infoTableClosureType :: Profile -> CmmExpr -> CmmExpr
    infoTableClosureType :: Profile -> CmmExpr -> CmmExpr
    infoTableClosureType Profile
    profile CmmExpr
    info_tbl
      = CmmExpr -> CmmType -> CmmExpr
    CmmLoad (Platform -> CmmExpr -> WordOff -> CmmExpr
    cmmOffsetB Platform
    platform CmmExpr
    info_tbl (Profile -> WordOff
    stdClosureTypeOffset Profile
    profile)) (Platform -> CmmType
    bHalfWord Platform
    platform)
        where platform :: Platform
    platform = Profile -> Platform
    profilePlatform Profile
    profile

    infoTablePtrs :: Profile -> CmmExpr -> CmmExpr
    infoTablePtrs :: Profile -> CmmExpr -> CmmExpr
    infoTablePtrs Profile
    profile CmmExpr
    info_tbl
      = CmmExpr -> CmmType -> CmmExpr
    CmmLoad (Platform -> CmmExpr -> WordOff -> CmmExpr
    cmmOffsetB Platform
    platform CmmExpr
    info_tbl (Profile -> WordOff
    stdPtrsOffset Profile
    profile)) (Platform -> CmmType
    bHalfWord Platform
    platform)
        where platform :: Platform
    platform = Profile -> Platform
    profilePlatform Profile
    profile

    infoTableNonPtrs :: Profile -> CmmExpr -> CmmExpr
    infoTableNonPtrs :: Profile -> CmmExpr -> CmmExpr
    infoTableNonPtrs Profile
    profile CmmExpr
    info_tbl
      = CmmExpr -> CmmType -> CmmExpr
    CmmLoad (Platform -> CmmExpr -> WordOff -> CmmExpr
    cmmOffsetB Platform
    platform CmmExpr
    info_tbl (Profile -> WordOff
    stdNonPtrsOffset Profile
    profile)) (Platform -> CmmType
    bHalfWord Platform
    platform)
        where platform :: Platform
    platform = Profile -> Platform
    profilePlatform Profile
    profile

    -- | Takes the info pointer of a function, and returns a pointer to the first
    -- word of the StgFunInfoExtra struct in the info table.
    funInfoTable :: Profile -> CmmExpr -> CmmExpr
    funInfoTable :: Profile -> CmmExpr -> CmmExpr
    funInfoTable Profile
    profile CmmExpr
    info_ptr
      | Platform -> Bool
    platformTablesNextToCode Platform
    platform
      = Platform -> CmmExpr -> WordOff -> CmmExpr
    cmmOffsetB Platform
    platform CmmExpr
    info_ptr (- Profile -> WordOff
    stdInfoTableSizeB Profile
    profile WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    - PlatformConstants -> WordOff
    pc_SIZEOF_StgFunInfoExtraRev (Platform -> PlatformConstants
    platformConstants Platform
    platform))
      | Bool
    otherwise
      = Platform -> CmmExpr -> WordOff -> CmmExpr
    cmmOffsetW Platform
    platform CmmExpr
    info_ptr (WordOff
    1 WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    + Profile -> WordOff
    stdInfoTableSizeW Profile
    profile)
                                      -- Past the entry code pointer
      where
        platform :: Platform
    platform = Profile -> Platform
    profilePlatform Profile
    profile

    -- | Takes the info pointer of a function, returns the function's arity
    funInfoArity :: Profile -> CmmExpr -> CmmExpr
    funInfoArity :: Profile -> CmmExpr -> CmmExpr
    funInfoArity Profile
    profile CmmExpr
    iptr
      = Platform -> CmmExpr -> CmmExpr
    cmmToWord Platform
    platform (Platform -> CmmType -> CmmExpr -> WordOff -> CmmExpr
    cmmLoadIndex Platform
    platform CmmType
    rep CmmExpr
    fun_info (WordOff
    offset WordOff -> WordOff -> WordOff
    forall a. Integral a => a -> a -> a
    `div` WordOff
    rep_bytes))
      where
       platform :: Platform
    platform = Profile -> Platform
    profilePlatform Profile
    profile
       fun_info :: CmmExpr
    fun_info = Profile -> CmmExpr -> CmmExpr
    funInfoTable Profile
    profile CmmExpr
    iptr
       rep :: CmmType
    rep = Width -> CmmType
    cmmBits (WordOff -> Width
    widthFromBytes WordOff
    rep_bytes)
       tablesNextToCode :: Bool
    tablesNextToCode = Platform -> Bool
    platformTablesNextToCode Platform
    platform

       (WordOff
    rep_bytes, WordOff
    offset)
        | Bool
    tablesNextToCode = ( PlatformConstants -> WordOff
    pc_REP_StgFunInfoExtraRev_arity PlatformConstants
    pc
                             , PlatformConstants -> WordOff
    pc_OFFSET_StgFunInfoExtraRev_arity PlatformConstants
    pc )
        | Bool
    otherwise        = ( PlatformConstants -> WordOff
    pc_REP_StgFunInfoExtraFwd_arity PlatformConstants
    pc
                             , PlatformConstants -> WordOff
    pc_OFFSET_StgFunInfoExtraFwd_arity PlatformConstants
    pc )

       pc :: PlatformConstants
    pc = Platform -> PlatformConstants
    platformConstants Platform
    platform

    -----------------------------------------------------------------------------
    --
    --      Info table sizes & offsets
    --
    -----------------------------------------------------------------------------

    stdInfoTableSizeW :: Profile -> WordOff
    -- The size of a standard info table varies with profiling/ticky etc,
    -- so we can't get it from Constants
    -- It must vary in sync with mkStdInfoTable
    stdInfoTableSizeW :: Profile -> WordOff
    stdInfoTableSizeW Profile
    profile
      = WordOff
    fixedInfoTableSizeW
      WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    + if Profile -> Bool
    profileIsProfiling Profile
    profile
           then WordOff
    profInfoTableSizeW
           else WordOff
    0

    fixedInfoTableSizeW :: WordOff
    fixedInfoTableSizeW :: WordOff
    fixedInfoTableSizeW = WordOff
    2 -- layout, type

    profInfoTableSizeW :: WordOff
    profInfoTableSizeW :: WordOff
    profInfoTableSizeW = WordOff
    2

    maxStdInfoTableSizeW :: WordOff
    maxStdInfoTableSizeW :: WordOff
    maxStdInfoTableSizeW =
      WordOff
    1 {- entry, when !tablesNextToCode -}
      WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    + WordOff
    fixedInfoTableSizeW
      WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    + WordOff
    profInfoTableSizeW

    maxRetInfoTableSizeW :: WordOff
    maxRetInfoTableSizeW :: WordOff
    maxRetInfoTableSizeW =
      WordOff
    maxStdInfoTableSizeW
      WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    + WordOff
    1 {- srt label -}

    stdInfoTableSizeB  :: Profile -> ByteOff
    stdInfoTableSizeB :: Profile -> WordOff
    stdInfoTableSizeB Profile
    profile = Profile -> WordOff
    stdInfoTableSizeW Profile
    profile WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    * Profile -> WordOff
    profileWordSizeInBytes Profile
    profile

    -- | Byte offset of the SRT bitmap half-word which is in the *higher-addressed*
    -- part of the type_lit
    stdSrtBitmapOffset :: Profile -> ByteOff
    stdSrtBitmapOffset :: Profile -> WordOff
    stdSrtBitmapOffset Profile
    profile = Profile -> WordOff
    stdInfoTableSizeB Profile
    profile WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    - Platform -> WordOff
    halfWordSize (Profile -> Platform
    profilePlatform Profile
    profile)

    -- | Byte offset of the closure type half-word
    stdClosureTypeOffset :: Profile -> ByteOff
    stdClosureTypeOffset :: Profile -> WordOff
    stdClosureTypeOffset Profile
    profile = Profile -> WordOff
    stdInfoTableSizeB Profile
    profile WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    - Profile -> WordOff
    profileWordSizeInBytes Profile
    profile

    stdPtrsOffset :: Profile -> ByteOff
    stdPtrsOffset :: Profile -> WordOff
    stdPtrsOffset Profile
    profile = Profile -> WordOff
    stdInfoTableSizeB Profile
    profile WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    - WordOff
    2 WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    * Profile -> WordOff
    profileWordSizeInBytes Profile
    profile

    stdNonPtrsOffset :: Profile -> ByteOff
    stdNonPtrsOffset :: Profile -> WordOff
    stdNonPtrsOffset Profile
    profile = Profile -> WordOff
    stdInfoTableSizeB Profile
    profile WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    - WordOff
    2 WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    * Profile -> WordOff
    profileWordSizeInBytes Profile
    profile
                                                         WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    + Platform -> WordOff
    halfWordSize (Profile -> Platform
    profilePlatform Profile
    profile)

    conInfoTableSizeB :: Profile -> Int
    conInfoTableSizeB :: Profile -> WordOff
    conInfoTableSizeB Profile
    profile = Profile -> WordOff
    stdInfoTableSizeB Profile
    profile WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    + Profile -> WordOff
    profileWordSizeInBytes Profile
    profile