Info.hs 23.3 KB
Newer Older
1
{-# LANGUAGE CPP #-}
2
module GHC.Cmm.Info (
3
  mkEmptyContInfoTable,
4
  cmmToRawCmm,
5 6 7
  srtEscape,

  -- info table accessors
8
  PtrOpts (..),
9 10 11 12 13 14 15 16 17 18 19
  closureInfoPtr,
  entryCode,
  getConstrTag,
  cmmGetClosureType,
  infoTable,
  infoTableConstrTag,
  infoTableSrtBitmap,
  infoTableClosureType,
  infoTablePtrs,
  infoTableNonPtrs,
  funInfoTable,
20
  funInfoArity,
21 22 23 24 25 26 27 28

  -- info table sizes and offsets
  stdInfoTableSizeW,
  fixedInfoTableSizeW,
  profInfoTableSizeW,
  maxStdInfoTableSizeW,
  maxRetInfoTableSizeW,
  stdInfoTableSizeB,
29
  conInfoTableSizeB,
30 31 32
  stdSrtBitmapOffset,
  stdClosureTypeOffset,
  stdPtrsOffset, stdNonPtrsOffset,
33 34 35 36
) where

#include "HsVersions.h"

37
import GHC.Prelude
38

39 40 41
import GHC.Cmm
import GHC.Cmm.Utils
import GHC.Cmm.CLabel
42
import GHC.Runtime.Heap.Layout
43
import GHC.Data.Bitmap
44 45
import GHC.Data.Stream (Stream)
import qualified GHC.Data.Stream as Stream
46
import GHC.Cmm.Dataflow.Collections
47

John Ericson's avatar
John Ericson committed
48
import GHC.Platform
49
import GHC.Platform.Profile
50
import GHC.Data.Maybe
Sylvain Henry's avatar
Sylvain Henry committed
51
import GHC.Driver.Session
52 53
import GHC.Utils.Error (withTimingSilent)
import GHC.Utils.Panic
Sylvain Henry's avatar
Sylvain Henry committed
54
import GHC.Types.Unique.Supply
55 56 57
import GHC.Utils.Monad
import GHC.Utils.Misc
import GHC.Utils.Outputable
58

59
import Data.ByteString (ByteString)
60 61
import Data.Bits

62
-- When we split at proc points, we need an empty info table.
63
mkEmptyContInfoTable :: CLabel -> CmmInfoTable
64
mkEmptyContInfoTable info_lbl
65 66 67
  = CmmInfoTable { cit_lbl  = info_lbl
                 , cit_rep  = mkStackRep []
                 , cit_prof = NoProfilingInfo
68 69
                 , cit_srt  = Nothing
                 , cit_clo  = Nothing }
70

71
cmmToRawCmm :: DynFlags -> Stream IO CmmGroupSRTs a
72
            -> IO (Stream IO RawCmmGroup a)
73
cmmToRawCmm dflags cmms
74
  = do { uniqs <- mkSplitUniqSupply 'i'
75
       ; let do_one :: UniqSupply -> [CmmDeclSRTs] -> IO (UniqSupply, [RawCmmDecl])
76
             do_one uniqs cmm =
77
               -- NB. strictness fixes a space leak.  DO NOT REMOVE.
78
               withTimingSilent dflags (text "Cmm -> Raw Cmm")
79
                                forceRes $
80 81
                 case initUs uniqs $ concatMapM (mkInfoTable dflags) cmm of
                   (b,uniqs') -> return (uniqs',b)
82
       ; return (snd <$> Stream.mapAccumL_ do_one uniqs cmms)
83
       }
84

85 86 87
    where forceRes (uniqs, rawcmms) =
            uniqs `seq` foldr (\decl r -> decl `seq` r) () rawcmms

88 89 90 91 92
-- 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
93 94 95 96
--      <reversed variable part>
--      <normal forward StgInfoTable, but without
--              an entry point at the front>
--      <code>
97 98
--
-- Without tablesNextToCode, the layout of an info table is
99 100 101
--      <entry label>
--      <normal forward rest of StgInfoTable>
--      <forward variable part>
102
--
103
--      See includes/rts/storage/InfoTables.h
104 105 106 107 108
--
-- For return-points these are as follows
--
-- Tables next to code:
--
109 110 111
--                      <srt slot>
--                      <standard info table>
--      ret-addr -->    <entry code (if any)>
112 113 114
--
-- Not tables-next-to-code:
--
115 116 117
--      ret-addr -->    <ptr to entry code>
--                      <standard info table>
--                      <srt slot>
118 119 120
--
--  * The SRT slot is only there if there is SRT info to record

121 122
mkInfoTable :: DynFlags -> CmmDeclSRTs -> UniqSM [RawCmmDecl]
mkInfoTable _ (CmmData sec dat) = return [CmmData sec dat]
123

124
mkInfoTable dflags proc@(CmmProc infos entry_lbl live blocks)
125 126 127 128
  --
  -- 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.
  --
129
  | not (platformTablesNextToCode (targetPlatform dflags))
130 131 132
  = case topInfoTable proc of   --  must be at most one
      -- no info table
      Nothing ->
133
         return [CmmProc mapEmpty entry_lbl live blocks]
134 135 136 137 138

      Just info@CmmInfoTable { cit_lbl = info_lbl } -> do
        (top_decls, (std_info, extra_bits)) <-
             mkInfoTableContents dflags info Nothing
        let
139 140
          rel_std_info   = map (makeRelativeRefTo platform info_lbl) std_info
          rel_extra_bits = map (makeRelativeRefTo platform info_lbl) extra_bits
141
        --
142 143 144 145 146
        -- Separately emit info table (with the function entry
        -- point as first entry) and the entry code
        --
        return (top_decls ++
                [CmmProc mapEmpty entry_lbl live blocks,
147
                 mkRODataLits info_lbl
148
                    (CmmLabel entry_lbl : rel_std_info ++ rel_extra_bits)])
149 150 151 152 153 154 155 156 157

  --
  -- 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.
  --
  | otherwise
  = do
158 159
    (top_declss, raw_infos) <-
       unzip `fmap` mapM do_one_info (mapToList (info_tbls infos))
160
    return (concat top_declss ++
161
            [CmmProc (mapFromList raw_infos) entry_lbl live blocks])
162 163

  where
164
   platform = targetPlatform dflags
165 166 167 168 169
   do_one_info (lbl,itbl) = do
     (top_decls, (std_info, extra_bits)) <-
         mkInfoTableContents dflags itbl Nothing
     let
        info_lbl = cit_lbl itbl
170 171
        rel_std_info   = map (makeRelativeRefTo platform info_lbl) std_info
        rel_extra_bits = map (makeRelativeRefTo platform info_lbl) extra_bits
172
     --
Sylvain Henry's avatar
Sylvain Henry committed
173
     return (top_decls, (lbl, CmmStaticsRaw info_lbl $ map CmmStaticLit $
174
                              reverse rel_extra_bits ++ rel_std_info))
175 176

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

181
mkInfoTableContents :: DynFlags
182
                    -> CmmInfoTable
183
                    -> Maybe Int               -- Override default RTS type tag?
Simon Peyton Jones's avatar
Simon Peyton Jones committed
184
                    -> UniqSM ([RawCmmDecl],             -- Auxiliary top decls
185
                               InfoTableContents)       -- Info tbl + extra bits
186

187
mkInfoTableContents dflags
188
                    info@(CmmInfoTable { cit_lbl  = info_lbl
Simon Peyton Jones's avatar
Simon Peyton Jones committed
189 190
                                       , cit_rep  = smrep
                                       , cit_prof = prof
191
                                       , cit_srt = srt })
Simon Peyton Jones's avatar
Simon Peyton Jones committed
192 193
                    mb_rts_tag
  | RTSRep rts_tag rep <- smrep
194
  = mkInfoTableContents dflags info{cit_rep = rep} (Just rts_tag)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
195 196 197
    -- 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)
