never executed always true always false
    1 
    2 module GHC.Cmm.Info (
    3   mkEmptyContInfoTable,
    4   cmmToRawCmm,
    5   srtEscape,
    6 
    7   -- info table accessors
    8   PtrOpts (..),
    9   closureInfoPtr,
   10   entryCode,
   11   getConstrTag,
   12   cmmGetClosureType,
   13   infoTable,
   14   infoTableConstrTag,
   15   infoTableSrtBitmap,
   16   infoTableClosureType,
   17   infoTablePtrs,
   18   infoTableNonPtrs,
   19   funInfoTable,
   20   funInfoArity,
   21 
   22   -- info table sizes and offsets
   23   stdInfoTableSizeW,
   24   fixedInfoTableSizeW,
   25   profInfoTableSizeW,
   26   maxStdInfoTableSizeW,
   27   maxRetInfoTableSizeW,
   28   stdInfoTableSizeB,
   29   conInfoTableSizeB,
   30   stdSrtBitmapOffset,
   31   stdClosureTypeOffset,
   32   stdPtrsOffset, stdNonPtrsOffset,
   33 ) where
   34 
   35 import GHC.Prelude
   36 
   37 import GHC.Cmm
   38 import GHC.Cmm.Utils
   39 import GHC.Cmm.CLabel
   40 import GHC.Runtime.Heap.Layout
   41 import GHC.Data.Bitmap
   42 import GHC.Data.Stream (Stream)
   43 import qualified GHC.Data.Stream as Stream
   44 import GHC.Cmm.Dataflow.Collections
   45 
   46 import GHC.Platform
   47 import GHC.Platform.Profile
   48 import GHC.Data.Maybe
   49 import GHC.Utils.Error (withTimingSilent)
   50 import GHC.Utils.Panic
   51 import GHC.Utils.Panic.Plain
   52 import GHC.Types.Unique.Supply
   53 import GHC.Utils.Logger
   54 import GHC.Utils.Monad
   55 import GHC.Utils.Misc
   56 import GHC.Utils.Outputable
   57 
   58 import Data.ByteString (ByteString)
   59 
   60 -- When we split at proc points, we need an empty info table.
   61 mkEmptyContInfoTable :: CLabel -> CmmInfoTable
   62 mkEmptyContInfoTable info_lbl
   63   = CmmInfoTable { cit_lbl  = info_lbl
   64                  , cit_rep  = mkStackRep []
   65                  , cit_prof = NoProfilingInfo
   66                  , cit_srt  = Nothing
   67                  , cit_clo  = Nothing }
   68 
   69 cmmToRawCmm :: Logger -> Profile -> Stream IO CmmGroupSRTs a
   70             -> IO (Stream IO RawCmmGroup a)
   71 cmmToRawCmm logger profile cmms
   72   = do {
   73        ; let do_one :: [CmmDeclSRTs] -> IO [RawCmmDecl]
   74              do_one cmm = do
   75                uniqs <- mkSplitUniqSupply 'i'
   76                -- NB. strictness fixes a space leak.  DO NOT REMOVE.
   77                withTimingSilent logger (text "Cmm -> Raw Cmm") (\x -> seqList x ())
   78                   -- TODO: It might be better to make `mkInfoTable` run in
   79                   -- IO as well so we don't have to pass around
   80                   -- a UniqSupply (see #16843)
   81                  (return $ initUs_ uniqs $ concatMapM (mkInfoTable profile) cmm)
   82        ; return (Stream.mapM do_one cmms)
   83        }
   84 
   85 
   86 -- Make a concrete info table, represented as a list of CmmStatic
   87 -- (it can't be simply a list of Word, because the SRT field is
   88 -- represented by a label+offset expression).
   89 --
   90 -- With tablesNextToCode, the layout is
   91 --      <reversed variable part>
   92 --      <normal forward StgInfoTable, but without
   93 --              an entry point at the front>
   94 --      <code>
   95 --
   96 -- Without tablesNextToCode, the layout of an info table is
   97 --      <entry label>
   98 --      <normal forward rest of StgInfoTable>
   99 --      <forward variable part>
  100 --
  101 --      See rts/include/rts/storage/InfoTables.h
  102 --
  103 -- For return-points these are as follows
  104 --
  105 -- Tables next to code:
  106 --
  107 --                      <srt slot>
  108 --                      <standard info table>
  109 --      ret-addr -->    <entry code (if any)>
  110 --
  111 -- Not tables-next-to-code:
  112 --
  113 --      ret-addr -->    <ptr to entry code>
  114 --                      <standard info table>
  115 --                      <srt slot>
  116 --
  117 --  * The SRT slot is only there if there is SRT info to record
  118 
  119 mkInfoTable :: Profile -> CmmDeclSRTs -> UniqSM [RawCmmDecl]
  120 mkInfoTable _ (CmmData sec dat) = return [CmmData sec dat]
  121 
  122 mkInfoTable profile proc@(CmmProc infos entry_lbl live blocks)
  123   --
  124   -- in the non-tables-next-to-code case, procs can have at most a
  125   -- single info table associated with the entry label of the proc.
  126   --
  127   | not (platformTablesNextToCode platform)
  128   = case topInfoTable proc of   --  must be at most one
  129       -- no info table
  130       Nothing ->
  131          return [CmmProc mapEmpty entry_lbl live blocks]
  132 
  133       Just info@CmmInfoTable { cit_lbl = info_lbl } -> do
  134         (top_decls, (std_info, extra_bits)) <-
  135              mkInfoTableContents profile info Nothing
  136         let
  137           rel_std_info   = map (makeRelativeRefTo platform info_lbl) std_info
  138           rel_extra_bits = map (makeRelativeRefTo platform info_lbl) extra_bits
  139         --
  140         -- Separately emit info table (with the function entry
  141         -- point as first entry) and the entry code
  142         --
  143         return (top_decls ++
  144                 [CmmProc mapEmpty entry_lbl live blocks,
  145                  mkRODataLits info_lbl
  146                     (CmmLabel entry_lbl : rel_std_info ++ rel_extra_bits)])
  147 
  148   --
  149   -- With tables-next-to-code, we can have many info tables,
  150   -- associated with some of the BlockIds of the proc.  For each info
  151   -- table we need to turn it into CmmStatics, and collect any new
  152   -- CmmDecls that arise from doing so.
  153   --
  154   | otherwise
  155   = do
  156     (top_declss, raw_infos) <-
  157        unzip `fmap` mapM do_one_info (mapToList (info_tbls infos))
  158     return (concat top_declss ++
  159             [CmmProc (mapFromList raw_infos) entry_lbl live blocks])
  160 
  161   where
  162    platform = profilePlatform profile
  163    do_one_info (lbl,itbl) = do
  164      (top_decls, (std_info, extra_bits)) <-
  165          mkInfoTableContents profile itbl Nothing
  166      let
  167         info_lbl = cit_lbl itbl
  168         rel_std_info   = map (makeRelativeRefTo platform info_lbl) std_info
  169         rel_extra_bits = map (makeRelativeRefTo platform info_lbl) extra_bits
  170      --
  171      return (top_decls, (lbl, CmmStaticsRaw info_lbl $ map CmmStaticLit $
  172                               reverse rel_extra_bits ++ rel_std_info))
  173 
  174 -----------------------------------------------------
  175 type InfoTableContents = ( [CmmLit]          -- The standard part
  176                          , [CmmLit] )        -- The "extra bits"
  177 -- These Lits have *not* had mkRelativeTo applied to them
  178 
  179 mkInfoTableContents :: Profile
  180                     -> CmmInfoTable
  181                     -> Maybe Int               -- Override default RTS type tag?
  182                     -> UniqSM ([RawCmmDecl],             -- Auxiliary top decls
  183                                InfoTableContents)       -- Info tbl + extra bits
  184 
  185 mkInfoTableContents profile
  186                     info@(CmmInfoTable { cit_lbl  = info_lbl
  187                                        , cit_rep  = smrep
  188                                        , cit_prof = prof
  189                                        , cit_srt = srt })
  190                     mb_rts_tag
  191   | RTSRep rts_tag rep <- smrep
  192   = mkInfoTableContents profile info{cit_rep = rep} (Just rts_tag)
  193     -- Completely override the rts_tag that mkInfoTableContents would
  194     -- otherwise compute, with the rts_tag stored in the RTSRep
  195     -- (which in turn came from a handwritten .cmm file)
  196 
  197   | StackRep frame <- smrep
  198   = do { (prof_lits, prof_data) <- mkProfLits platform prof
  199        ; let (srt_label, srt_bitmap) = mkSRTLit platform info_lbl srt
  200        ; (liveness_lit, liveness_data) <- mkLivenessBits platform frame
  201        ; let
  202              std_info = mkStdInfoTable profile prof_lits rts_tag srt_bitmap liveness_lit
  203              rts_tag | Just tag <- mb_rts_tag = tag
  204                      | null liveness_data     = rET_SMALL -- Fits in extra_bits
  205                      | otherwise              = rET_BIG   -- Does not; extra_bits is
  206                                                           -- a label
  207        ; return (prof_data ++ liveness_data, (std_info, srt_label)) }
  208 
  209   | HeapRep _ ptrs nonptrs closure_type <- smrep
  210   = do { let layout  = packIntsCLit platform ptrs nonptrs
  211        ; (prof_lits, prof_data) <- mkProfLits platform prof
  212        ; let (srt_label, srt_bitmap) = mkSRTLit platform info_lbl srt
  213        ; (mb_srt_field, mb_layout, extra_bits, ct_data)
  214                                 <- mk_pieces closure_type srt_label
  215        ; let std_info = mkStdInfoTable profile prof_lits
  216                                        (mb_rts_tag   `orElse` rtsClosureType smrep)
  217                                        (mb_srt_field `orElse` srt_bitmap)
  218                                        (mb_layout    `orElse` layout)
  219        ; return (prof_data ++ ct_data, (std_info, extra_bits)) }
  220   where
  221     platform = profilePlatform profile
  222     mk_pieces :: ClosureTypeInfo -> [CmmLit]
  223               -> UniqSM ( Maybe CmmLit  -- Override the SRT field with this
  224                         , Maybe CmmLit  -- Override the layout field with this
  225                         , [CmmLit]           -- "Extra bits" for info table
  226                         , [RawCmmDecl])      -- Auxiliary data decls
  227     mk_pieces (Constr con_tag con_descr) _no_srt    -- A data constructor
  228       = do { (descr_lit, decl) <- newStringLit con_descr
  229            ; return ( Just (CmmInt (fromIntegral con_tag)
  230                                    (halfWordWidth platform))
  231                     , Nothing, [descr_lit], [decl]) }
  232 
  233     mk_pieces Thunk srt_label
  234       = return (Nothing, Nothing, srt_label, [])
  235 
  236     mk_pieces (ThunkSelector offset) _no_srt
  237       = return (Just (CmmInt 0 (halfWordWidth platform)),
  238                 Just (mkWordCLit platform (fromIntegral offset)), [], [])
  239          -- Layout known (one free var); we use the layout field for offset
  240 
  241     mk_pieces (Fun arity (ArgSpec fun_type)) srt_label
  242       = do { let extra_bits = packIntsCLit platform fun_type arity : srt_label
  243            ; return (Nothing, Nothing,  extra_bits, []) }
  244 
  245     mk_pieces (Fun arity (ArgGen arg_bits)) srt_label
  246       = do { (liveness_lit, liveness_data) <- mkLivenessBits platform arg_bits
  247            ; let fun_type | null liveness_data = aRG_GEN
  248                           | otherwise          = aRG_GEN_BIG
  249                  extra_bits = [ packIntsCLit platform fun_type arity ]
  250                            ++ (if inlineSRT platform then [] else [ srt_lit ])
  251                            ++ [ liveness_lit, slow_entry ]
  252            ; return (Nothing, Nothing, extra_bits, liveness_data) }
  253       where
  254         slow_entry = CmmLabel (toSlowEntryLbl platform info_lbl)
  255         srt_lit = case srt_label of
  256                     []          -> mkIntCLit platform 0
  257                     (lit:_rest) -> assert (null _rest) lit
  258 
  259     mk_pieces other _ = pprPanic "mk_pieces" (ppr other)
  260 
  261 mkInfoTableContents _ _ _ = panic "mkInfoTableContents"   -- NonInfoTable dealt with earlier
  262 
  263 packIntsCLit :: Platform -> Int -> Int -> CmmLit
  264 packIntsCLit platform a b = packHalfWordsCLit platform
  265                            (toStgHalfWord platform (fromIntegral a))
  266                            (toStgHalfWord platform (fromIntegral b))
  267 
  268 
  269 mkSRTLit :: Platform
  270          -> CLabel
  271          -> Maybe CLabel
  272          -> ([CmmLit],    -- srt_label, if any
  273              CmmLit)      -- srt_bitmap
  274 mkSRTLit platform info_lbl (Just lbl)
  275   | inlineSRT platform
  276   = ([], CmmLabelDiffOff lbl info_lbl 0 (halfWordWidth platform))
  277 mkSRTLit platform _ Nothing    = ([], CmmInt 0 (halfWordWidth platform))
  278 mkSRTLit platform _ (Just lbl) = ([CmmLabel lbl], CmmInt 1 (halfWordWidth platform))
  279 
  280 
  281 -- | Is the SRT offset field inline in the info table on this platform?
  282 --
  283 -- See the section "Referring to an SRT from the info table" in
  284 -- Note [SRTs] in "GHC.Cmm.Info.Build"
  285 inlineSRT :: Platform -> Bool
  286 inlineSRT platform = platformArch platform == ArchX86_64
  287   && platformTablesNextToCode platform
  288 
  289 -------------------------------------------------------------------------
  290 --
  291 --      Lay out the info table and handle relative offsets
  292 --
  293 -------------------------------------------------------------------------
  294 
  295 -- This function takes
  296 --   * the standard info table portion (StgInfoTable)
  297 --   * the "extra bits" (StgFunInfoExtraRev etc.)
  298 --   * the entry label
  299 --   * the code
  300 -- and lays them out in memory, producing a list of RawCmmDecl
  301 
  302 -------------------------------------------------------------------------
  303 --
  304 --      Position independent code
  305 --
  306 -------------------------------------------------------------------------
  307 -- In order to support position independent code, we mustn't put absolute
  308 -- references into read-only space. Info tables in the tablesNextToCode
  309 -- case must be in .text, which is read-only, so we doctor the CmmLits
  310 -- to use relative offsets instead.
  311 
  312 -- Note that this is done even when the -fPIC flag is not specified,
  313 -- as we want to keep binary compatibility between PIC and non-PIC.
  314 
  315 makeRelativeRefTo :: Platform -> CLabel -> CmmLit -> CmmLit
  316 makeRelativeRefTo platform info_lbl lit
  317   = if platformTablesNextToCode platform
  318       then case lit of
  319          CmmLabel lbl        -> CmmLabelDiffOff lbl info_lbl 0   (wordWidth platform)
  320          CmmLabelOff lbl off -> CmmLabelDiffOff lbl info_lbl off (wordWidth platform)
  321          _                   -> lit
  322       else lit
  323 
  324 -------------------------------------------------------------------------
  325 --
  326 --              Build a liveness mask for the stack layout
  327 --
  328 -------------------------------------------------------------------------
  329 
  330 -- There are four kinds of things on the stack:
  331 --
  332 --      - pointer variables (bound in the environment)
  333 --      - non-pointer variables (bound in the environment)
  334 --      - free slots (recorded in the stack free list)
  335 --      - non-pointer data slots (recorded in the stack free list)
  336 --
  337 -- The first two are represented with a 'Just' of a 'LocalReg'.
  338 -- The last two with one or more 'Nothing' constructors.
  339 -- Each 'Nothing' represents one used word.
  340 --
  341 -- The head of the stack layout is the top of the stack and
  342 -- the least-significant bit.
  343 
  344 mkLivenessBits :: Platform -> Liveness -> UniqSM (CmmLit, [RawCmmDecl])
  345               -- ^ Returns:
  346               --   1. The bitmap (literal value or label)
  347               --   2. Large bitmap CmmData if needed
  348 
  349 mkLivenessBits platform liveness
  350   | n_bits > mAX_SMALL_BITMAP_SIZE platform -- does not fit in one word
  351   = do { uniq <- getUniqueM
  352        ; let bitmap_lbl = mkBitmapLabel uniq
  353        ; return (CmmLabel bitmap_lbl,
  354                  [mkRODataLits bitmap_lbl lits]) }
  355 
  356   | otherwise -- Fits in one word
  357   = return (mkStgWordCLit platform bitmap_word, [])
  358   where
  359     n_bits = length liveness
  360 
  361     bitmap :: Bitmap
  362     bitmap = mkBitmap platform liveness
  363 
  364     small_bitmap = case bitmap of
  365                      []  -> toStgWord platform 0
  366                      [b] -> b
  367                      _   -> panic "mkLiveness"
  368     bitmap_word = toStgWord platform (fromIntegral n_bits)
  369               .|. (small_bitmap `shiftL` pc_BITMAP_BITS_SHIFT (platformConstants platform))
  370 
  371     lits = mkWordCLit platform (fromIntegral n_bits)
  372          : map (mkStgWordCLit platform) bitmap
  373       -- The first word is the size.  The structure must match
  374       -- StgLargeBitmap in rts/include/rts/storage/InfoTable.h
  375 
  376 -------------------------------------------------------------------------
  377 --
  378 --      Generating a standard info table
  379 --
  380 -------------------------------------------------------------------------
  381 
  382 -- The standard bits of an info table.  This part of the info table
  383 -- corresponds to the StgInfoTable type defined in
  384 -- rts/include/rts/storage/InfoTables.h.
  385 --
  386 -- Its shape varies with ticky/profiling/tables next to code etc
  387 -- so we can't use constant offsets from Constants
  388 
  389 mkStdInfoTable
  390    :: Profile
  391    -> (CmmLit,CmmLit)   -- Closure type descr and closure descr  (profiling)
  392    -> Int               -- Closure RTS tag
  393    -> CmmLit            -- SRT length
  394    -> CmmLit            -- layout field
  395    -> [CmmLit]
  396 
  397 mkStdInfoTable profile (type_descr, closure_descr) cl_type srt layout_lit
  398  =      -- Parallel revertible-black hole field
  399     prof_info
  400         -- Ticky info (none at present)
  401         -- Debug info (none at present)
  402  ++ [layout_lit, tag, srt]
  403 
  404  where
  405     platform = profilePlatform profile
  406     prof_info
  407         | profileIsProfiling profile = [type_descr, closure_descr]
  408         | otherwise = []
  409 
  410     tag = CmmInt (fromIntegral cl_type) (halfWordWidth platform)
  411 
  412 -------------------------------------------------------------------------
  413 --
  414 --      Making string literals
  415 --
  416 -------------------------------------------------------------------------
  417 
  418 mkProfLits :: Platform -> ProfilingInfo -> UniqSM ((CmmLit,CmmLit), [RawCmmDecl])
  419 mkProfLits platform NoProfilingInfo = return ((zeroCLit platform, zeroCLit platform), [])
  420 mkProfLits _ (ProfilingInfo td cd)
  421   = do { (td_lit, td_decl) <- newStringLit td
  422        ; (cd_lit, cd_decl) <- newStringLit cd
  423        ; return ((td_lit,cd_lit), [td_decl,cd_decl]) }
  424 
  425 newStringLit :: ByteString -> UniqSM (CmmLit, GenCmmDecl RawCmmStatics info stmt)
  426 newStringLit bytes
  427   = do { uniq <- getUniqueM
  428        ; return (mkByteStringCLit (mkStringLitLabel uniq) bytes) }
  429 
  430 
  431 -- Misc utils
  432 
  433 -- | Value of the srt field of an info table when using an StgLargeSRT
  434 srtEscape :: Platform -> StgHalfWord
  435 srtEscape platform = toStgHalfWord platform (-1)
  436 
  437 -------------------------------------------------------------------------
  438 --
  439 --      Accessing fields of an info table
  440 --
  441 -------------------------------------------------------------------------
  442 
  443 data PtrOpts = PtrOpts
  444    { po_profile     :: !Profile -- ^ Platform profile
  445    , po_align_check :: !Bool    -- ^ Insert alignment check (cf @-falignment-sanitisation@)
  446    }
  447 
  448 -- | Wrap a 'CmmExpr' in an alignment check when @-falignment-sanitisation@ is
  449 -- enabled.
  450 wordAligned :: PtrOpts -> CmmExpr -> CmmExpr
  451 wordAligned opts e
  452   | po_align_check opts
  453   = CmmMachOp (MO_AlignmentCheck (platformWordSizeInBytes platform) (wordWidth platform)) [e]
  454   | otherwise
  455   = e
  456   where platform = profilePlatform (po_profile opts)
  457 
  458 -- | Takes a closure pointer and returns the info table pointer
  459 closureInfoPtr :: PtrOpts -> CmmExpr -> CmmExpr
  460 closureInfoPtr opts e =
  461     CmmLoad (wordAligned opts e) (bWord (profilePlatform (po_profile opts)))
  462 
  463 -- | Takes an info pointer (the first word of a closure) and returns its entry
  464 -- code
  465 entryCode :: Platform -> CmmExpr -> CmmExpr
  466 entryCode platform e =
  467  if platformTablesNextToCode platform
  468       then e
  469       else CmmLoad e (bWord platform)
  470 
  471 -- | Takes a closure pointer, and return the *zero-indexed*
  472 -- constructor tag obtained from the info table
  473 -- This lives in the SRT field of the info table
  474 -- (constructors don't need SRTs).
  475 getConstrTag :: PtrOpts -> CmmExpr -> CmmExpr
  476 getConstrTag opts closure_ptr
  477   = CmmMachOp (MO_UU_Conv (halfWordWidth platform) (wordWidth platform)) [infoTableConstrTag profile info_table]
  478   where
  479     info_table = infoTable profile (closureInfoPtr opts closure_ptr)
  480     platform   = profilePlatform profile
  481     profile    = po_profile opts
  482 
  483 -- | Takes a closure pointer, and return the closure type
  484 -- obtained from the info table
  485 cmmGetClosureType :: PtrOpts -> CmmExpr -> CmmExpr
  486 cmmGetClosureType opts closure_ptr
  487   = CmmMachOp (MO_UU_Conv (halfWordWidth platform) (wordWidth platform)) [infoTableClosureType profile info_table]
  488   where
  489     info_table = infoTable profile (closureInfoPtr opts closure_ptr)
  490     platform   = profilePlatform profile
  491     profile    = po_profile opts
  492 
  493 -- | Takes an info pointer (the first word of a closure)
  494 -- and returns a pointer to the first word of the standard-form
  495 -- info table, excluding the entry-code word (if present)
  496 infoTable :: Profile -> CmmExpr -> CmmExpr
  497 infoTable profile info_ptr
  498   | platformTablesNextToCode platform = cmmOffsetB platform info_ptr (- stdInfoTableSizeB profile)
  499   | otherwise                         = cmmOffsetW platform info_ptr 1 -- Past the entry code pointer
  500   where platform = profilePlatform profile
  501 
  502 -- | Takes an info table pointer (from infoTable) and returns the constr tag
  503 -- field of the info table (same as the srt_bitmap field)
  504 infoTableConstrTag :: Profile -> CmmExpr -> CmmExpr
  505 infoTableConstrTag = infoTableSrtBitmap
  506 
  507 -- | Takes an info table pointer (from infoTable) and returns the srt_bitmap
  508 -- field of the info table
  509 infoTableSrtBitmap :: Profile -> CmmExpr -> CmmExpr
  510 infoTableSrtBitmap profile info_tbl
  511   = CmmLoad (cmmOffsetB platform info_tbl (stdSrtBitmapOffset profile)) (bHalfWord platform)
  512     where platform = profilePlatform profile
  513 
  514 -- | Takes an info table pointer (from infoTable) and returns the closure type
  515 -- field of the info table.
  516 infoTableClosureType :: Profile -> CmmExpr -> CmmExpr
  517 infoTableClosureType profile info_tbl
  518   = CmmLoad (cmmOffsetB platform info_tbl (stdClosureTypeOffset profile)) (bHalfWord platform)
  519     where platform = profilePlatform profile
  520 
  521 infoTablePtrs :: Profile -> CmmExpr -> CmmExpr
  522 infoTablePtrs profile info_tbl
  523   = CmmLoad (cmmOffsetB platform info_tbl (stdPtrsOffset profile)) (bHalfWord platform)
  524     where platform = profilePlatform profile
  525 
  526 infoTableNonPtrs :: Profile -> CmmExpr -> CmmExpr
  527 infoTableNonPtrs profile info_tbl
  528   = CmmLoad (cmmOffsetB platform info_tbl (stdNonPtrsOffset profile)) (bHalfWord platform)
  529     where platform = profilePlatform profile
  530 
  531 -- | Takes the info pointer of a function, and returns a pointer to the first
  532 -- word of the StgFunInfoExtra struct in the info table.
  533 funInfoTable :: Profile -> CmmExpr -> CmmExpr
  534 funInfoTable profile info_ptr
  535   | platformTablesNextToCode platform
  536   = cmmOffsetB platform info_ptr (- stdInfoTableSizeB profile - pc_SIZEOF_StgFunInfoExtraRev (platformConstants platform))
  537   | otherwise
  538   = cmmOffsetW platform info_ptr (1 + stdInfoTableSizeW profile)
  539                                   -- Past the entry code pointer
  540   where
  541     platform = profilePlatform profile
  542 
  543 -- | Takes the info pointer of a function, returns the function's arity
  544 funInfoArity :: Profile -> CmmExpr -> CmmExpr
  545 funInfoArity profile iptr
  546   = cmmToWord platform (cmmLoadIndex platform rep fun_info (offset `div` rep_bytes))
  547   where
  548    platform = profilePlatform profile
  549    fun_info = funInfoTable profile iptr
  550    rep = cmmBits (widthFromBytes rep_bytes)
  551    tablesNextToCode = platformTablesNextToCode platform
  552 
  553    (rep_bytes, offset)
  554     | tablesNextToCode = ( pc_REP_StgFunInfoExtraRev_arity pc
  555                          , pc_OFFSET_StgFunInfoExtraRev_arity pc )
  556     | otherwise        = ( pc_REP_StgFunInfoExtraFwd_arity pc
  557                          , pc_OFFSET_StgFunInfoExtraFwd_arity pc )
  558 
  559    pc = platformConstants platform
  560 
  561 -----------------------------------------------------------------------------
  562 --
  563 --      Info table sizes & offsets
  564 --
  565 -----------------------------------------------------------------------------
  566 
  567 stdInfoTableSizeW :: Profile -> WordOff
  568 -- The size of a standard info table varies with profiling/ticky etc,
  569 -- so we can't get it from Constants
  570 -- It must vary in sync with mkStdInfoTable
  571 stdInfoTableSizeW profile
  572   = fixedInfoTableSizeW
  573   + if profileIsProfiling profile
  574        then profInfoTableSizeW
  575        else 0
  576 
  577 fixedInfoTableSizeW :: WordOff
  578 fixedInfoTableSizeW = 2 -- layout, type
  579 
  580 profInfoTableSizeW :: WordOff
  581 profInfoTableSizeW = 2
  582 
  583 maxStdInfoTableSizeW :: WordOff
  584 maxStdInfoTableSizeW =
  585   1 {- entry, when !tablesNextToCode -}
  586   + fixedInfoTableSizeW
  587   + profInfoTableSizeW
  588 
  589 maxRetInfoTableSizeW :: WordOff
  590 maxRetInfoTableSizeW =
  591   maxStdInfoTableSizeW
  592   + 1 {- srt label -}
  593 
  594 stdInfoTableSizeB  :: Profile -> ByteOff
  595 stdInfoTableSizeB profile = stdInfoTableSizeW profile * profileWordSizeInBytes profile
  596 
  597 -- | Byte offset of the SRT bitmap half-word which is in the *higher-addressed*
  598 -- part of the type_lit
  599 stdSrtBitmapOffset :: Profile -> ByteOff
  600 stdSrtBitmapOffset profile = stdInfoTableSizeB profile - halfWordSize (profilePlatform profile)
  601 
  602 -- | Byte offset of the closure type half-word
  603 stdClosureTypeOffset :: Profile -> ByteOff
  604 stdClosureTypeOffset profile = stdInfoTableSizeB profile - profileWordSizeInBytes profile
  605 
  606 stdPtrsOffset :: Profile -> ByteOff
  607 stdPtrsOffset profile = stdInfoTableSizeB profile - 2 * profileWordSizeInBytes profile
  608 
  609 stdNonPtrsOffset :: Profile -> ByteOff
  610 stdNonPtrsOffset profile = stdInfoTableSizeB profile - 2 * profileWordSizeInBytes profile
  611                                                      + halfWordSize (profilePlatform profile)
  612 
  613 conInfoTableSizeB :: Profile -> Int
  614 conInfoTableSizeB profile = stdInfoTableSizeB profile + profileWordSizeInBytes profile