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 info entry_label arguments blocks) =
  75     case info of
  76       -- | Code without an info table.  Easy.
  77       CmmNonInfo _ -> [CmmProc [] entry_label arguments blocks]
  78
  79       -- | A function entry point.
  80       CmmInfo (ProfilingInfo ty_prof cl_prof) _ type_tag
  81               (FunInfo (ptrs, nptrs) srt fun_type fun_arity
  82                        pap_bitmap slow_entry) ->
  83           mkInfoTableAndCode info_label std_info fun_extra_bits entry_label
  84                              arguments blocks
  85           where
  86             fun_extra_bits =
  87                [packHalfWordsCLit fun_type fun_arity] ++
  88                srt_label ++
  89                case pap_bitmap of
  90                  ArgGen liveness ->
  91                      [makeRelativeRefTo info_label $ mkLivenessCLit liveness,
  92                       makeRelativeRefTo info_label slow_entry]
  93                  _ -> []
  94             std_info = mkStdInfoTable ty_prof cl_prof type_tag srt_bitmap layout
  95             info_label = entryLblToInfoLbl entry_label
  96             (srt_label, srt_bitmap) = mkSRTLit info_label srt
  97             layout = packHalfWordsCLit ptrs nptrs
  98
  99       -- | A constructor.
 100       CmmInfo (ProfilingInfo ty_prof cl_prof) _ type_tag
 101               (ConstrInfo (ptrs, nptrs) con_tag descr) ->
 102           mkInfoTableAndCode info_label std_info [con_name] entry_label
 103                              arguments blocks
 104           where
 105             std_info = mkStdInfoTable ty_prof cl_prof type_tag con_tag layout
 106             info_label = entryLblToInfoLbl entry_label
 107             con_name = makeRelativeRefTo info_label descr
 108             layout = packHalfWordsCLit ptrs nptrs
 109
 110       -- | A thunk.
 111       CmmInfo (ProfilingInfo ty_prof cl_prof) _ type_tag
 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             info_label = entryLblToInfoLbl entry_label
 118             (srt_label, srt_bitmap) = mkSRTLit info_label srt
 119             layout = packHalfWordsCLit ptrs nptrs
 120
 121       -- | A selector thunk.
 122       CmmInfo (ProfilingInfo ty_prof cl_prof) _ type_tag
 123               (ThunkSelectorInfo offset srt) ->
 124           mkInfoTableAndCode info_label std_info srt_label entry_label
 125                              arguments blocks
 126           where
 127             std_info = mkStdInfoTable ty_prof cl_prof type_tag srt_bitmap (mkWordCLit offset)
 128             info_label = entryLblToInfoLbl entry_label
 129             (srt_label, srt_bitmap) = mkSRTLit info_label srt
 130
 131       -- A continuation/return-point.
 132       CmmInfo (ProfilingInfo ty_prof cl_prof) _ type_tag (ContInfo stack_layout srt) ->
 133           liveness_data ++
 134           mkInfoTableAndCode info_label std_info srt_label entry_label
 135                              arguments blocks
 136           where
 137             std_info = mkStdInfoTable ty_prof cl_prof maybe_big_type_tag srt_bitmap
 138                                       (makeRelativeRefTo info_label liveness_lit)
 139             info_label = entryLblToInfoLbl entry_label
 140             (liveness_lit, liveness_data, liveness_tag) =
 141                 mkLiveness uniq stack_layout
 142             maybe_big_type_tag = if type_tag == rET_SMALL
 143                                  then liveness_tag
 144                                  else type_tag
 145             (srt_label, srt_bitmap) = mkSRTLit info_label srt
 146
 147 -- Handle the differences between tables-next-to-code
 148 -- and not tables-next-to-code
 149 mkInfoTableAndCode :: CLabel
 150                    -> [CmmLit]
 151                    -> [CmmLit]
 152                    -> CLabel
 153                    -> CmmFormals
 154                    -> [CmmBasicBlock]
 155                    -> [RawCmmTop]
 156 mkInfoTableAndCode info_lbl std_info extra_bits entry_lbl args blocks
 157   | tablesNextToCode    -- Reverse the extra_bits; and emit the top-level proc
 158   = [CmmProc (map CmmStaticLit (reverse extra_bits ++ std_info))
 159              entry_lbl args blocks]
 160
 161   | null blocks -- No actual code; only the info table is significant
 162   =             -- Use a zero place-holder in place of the
 163                 -- entry-label in the info table
 164     [mkRODataLits info_lbl (zeroCLit : std_info ++ extra_bits)]
 165
 166   | otherwise   -- Separately emit info table (with the function entry
 167   =             -- point as first entry) and the entry code
 168     [mkDataLits info_lbl (CmmLabel entry_lbl : std_info ++ extra_bits),
 169      CmmProc [] entry_lbl args blocks]
 170
 171 mkSRTLit :: CLabel
 172          -> C_SRT
 173          -> ([CmmLit],    -- srt_label
 174              StgHalfWord) -- srt_bitmap
 175 mkSRTLit info_label NoC_SRT = ([], 0)
 176 mkSRTLit info_label (C_SRT lbl off bitmap) =
 177     ([makeRelativeRefTo info_label (cmmLabelOffW lbl off)], bitmap)
 178
 179 -------------------------------------------------------------------------
 180 --
 181 --              Build a liveness mask for the stack layout
 182 --
 183 -------------------------------------------------------------------------
 184
 185 -- There are four kinds of things on the stack:
 186 --
 187 --      - pointer variables (bound in the environment)
 188 --      - non-pointer variables (bound in the environment)
 189 --      - free slots (recorded in the stack free list)
 190 --      - non-pointer data slots (recorded in the stack free list)
 191 --
 192 -- The first two are represented with a 'Just' of a 'LocalReg'.
 193 -- The last two with one or more 'Nothing' constructors.
 194 -- Each 'Nothing' represents one used word.
 195 --
 196 -- The head of the stack layout is the top of the stack and
 197 -- the least-significant bit.
 198
 199 -- TODO: refactor to use utility functions
 200 -- TODO: combine with CgCallConv.mkLiveness (see comment there)
 201 mkLiveness :: Unique
 202            -> [Maybe LocalReg]
 203            -> (CmmLit,           -- ^ The bitmap (literal value or label)
 204                [RawCmmTop],      -- ^ Large bitmap CmmData if needed
 205                ClosureTypeTag)   -- ^ 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 -> machRepByteWidth (localRegRep r) `quot` wORD_SIZE
 218         bits = repeat $ is_non_ptr reg -- True <=> Non Ptr
 219
 220     is_non_ptr Nothing = True
 221     is_non_ptr (Just reg) =
 222         case localRegGCFollow reg of
 223           KindNonPtr -> True
 224           KindPtr -> False
 225
 226     bits :: [Bool]
 227     bits = mkBits live
 228
 229     bitmap :: Bitmap
 230     bitmap = mkBitmap bits
 231
 232     small_bitmap = case bitmap of
 233                    []  -> 0
 234                    [b] -> fromIntegral b
 235                    _   -> panic "mkLiveness"
 236     small_liveness =
 237         fromIntegral (length bits) .|. (small_bitmap `shiftL` bITMAP_BITS_SHIFT)
 238
 239     big_liveness = mkBitmapLabel uniq
 240     lits = mkWordCLit (fromIntegral (length bits)) : map mkWordCLit bitmap
 241     data_lits = mkRODataLits big_liveness lits
 242
 243 -------------------------------------------------------------------------
 244 --
 245 --      Generating a standard info table
 246 --
 247 -------------------------------------------------------------------------
 248
 249 -- The standard bits of an info table.  This part of the info table
 250 -- corresponds to the StgInfoTable type defined in InfoTables.h.
 251 --
 252 -- Its shape varies with ticky/profiling/tables next to code etc
 253 -- so we can't use constant offsets from Constants
 254
 255 mkStdInfoTable
 256    :: CmmLit            -- closure type descr (profiling)
 257    -> CmmLit            -- closure descr (profiling)
 258    -> StgHalfWord       -- closure type
 259    -> StgHalfWord       -- SRT length
 260    -> CmmLit            -- layout field
 261    -> [CmmLit]
 262
 263 mkStdInfoTable type_descr closure_descr cl_type srt_len layout_lit
 264  =      -- Parallel revertible-black hole field
 265     prof_info
 266         -- Ticky info (none at present)
 267         -- Debug info (none at present)
 268  ++ [layout_lit, type_lit]
 269
 270  where
 271     prof_info
 272         | opt_SccProfilingOn = [type_descr, closure_descr]
 273         | otherwise          = []
 274
 275     type_lit = packHalfWordsCLit cl_type srt_len