198

199
  | StackRep frame <- smrep
200
  = do { (prof_lits, prof_data) <- mkProfLits platform prof
201
       ; let (srt_label, srt_bitmap) = mkSRTLit platform info_lbl srt
202
       ; (liveness_lit, liveness_data) <- mkLivenessBits dflags frame
203
       ; let
204
             std_info = mkStdInfoTable dflags prof_lits rts_tag srt_bitmap liveness_lit
205
             rts_tag | Just tag <- mb_rts_tag = tag
206 207 208
                     | null liveness_data     = rET_SMALL -- Fits in extra_bits
                     | otherwise              = rET_BIG   -- Does not; extra_bits is
                                                          -- a label
209
       ; return (prof_data ++ liveness_data, (std_info, srt_label)) }
210 211

  | HeapRep _ ptrs nonptrs closure_type <- smrep
212
  = do { let layout  = packIntsCLit platform ptrs nonptrs
213
       ; (prof_lits, prof_data) <- mkProfLits platform prof
214
       ; let (srt_label, srt_bitmap) = mkSRTLit platform info_lbl srt
215
       ; (mb_srt_field, mb_layout, extra_bits, ct_data)
216
                                <- mk_pieces closure_type srt_label
217
       ; let std_info = mkStdInfoTable dflags prof_lits
218
                                       (mb_rts_tag   `orElse` rtsClosureType smrep)
219 220 221 222
                                       (mb_srt_field `orElse` srt_bitmap)
                                       (mb_layout    `orElse` layout)
       ; return (prof_data ++ ct_data, (std_info, extra_bits)) }
  where
