compiler/cmm/CmmInfo.hs

   1 module CmmInfo (
   2   cmmToRawCmm,
   3   mkInfoTable
   4 ) where
   5
   6 #include "HsVersions.h"
   7
   8 import Cmm
   9 import CmmUtils
  10 import PprCmm
  11
  12 import CLabel
  13 import MachOp
  14
  15 import Bitmap
  16 import ClosureInfo
  17 import CgInfoTbls
  18 import CgCallConv
  19 import CgUtils
  20 import SMRep
  21
  22 import Constants
  23 import StaticFlags
  24 import DynFlags
  25 import Unique
  26 import UniqSupply
  27 import Panic
  28
  29 import Data.Bits
  30
  31 cmmToRawCmm :: [Cmm] -> IO [RawCmm]
  32 cmmToRawCmm cmm = do
  33   info_tbl_uniques <- mkSplitUniqSupply 'i'
  34   return $ zipWith raw_cmm (listSplitUniqSupply info_tbl_uniques) cmm
  35     where
  36       raw_cmm uniq_supply (Cmm procs) =
  37           Cmm $ concat $ zipWith mkInfoTable (uniqsFromSupply uniq_supply) procs
  38
  39 -- Make a concrete info table, represented as a list of CmmStatic
  40 -- (it can't be simply a list of Word, because the SRT field is
  41 -- represented by a label+offset expression).
  42 --
  43 -- With tablesNextToCode, the layout is
  44 --      <reversed variable part>
  45 --      <normal forward StgInfoTable, but without
  46 --              an entry point at the front>
  47 --      <code>
  48 --
  49 -- Without tablesNextToCode, the layout of an info table is
  50 --      <entry label>
  51 --      <normal forward rest of StgInfoTable>
  52 --      <forward variable part>
  53 --
  54 --      See includes/InfoTables.h
  55 --
  56 -- For return-points these are as follows
  57 --
  58 -- Tables next to code:
  59 --
  60 --                      <srt slot>
  61 --                      <standard info table>
  62 --      ret-addr -->    <entry code (if any)>
  63 --
  64 -- Not tables-next-to-code:
  65 --
  66 --      ret-addr -->    <ptr to entry code>
  67 --                      <standard info table>
  68 --                      <srt slot>
  69 --
  70 --  * The SRT slot is only there if there is SRT info to record
  71
  72 mkInfoTable :: Unique -> CmmTop -> [RawCmmTop]
  73 mkInfoTable uniq (CmmData sec dat) = [CmmData sec dat]
  74 mkInfoTable uniq (CmmProc (CmmInfo _ _ info) entry_label arguments blocks) =
  75     case info of
  76       -- | Code without an info table.  Easy.
  77       CmmNonInfoTable -> [CmmProc [] entry_label arguments blocks]
  78
  79       CmmInfoTable (ProfilingInfo ty_prof cl_prof) type_tag type_info ->
  80           let info_label = entryLblToInfoLbl entry_label
  81               ty_prof' = makeRelativeRefTo info_label ty_prof
  82               cl_prof' = makeRelativeRefTo info_label cl_prof
  83           in case type_info of
  84           -- | A function entry point.
  85           FunInfo (ptrs, nptrs) srt fun_type fun_arity pap_bitmap slow_entry ->
  86               mkInfoTableAndCode info_label std_info fun_extra_bits entry_label
  87                                  arguments blocks
  88             where
  89               fun_extra_bits =
  90                  [packHalfWordsCLit fun_type fun_arity] ++
  91                  case pap_bitmap of
  92                  ArgGen liveness ->
  93                      (if null srt_label then [mkIntCLit 0] else srt_label) ++
  94                      [makeRelativeRefTo info_label $ mkLivenessCLit liveness,
  95                       makeRelativeRefTo info_label slow_entry]
  96                  _ -> srt_label
  97               std_info = mkStdInfoTable ty_prof' cl_prof' type_tag srt_bitmap
  98                                         layout
  99               (srt_label, srt_bitmap) = mkSRTLit info_label srt
 100               layout = packHalfWordsCLit ptrs nptrs
 101
 102           -- | A constructor.
 103           ConstrInfo (ptrs, nptrs) con_tag descr ->
 104               mkInfoTableAndCode info_label std_info [con_name] entry_label
 105                                  arguments blocks
 106               where
 107                 std_info = mkStdInfoTable ty_prof' cl_prof' type_tag con_tag layout
 108                 con_name = makeRelativeRefTo info_label descr
 109                 layout = packHalfWordsCLit ptrs nptrs
 110
 111           -- | A thunk.
 112           ThunkInfo (ptrs, nptrs) srt ->
 113               mkInfoTableAndCode info_label std_info srt_label entry_label
 114                                  arguments blocks
 115               where
 116                 std_info = mkStdInfoTable ty_prof' cl_prof' type_tag srt_bitmap layout
 117                 (srt_label, srt_bitmap) = mkSRTLit info_label srt
 118                 layout = packHalfWordsCLit ptrs nptrs
 119
 120           -- | A selector thunk.
 121           ThunkSelectorInfo offset srt ->
 122               mkInfoTableAndCode info_label std_info [{- no SRT -}] entry_label
 123                                  arguments blocks
 124               where
 125                 std_info = mkStdInfoTable ty_prof' cl_prof' type_tag 0 (mkWordCLit offset)
 126
 127           -- A continuation/return-point.
 128           ContInfo stack_layout srt ->
 129               liveness_data ++
 130               mkInfoTableAndCode info_label std_info srt_label entry_label
 131                                  arguments blocks
 132               where
 133                 std_info = mkStdInfoTable ty_prof' cl_prof' maybe_big_type_tag srt_bitmap
 134                                           (makeRelativeRefTo info_label liveness_lit)
 135                 (liveness_lit, liveness_data, liveness_tag) =
 136                     mkLiveness uniq stack_layout
 137                 maybe_big_type_tag = if type_tag == rET_SMALL
 138                                      then liveness_tag
 139                                      else type_tag
 140                 (srt_label, srt_bitmap) = mkSRTLit info_label srt
 141
 142 -- Handle the differences between tables-next-to-code
 143 -- and not tables-next-to-code
 144 mkInfoTableAndCode :: CLabel
 145                    -> [CmmLit]
 146                    -> [CmmLit]
 147                    -> CLabel
 148                    -> CmmFormals
 149                    -> [CmmBasicBlock]
 150                    -> [RawCmmTop]
 151 mkInfoTableAndCode info_lbl std_info extra_bits entry_lbl args blocks
 152   | tablesNextToCode    -- Reverse the extra_bits; and emit the top-level proc
 153   = [CmmProc (map CmmStaticLit (reverse extra_bits ++ std_info))
 154              entry_lbl args blocks]
 155
 156   | null blocks -- No actual code; only the info table is significant
 157   =             -- Use a zero place-holder in place of the
 158                 -- entry-label in the info table
 159     [mkRODataLits info_lbl (zeroCLit : std_info ++ extra_bits)]
 160
 161   | otherwise   -- Separately emit info table (with the function entry
 162   =             -- point as first entry) and the entry code
 163     [CmmProc [] entry_lbl args blocks,
 164      mkDataLits info_lbl (CmmLabel entry_lbl : std_info ++ extra_bits)]
 165
 166 mkSRTLit :: CLabel
 167          -> C_SRT
 168          -> ([CmmLit],    -- srt_label
 169              StgHalfWord) -- srt_bitmap
 170 mkSRTLit info_label NoC_SRT = ([], 0)
 171 mkSRTLit info_label (C_SRT lbl off bitmap) =
 172     ([makeRelativeRefTo info_label (cmmLabelOffW lbl off)], bitmap)
 173
 174 -------------------------------------------------------------------------
 175 --
 176 --              Build a liveness mask for the stack layout
 177 --
 178 -------------------------------------------------------------------------
 179
 180 -- There are four kinds of things on the stack:
 181 --
 182 --      - pointer variables (bound in the environment)
 183 --      - non-pointer variables (bound in the environment)
 184 --      - free slots (recorded in the stack free list)
 185 --      - non-pointer data slots (recorded in the stack free list)
 186 --
 187 -- The first two are represented with a 'Just' of a 'LocalReg'.
 188 -- The last two with one or more 'Nothing' constructors.
 189 -- Each 'Nothing' represents one used word.
 190 --
 191 -- The head of the stack layout is the top of the stack and
 192 -- the least-significant bit.
 193
 194 -- TODO: refactor to use utility functions
 195 -- TODO: combine with CgCallConv.mkLiveness (see comment there)
 196 mkLiveness :: Unique
 197            -> [Maybe LocalReg]
 198            -> (CmmLit,           -- ^ The bitmap (literal value or label)
 199                [RawCmmTop],      -- ^ Large bitmap CmmData if needed
 200                ClosureTypeTag)   -- ^ rET_SMALL or rET_BIG
 201 mkLiveness uniq live =
 202   if length bits > mAX_SMALL_BITMAP_SIZE
 203     -- does not fit in one word
 204     then (CmmLabel big_liveness, [data_lits], rET_BIG)
 205     -- fits in one word
 206     else (mkWordCLit small_liveness, [], rET_SMALL)
 207   where
 208     mkBits [] = []
 209     mkBits (reg:regs) = take sizeW bits ++ mkBits regs where
 210         sizeW = case reg of
 211                   Nothing -> 1
 212                   Just r -> (machRepByteWidth (localRegRep r) + wORD_SIZE - 1)
 213                             `quot` wORD_SIZE
 214                             -- number of words, rounded up
 215         bits = repeat $ is_non_ptr reg -- True <=> Non Ptr
 216
 217     is_non_ptr Nothing = True
 218     is_non_ptr (Just reg) =
 219         case localRegGCFollow reg of
 220           KindNonPtr -> True
 221           KindPtr -> False
 222
 223     bits :: [Bool]
 224     bits = mkBits live
 225
 226     bitmap :: Bitmap
 227     bitmap = mkBitmap bits
 228
 229     small_bitmap = case bitmap of
 230                    []  -> 0
 231                    [b] -> fromIntegral b
 232                    _   -> panic "mkLiveness"
 233     small_liveness =
 234         fromIntegral (length bits) .|. (small_bitmap `shiftL` bITMAP_BITS_SHIFT)
 235
 236     big_liveness = mkBitmapLabel uniq
 237     lits = mkWordCLit (fromIntegral (length bits)) : map mkWordCLit bitmap
 238     data_lits = mkRODataLits big_liveness lits
 239
 240 -------------------------------------------------------------------------
 241 --
 242 --      Generating a standard info table
 243 --
 244 -------------------------------------------------------------------------
 245
 246 -- The standard bits of an info table.  This part of the info table
 247 -- corresponds to the StgInfoTable type defined in InfoTables.h.
 248 --
 249 -- Its shape varies with ticky/profiling/tables next to code etc
 250 -- so we can't use constant offsets from Constants
 251
 252 mkStdInfoTable
 253    :: CmmLit            -- closure type descr (profiling)
 254    -> CmmLit            -- closure descr (profiling)
 255    -> StgHalfWord       -- closure type
 256    -> StgHalfWord       -- SRT length
 257    -> CmmLit            -- layout field
 258    -> [CmmLit]
 259
 260 mkStdInfoTable type_descr closure_descr cl_type srt_len layout_lit
 261  =      -- Parallel revertible-black hole field
 262     prof_info
 263         -- Ticky info (none at present)
 264         -- Debug info (none at present)
 265  ++ [layout_lit, type_lit]
 266
 267  where
 268     prof_info
 269         | opt_SccProfilingOn = [type_descr, closure_descr]
 270         | otherwise          = []
 271
 272     type_lit = packHalfWordsCLit cl_type srt_len