compiler/cmm/CmmInfo.hs

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