223
    platform = targetPlatform dflags
224
    mk_pieces :: ClosureTypeInfo -> [CmmLit]
225 226
              -> UniqSM ( Maybe CmmLit  -- Override the SRT field with this
                        , Maybe CmmLit  -- Override the layout field with this
227 228
                        , [CmmLit]           -- "Extra bits" for info table
                        , [RawCmmDecl])      -- Auxiliary data decls
229 230
    mk_pieces (Constr con_tag con_descr) _no_srt    -- A data constructor
      = do { (descr_lit, decl) <- newStringLit con_descr
231
           ; return ( Just (CmmInt (fromIntegral con_tag)
232
                                   (halfWordWidth platform))
233
                    , Nothing, [descr_lit], [decl]) }
234 235 236 237 238

    mk_pieces Thunk srt_label
      = return (Nothing, Nothing, srt_label, [])

    mk_pieces (ThunkSelector offset) _no_srt
239 240
      = return (Just (CmmInt 0 (halfWordWidth platform)),
                Just (mkWordCLit platform (fromIntegral offset)), [], [])
241 242
         -- Layout known (one free var); we use the layout field for offset

243
    mk_pieces (Fun arity (ArgSpec fun_type)) srt_label
244
      = do { let extra_bits = packIntsCLit platform fun_type arity : srt_label
245 246 247
           ; return (Nothing, Nothing,  extra_bits, []) }

    mk_pieces (Fun arity (ArgGen arg_bits)) srt_label
248
      = do { (liveness_lit, liveness_data) <- mkLivenessBits dflags arg_bits
249 250
           ; let fun_type | null liveness_data = aRG_GEN
                          | otherwise          = aRG_GEN_BIG
251
                 extra_bits = [ packIntsCLit platform fun_type arity ]
252
                           ++ (if inlineSRT platform then [] else [ srt_lit ])
253
                           ++ [ liveness_lit, slow_entry ]
254 255
           ; return (Nothing, Nothing, extra_bits, liveness_data) }
      where
256
        slow_entry = CmmLabel (toSlowEntryLbl info_lbl)
257
        srt_lit = case srt_label of
258
                    []          -> mkIntCLit platform 0
259 260
                    (lit:_rest) -> ASSERT( null _rest ) lit

261
    mk_pieces other _ = pprPanic "mk_pieces" (ppr other)
262

263
mkInfoTableContents _ _ _ = panic "mkInfoTableContents"   -- NonInfoTable dealt with earlier
264

265 266
packIntsCLit :: Platform -> Int -> Int -> CmmLit
packIntsCLit platform a b = packHalfWordsCLit platform
267 268
                           (toStgHalfWord platform (fromIntegral a))
                           (toStgHalfWord platform (fromIntegral b))
269 270


271
mkSRTLit :: Platform
272
         -> CLabel
273
         -> Maybe CLabel
274
         -> ([CmmLit],    -- srt_label, if any
275
             CmmLit)      -- srt_bitmap
276 277 278 279 280
mkSRTLit platform info_lbl (Just lbl)
  | inlineSRT platform
  = ([], CmmLabelDiffOff lbl info_lbl 0 (halfWordWidth platform))
mkSRTLit platform _ Nothing    = ([], CmmInt 0 (halfWordWidth platform))
mkSRTLit platform _ (Just lbl) = ([CmmLabel lbl], CmmInt 1 (halfWordWidth platform))
281 282


283 284 285
-- | 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
286
-- Note [SRTs] in "GHC.Cmm.Info.Build"
287 288 289
inlineSRT :: Platform -> Bool
inlineSRT platform = platformArch platform == ArchX86_64
  && platformTablesNextToCode platform
290 291 292 293 294 295 296 297 298 299 300 301

-------------------------------------------------------------------------
--
--      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
Simon Peyton Jones's avatar
Simon Peyton Jones committed
302
-- and lays them out in memory, producing a list of RawCmmDecl
303 304 305

-------------------------------------------------------------------------
--
306
--      Position independent code
307 308 309 310 311 312 313 314 315 316
--
-------------------------------------------------------------------------
-- 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.

317 318 319 320 321 322 323 324
makeRelativeRefTo :: Platform -> CLabel -> CmmLit -> CmmLit
makeRelativeRefTo platform info_lbl lit
  = if platformTablesNextToCode platform
      then case lit of
         CmmLabel lbl        -> CmmLabelDiffOff lbl info_lbl 0   (wordWidth platform)
         CmmLabelOff lbl off -> CmmLabelDiffOff lbl info_lbl off (wordWidth platform)
         _                   -> lit
      else lit
325 326 327

-------------------------------------------------------------------------
--
328
--              Build a liveness mask for the stack layout
329 330 331 332 333
--
-------------------------------------------------------------------------

-- There are four kinds of things on the stack:
--
334 335 336 337
--      - 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)
338 339 340 341 342 343 344 345
--
-- 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.

346
mkLivenessBits :: DynFlags -> Liveness -> UniqSM (CmmLit, [RawCmmDecl])
Thomas Schilling's avatar
Thomas Schilling committed
347 348 349
              -- ^ Returns:
              --   1. The bitmap (literal value or label)
              --   2. Large bitmap CmmData if needed
350

351
mkLivenessBits dflags liveness
352
  | n_bits > mAX_SMALL_BITMAP_SIZE platform -- does not fit in one word
353
  = do { uniq <- getUniqueM
354
       ; let bitmap_lbl = mkBitmapLabel uniq
355
       ; return (CmmLabel bitmap_lbl,
356
                 [mkRODataLits bitmap_lbl lits]) }
357

358
  | otherwise -- Fits in one word
359
  = return (mkStgWordCLit platform bitmap_word, [])
360
  where
361
    platform = targetPlatform dflags
362
    n_bits = length liveness
363 364

    bitmap :: Bitmap
365
    bitmap = mkBitmap platform liveness
366

367
    small_bitmap = case bitmap of
368
                     []  -> toStgWord platform 0
369
                     [b] -> b
370
                     _   -> panic "mkLiveness"
371
    bitmap_word = toStgWord platform (fromIntegral n_bits)
372
              .|. (small_bitmap `shiftL` pc_BITMAP_BITS_SHIFT (platformConstants platform))
373

374 375
    lits = mkWordCLit platform (fromIntegral n_bits)
         : map (mkStgWordCLit platform) bitmap
376 377
      -- The first word is the size.  The structure must match
      -- StgLargeBitmap in includes/rts/storage/InfoTable.h
378 379 380

-------------------------------------------------------------------------
--
381
--      Generating a standard info table
382 383 384 385
--
-------------------------------------------------------------------------

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

mkStdInfoTable
393
   :: DynFlags
394
   -> (CmmLit,CmmLit)   -- Closure type descr and closure descr  (profiling)
395
   -> Int               -- Closure RTS tag
396
   -> CmmLit            -- SRT length
397
   -> CmmLit            -- layout field
398 399
   -> [CmmLit]

400
mkStdInfoTable dflags (type_descr, closure_descr) cl_type srt layout_lit
401
 =      -- Parallel revertible-black hole field
402
    prof_info
403 404
        -- Ticky info (none at present)
        -- Debug info (none at present)
405
 ++ [layout_lit, tag, srt]
406

407
 where
408
    platform = targetPlatform dflags
409
    prof_info
410
        | sccProfilingEnabled dflags = [type_descr, closure_descr]
411
        | otherwise = []
412

413
    tag = CmmInt (fromIntegral cl_type) (halfWordWidth platform)
414

415 416 417 418 419 420
-------------------------------------------------------------------------
--
--      Making string literals
--
-------------------------------------------------------------------------

421 422
mkProfLits :: Platform -> ProfilingInfo -> UniqSM ((CmmLit,CmmLit), [RawCmmDecl])
mkProfLits platform NoProfilingInfo = return ((zeroCLit platform, zeroCLit platform), [])
423
mkProfLits _ (ProfilingInfo td cd)
424 425 426 427
  = do { (td_lit, td_decl) <- newStringLit td
       ; (cd_lit, cd_decl) <- newStringLit cd
       ; return ((td_lit,cd_lit), [td_decl,cd_decl]) }

428
newStringLit :: ByteString -> UniqSM (CmmLit, GenCmmDecl RawCmmStatics info stmt)
429
newStringLit bytes
430
  = do { uniq <- getUniqueM
431
       ; return (mkByteStringCLit (mkStringLitLabel uniq) bytes) }
432

Simon Marlow's avatar
Simon Marlow committed
433 434 435 436

-- Misc utils

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

-------------------------------------------------------------------------
--
442
--      Accessing fields of an info table
443 444 445
--
-------------------------------------------------------------------------

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

Ben Gamari's avatar
Ben Gamari committed
451 452
-- | Wrap a 'CmmExpr' in an alignment check when @-falignment-sanitisation@ is
-- enabled.
453 454 455
wordAligned :: PtrOpts -> CmmExpr -> CmmExpr
wordAligned opts e
  | po_align_check opts
456
  = CmmMachOp (MO_AlignmentCheck (platformWordSizeInBytes platform) (wordWidth platform)) [e]
Ben Gamari's avatar
Ben Gamari committed
457 458
  | otherwise
  = e
459
  where platform = profilePlatform (po_profile opts)
Ben Gamari's avatar
Ben Gamari committed
460

461 462 463 464
-- | Takes a closure pointer and returns the info table pointer
closureInfoPtr :: PtrOpts -> CmmExpr -> CmmExpr
closureInfoPtr opts e =
    CmmLoad (wordAligned opts e) (bWord (profilePlatform (po_profile opts)))
465

466 467 468 469 470 471 472
-- | Takes an info pointer (the first word of a closure) and returns its entry
-- code
entryCode :: Platform -> CmmExpr -> CmmExpr
entryCode platform e =
 if platformTablesNextToCode platform
      then e
      else CmmLoad e (bWord platform)
473

474
-- | Takes a closure pointer, and return the *zero-indexed*
475 476 477
-- constructor tag obtained from the info table
-- This lives in the SRT field of the info table
-- (constructors don't need SRTs).
478 479 480
getConstrTag :: PtrOpts -> CmmExpr -> CmmExpr
getConstrTag opts closure_ptr
  = CmmMachOp (MO_UU_Conv (halfWordWidth platform) (wordWidth platform)) [infoTableConstrTag profile info_table]
481
  where
482 483 484
    info_table = infoTable profile (closureInfoPtr opts closure_ptr)
    platform   = profilePlatform profile
    profile    = po_profile opts
485

486
-- | Takes a closure pointer, and return the closure type
487
-- obtained from the info table
488 489 490
cmmGetClosureType :: PtrOpts -> CmmExpr -> CmmExpr
cmmGetClosureType opts closure_ptr
  = CmmMachOp (MO_UU_Conv (halfWordWidth platform) (wordWidth platform)) [infoTableClosureType profile info_table]
491
  where
492 493 494
    info_table = infoTable profile (closureInfoPtr opts closure_ptr)
    platform   = profilePlatform profile
    profile    = po_profile opts
495

496
-- | Takes an info pointer (the first word of a closure)
497 498
-- and returns a pointer to the first word of the standard-form
-- info table, excluding the entry-code word (if present)
499 500 501
infoTable :: Profile -> CmmExpr -> CmmExpr
infoTable profile info_ptr
  | platformTablesNextToCode platform = cmmOffsetB platform info_ptr (- stdInfoTableSizeB profile)
502
  | otherwise                         = cmmOffsetW platform info_ptr 1 -- Past the entry code pointer
503
  where platform = profilePlatform profile
504

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

510
-- | Takes an info table pointer (from infoTable) and returns the srt_bitmap
511
-- field of the info table
512 513 514 515
infoTableSrtBitmap :: Profile -> CmmExpr -> CmmExpr
infoTableSrtBitmap profile info_tbl
  = CmmLoad (cmmOffsetB platform info_tbl (stdSrtBitmapOffset profile)) (bHalfWord platform)
    where platform = profilePlatform profile
516

517
-- | Takes an info table pointer (from infoTable) and returns the closure type
518
-- field of the info table.
519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537
infoTableClosureType :: Profile -> CmmExpr -> CmmExpr
infoTableClosureType profile info_tbl
  = CmmLoad (cmmOffsetB platform info_tbl (stdClosureTypeOffset profile)) (bHalfWord platform)
    where platform = profilePlatform profile

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

infoTableNonPtrs :: Profile -> CmmExpr -> CmmExpr
infoTableNonPtrs profile info_tbl
  = CmmLoad (cmmOffsetB platform info_tbl (stdNonPtrsOffset profile)) (bHalfWord platform)
    where platform = profilePlatform 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 info_ptr
538
  | platformTablesNextToCode platform
539
  = cmmOffsetB platform info_ptr (- stdInfoTableSizeB profile - pc_SIZEOF_StgFunInfoExtraRev (platformConstants platform))
540
  | otherwise
541
  = cmmOffsetW platform info_ptr (1 + stdInfoTableSizeW profile)
542 543
                                  -- Past the entry code pointer
  where
544
    platform = profilePlatform profile
545

546 547 548
-- | Takes the info pointer of a function, returns the function's arity
funInfoArity :: Profile -> CmmExpr -> CmmExpr
funInfoArity profile iptr
549
  = cmmToWord platform (cmmLoadIndex platform rep fun_info (offset `div` rep_bytes))
550
  where
551 552
   platform = profilePlatform profile
   fun_info = funInfoTable profile iptr
553
   rep = cmmBits (widthFromBytes rep_bytes)
554
   tablesNextToCode = platformTablesNextToCode platform
555 556

   (rep_bytes, offset)
557
    | tablesNextToCode = ( pc_REP_StgFunInfoExtraRev_arity pc
558
                         , pc_OFFSET_StgFunInfoExtraRev_arity pc )
559
    | otherwise        = ( pc_REP_StgFunInfoExtraFwd_arity pc
560
                         , pc_OFFSET_StgFunInfoExtraFwd_arity pc )
561

562
   pc = platformConstants platform
563

564 565 566 567 568
-----------------------------------------------------------------------------
--
--      Info table sizes & offsets
--
-----------------------------------------------------------------------------
569

570
stdInfoTableSizeW :: Profile -> WordOff
571 572 573
-- 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
574
stdInfoTableSizeW profile
575
  = fixedInfoTableSizeW
576
  + if profileIsProfiling profile
577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596
       then profInfoTableSizeW
       else 0

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

profInfoTableSizeW :: WordOff
profInfoTableSizeW = 2

maxStdInfoTableSizeW :: WordOff
maxStdInfoTableSizeW =
  1 {- entry, when !tablesNextToCode -}
  + fixedInfoTableSizeW
  + profInfoTableSizeW

maxRetInfoTableSizeW :: WordOff
maxRetInfoTableSizeW =
  maxStdInfoTableSizeW
  + 1 {- srt label -}

597 598
stdInfoTableSizeB  :: Profile -> ByteOff
stdInfoTableSizeB profile = stdInfoTableSizeW profile * profileWordSizeInBytes profile
599

600 601 602 603
-- | Byte offset of the SRT bitmap half-word which is in the *higher-addressed*
-- part of the type_lit
stdSrtBitmapOffset :: Profile -> ByteOff
stdSrtBitmapOffset profile = stdInfoTableSizeB profile - halfWordSize (profilePlatform profile)
604

605 606 607
-- | Byte offset of the closure type half-word
stdClosureTypeOffset :: Profile -> ByteOff
stdClosureTypeOffset profile = stdInfoTableSizeB profile - profileWordSizeInBytes profile
608

609 610
stdPtrsOffset :: Profile -> ByteOff
stdPtrsOffset profile = stdInfoTableSizeB profile - 2 * profileWordSizeInBytes profile
611

612 613 614
stdNonPtrsOffset :: Profile -> ByteOff
stdNonPtrsOffset profile = stdInfoTableSizeB profile - 2 * profileWordSizeInBytes profile
                                                     + halfWordSize (profilePlatform profile)
615

616 617
conInfoTableSizeB :: Profile -> Int
conInfoTableSizeB profile = stdInfoTableSizeB profile + profileWordSizeInBytes profile