compiler/codeGen/CgInfoTbls.hs

   1 -----------------------------------------------------------------------------
   2 --
   3 -- Building info tables.
   4 --
   5 -- (c) The University of Glasgow 2004-2006
   6 --
   7 -----------------------------------------------------------------------------
   8
   9 module CgInfoTbls (
  10         emitClosureCodeAndInfoTable,
  11         emitInfoTableAndCode,
  12         dataConTagZ,
  13         getSRTInfo,
  14         emitReturnTarget, emitAlgReturnTarget,
  15         emitReturnInstr,
  16         mkRetInfoTable,
  17         mkStdInfoTable,
  18         stdInfoTableSizeB,
  19         mkFunGenInfoExtraBits,
  20         entryCode, closureInfoPtr,
  21         getConstrTag,
  22         infoTable, infoTableClosureType,
  23         infoTablePtrs, infoTableNonPtrs,
  24         funInfoTable
  25   ) where
  26
  27
  28 #include "HsVersions.h"
  29
  30 import ClosureInfo
  31 import SMRep
  32 import CgBindery
  33 import CgCallConv
  34 import CgUtils
  35 import CgMonad
  36
  37 import CmmUtils
  38 import Cmm
  39 import MachOp
  40 import CLabel
  41 import StgSyn
  42 import Name
  43 import DataCon
  44 import Unique
  45 import StaticFlags
  46
  47 import Maybes
  48 import Constants
  49
  50 import Outputable
  51
  52 -------------------------------------------------------------------------
  53 --
  54 --      Generating the info table and code for a closure
  55 --
  56 -------------------------------------------------------------------------
  57
  58 -- Here we make a concrete info table, represented as a list of CmmAddr
  59 -- (it can't be simply a list of Word, because the SRT field is
  60 -- represented by a label+offset expression).
  61
  62 -- With tablesNextToCode, the layout is
  63 --      <reversed variable part>
  64 --      <normal forward StgInfoTable, but without
  65 --              an entry point at the front>
  66 --      <code>
  67 --
  68 -- Without tablesNextToCode, the layout of an info table is
  69 --      <entry label>
  70 --      <normal forward rest of StgInfoTable>
  71 --      <forward variable part>
  72 --
  73 --      See includes/InfoTables.h
  74
  75 emitClosureCodeAndInfoTable :: ClosureInfo -> [LocalReg] -> CgStmts -> Code
  76 emitClosureCodeAndInfoTable cl_info args body
  77  = do   { ty_descr_lit <-
  78                 if opt_SccProfilingOn
  79                    then mkStringCLit (closureTypeDescr cl_info)
  80                    else return (mkIntCLit 0)
  81         ; cl_descr_lit <-
  82                 if opt_SccProfilingOn
  83                    then mkStringCLit cl_descr_string
  84                    else return (mkIntCLit 0)
  85         ; let std_info = mkStdInfoTable ty_descr_lit cl_descr_lit
  86                                         cl_type srt_len layout_lit
  87
  88         ; blks <- cgStmtsToBlocks body
  89
  90         ; conName <-
  91              if is_con
  92                 then do cstr <- mkStringCLit $ fromJust conIdentity
  93                         return (makeRelativeRefTo info_lbl cstr)
  94                 else return (mkIntCLit 0)
  95
  96         ; emitInfoTableAndCode info_lbl std_info (extra_bits conName) args blks }
  97   where
  98     info_lbl  = infoTableLabelFromCI cl_info
  99
 100     cl_descr_string = closureValDescr cl_info
 101     cl_type = smRepClosureTypeInt (closureSMRep cl_info)
 102
 103     srt = closureSRT cl_info
 104     needs_srt = needsSRT srt
 105
 106     mb_con = isConstrClosure_maybe  cl_info
 107     is_con = isJust mb_con
 108
 109     (srt_label,srt_len,conIdentity)
 110         = case mb_con of
 111             Just con -> -- Constructors don't have an SRT
 112                         -- We keep the *zero-indexed* tag in the srt_len
 113                         -- field of the info table.
 114                         (mkIntCLit 0, fromIntegral (dataConTagZ con), Just $ dataConIdentity con)
 115
 116             Nothing  -> -- Not a constructor
 117                         let (label, len) = srtLabelAndLength srt info_lbl
 118                         in (label, len, Nothing)
 119
 120     ptrs       = closurePtrsSize cl_info
 121     nptrs      = size - ptrs
 122     size       = closureNonHdrSize cl_info
 123     layout_lit = packHalfWordsCLit ptrs nptrs
 124
 125     extra_bits conName
 126         | is_fun    = fun_extra_bits
 127         | is_con    = [conName]
 128         | needs_srt = [srt_label]
 129         | otherwise = []
 130
 131     maybe_fun_stuff = closureFunInfo cl_info
 132     is_fun = isJust maybe_fun_stuff
 133     (Just (arity, arg_descr)) = maybe_fun_stuff
 134
 135     fun_extra_bits
 136         | ArgGen liveness <- arg_descr
 137         = [ fun_amode,
 138             srt_label,
 139             makeRelativeRefTo info_lbl $ mkLivenessCLit liveness,
 140             slow_entry ]
 141         | needs_srt = [fun_amode, srt_label]
 142         | otherwise = [fun_amode]
 143
 144     slow_entry = makeRelativeRefTo info_lbl (CmmLabel slow_entry_label)
 145     slow_entry_label = mkSlowEntryLabel (closureName cl_info)
 146
 147     fun_amode = packHalfWordsCLit fun_type arity
 148     fun_type  = argDescrType arg_descr
 149
 150 -- We keep the *zero-indexed* tag in the srt_len field of the info
 151 -- table of a data constructor.
 152 dataConTagZ :: DataCon -> ConTagZ
 153 dataConTagZ con = dataConTag con - fIRST_TAG
 154
 155 -- A low-level way to generate the variable part of a fun-style info table.
 156 -- (must match fun_extra_bits above).  Used by the C-- parser.
 157 mkFunGenInfoExtraBits :: Int -> Int -> CmmLit -> CmmLit -> CmmLit -> [CmmLit]
 158 mkFunGenInfoExtraBits fun_type arity srt_label liveness slow_entry
 159   = [ packHalfWordsCLit fun_type arity,
 160       srt_label,
 161       liveness,
 162       slow_entry ]
 163
 164 -------------------------------------------------------------------------
 165 --
 166 --      Generating the info table and code for a return point
 167 --
 168 -------------------------------------------------------------------------
 169
 170 --      Here's the layout of a return-point info table
 171 --
 172 -- Tables next to code:
 173 --
 174 --                      <srt slot>
 175 --                      <standard info table>
 176 --      ret-addr -->    <entry code (if any)>
 177 --
 178 -- Not tables-next-to-code:
 179 --
 180 --      ret-addr -->    <ptr to entry code>
 181 --                      <standard info table>
 182 --                      <srt slot>
 183 --
 184 --  * The SRT slot is only there is SRT info to record
 185
 186 emitReturnTarget
 187    :: Name
 188    -> CgStmts                   -- The direct-return code (if any)
 189    -> SRT
 190    -> FCode CLabel
 191 emitReturnTarget name stmts srt
 192   = do  { live_slots <- getLiveStackSlots
 193         ; liveness   <- buildContLiveness name live_slots
 194         ; srt_info   <- getSRTInfo name srt
 195
 196         ; let
 197               cl_type | isBigLiveness liveness = rET_BIG
 198                       | otherwise              = rET_SMALL
 199
 200               (std_info, extra_bits) =
 201                    mkRetInfoTable info_lbl liveness srt_info cl_type
 202
 203         ; blks <- cgStmtsToBlocks stmts
 204         ; emitInfoTableAndCode info_lbl std_info extra_bits args blks
 205         ; return info_lbl }
 206   where
 207     args      = {- trace "emitReturnTarget: missing args" -} []
 208     uniq      = getUnique name
 209     info_lbl  = mkReturnInfoLabel uniq
 210
 211
 212 mkRetInfoTable
 213   :: CLabel             -- info label
 214   -> Liveness           -- liveness
 215   -> C_SRT              -- SRT Info
 216   -> Int                -- type (eg. rET_SMALL)
 217   -> ([CmmLit],[CmmLit])
 218 mkRetInfoTable info_lbl liveness srt_info cl_type
 219   =  (std_info, srt_slot)
 220   where
 221         (srt_label, srt_len) = srtLabelAndLength srt_info info_lbl
 222
 223         srt_slot | needsSRT srt_info = [srt_label]
 224                  | otherwise         = []
 225
 226         liveness_lit = makeRelativeRefTo info_lbl $ mkLivenessCLit liveness
 227         std_info = mkStdInfoTable zeroCLit zeroCLit cl_type srt_len liveness_lit
 228
 229 emitAlgReturnTarget
 230         :: Name                         -- Just for its unique
 231         -> [(ConTagZ, CgStmts)]         -- Tagged branches
 232         -> Maybe CgStmts                -- Default branch (if any)
 233         -> SRT                          -- Continuation's SRT
 234         -> Int                          -- family size
 235         -> FCode (CLabel, SemiTaggingStuff)
 236
 237 emitAlgReturnTarget name branches mb_deflt srt fam_sz
 238   = do  { blks <- getCgStmts $
 239                     emitSwitch tag_expr branches mb_deflt 0 (fam_sz - 1)
 240                 -- NB: tag_expr is zero-based
 241         ; lbl <- emitReturnTarget name blks srt
 242         ; return (lbl, Nothing) }
 243                 -- Nothing: the internal branches in the switch don't have
 244                 -- global labels, so we can't use them at the 'call site'
 245   where
 246     tag_expr = getConstrTag (CmmReg nodeReg)
 247
 248 --------------------------------
 249 emitReturnInstr :: Code
 250 emitReturnInstr
 251   = do  { info_amode <- getSequelAmode
 252         ; stmtC (CmmJump (entryCode info_amode) []) }
 253
 254 -------------------------------------------------------------------------
 255 --
 256 --      Generating a standard info table
 257 --
 258 -------------------------------------------------------------------------
 259
 260 -- The standard bits of an info table.  This part of the info table
 261 -- corresponds to the StgInfoTable type defined in InfoTables.h.
 262 --
 263 -- Its shape varies with ticky/profiling/tables next to code etc
 264 -- so we can't use constant offsets from Constants
 265
 266 mkStdInfoTable
 267    :: CmmLit            -- closure type descr (profiling)
 268    -> CmmLit            -- closure descr (profiling)
 269    -> Int               -- closure type
 270    -> StgHalfWord       -- SRT length
 271    -> CmmLit            -- layout field
 272    -> [CmmLit]
 273
 274 mkStdInfoTable type_descr closure_descr cl_type srt_len layout_lit
 275  =      -- Parallel revertible-black hole field
 276     prof_info
 277         -- Ticky info (none at present)
 278         -- Debug info (none at present)
 279  ++ [layout_lit, type_lit]
 280
 281  where
 282     prof_info
 283         | opt_SccProfilingOn = [type_descr, closure_descr]
 284         | otherwise          = []
 285
 286     type_lit = packHalfWordsCLit cl_type srt_len
 287
 288 stdInfoTableSizeW :: WordOff
 289 -- The size of a standard info table varies with profiling/ticky etc,
 290 -- so we can't get it from Constants
 291 -- It must vary in sync with mkStdInfoTable
 292 stdInfoTableSizeW
 293   = size_fixed + size_prof
 294   where
 295     size_fixed = 2      -- layout, type
 296     size_prof | opt_SccProfilingOn = 2
 297               | otherwise          = 0
 298
 299 stdInfoTableSizeB = stdInfoTableSizeW * wORD_SIZE :: ByteOff
 300
 301 stdSrtBitmapOffset :: ByteOff
 302 -- Byte offset of the SRT bitmap half-word which is
 303 -- in the *higher-addressed* part of the type_lit
 304 stdSrtBitmapOffset = stdInfoTableSizeB - hALF_WORD_SIZE
 305
 306 stdClosureTypeOffset :: ByteOff
 307 -- Byte offset of the closure type half-word
 308 stdClosureTypeOffset = stdInfoTableSizeB - wORD_SIZE
 309
 310 stdPtrsOffset, stdNonPtrsOffset :: ByteOff
 311 stdPtrsOffset    = stdInfoTableSizeB - 2*wORD_SIZE
 312 stdNonPtrsOffset = stdInfoTableSizeB - 2*wORD_SIZE + hALF_WORD_SIZE
 313
 314 -------------------------------------------------------------------------
 315 --
 316 --      Accessing fields of an info table
 317 --
 318 -------------------------------------------------------------------------
 319
 320 closureInfoPtr :: CmmExpr -> CmmExpr
 321 -- Takes a closure pointer and returns the info table pointer
 322 closureInfoPtr e = CmmLoad e wordRep
 323
 324 entryCode :: CmmExpr -> CmmExpr
 325 -- Takes an info pointer (the first word of a closure)
 326 -- and returns its entry code
 327 entryCode e | tablesNextToCode = e
 328             | otherwise        = CmmLoad e wordRep
 329
 330 getConstrTag :: CmmExpr -> CmmExpr
 331 -- Takes a closure pointer, and return the *zero-indexed*
 332 -- constructor tag obtained from the info table
 333 -- This lives in the SRT field of the info table
 334 -- (constructors don't need SRTs).
 335 getConstrTag closure_ptr
 336   = CmmMachOp (MO_U_Conv halfWordRep wordRep) [infoTableConstrTag info_table]
 337   where
 338     info_table = infoTable (closureInfoPtr closure_ptr)
 339
 340 infoTable :: CmmExpr -> CmmExpr
 341 -- Takes an info pointer (the first word of a closure)
 342 -- and returns a pointer to the first word of the standard-form
 343 -- info table, excluding the entry-code word (if present)
 344 infoTable info_ptr
 345   | tablesNextToCode = cmmOffsetB info_ptr (- stdInfoTableSizeB)
 346   | otherwise        = cmmOffsetW info_ptr 1    -- Past the entry code pointer
 347
 348 infoTableConstrTag :: CmmExpr -> CmmExpr
 349 -- Takes an info table pointer (from infoTable) and returns the constr tag
 350 -- field of the info table (same as the srt_bitmap field)
 351 infoTableConstrTag = infoTableSrtBitmap
 352
 353 infoTableSrtBitmap :: CmmExpr -> CmmExpr
 354 -- Takes an info table pointer (from infoTable) and returns the srt_bitmap
 355 -- field of the info table
 356 infoTableSrtBitmap info_tbl
 357   = CmmLoad (cmmOffsetB info_tbl stdSrtBitmapOffset) halfWordRep
 358
 359 infoTableClosureType :: CmmExpr -> CmmExpr
 360 -- Takes an info table pointer (from infoTable) and returns the closure type
 361 -- field of the info table.
 362 infoTableClosureType info_tbl
 363   = CmmLoad (cmmOffsetB info_tbl stdClosureTypeOffset) halfWordRep
 364
 365 infoTablePtrs :: CmmExpr -> CmmExpr
 366 infoTablePtrs info_tbl
 367   = CmmLoad (cmmOffsetB info_tbl stdPtrsOffset) halfWordRep
 368
 369 infoTableNonPtrs :: CmmExpr -> CmmExpr
 370 infoTableNonPtrs info_tbl
 371   = CmmLoad (cmmOffsetB info_tbl stdNonPtrsOffset) halfWordRep
 372
 373 funInfoTable :: CmmExpr -> CmmExpr
 374 -- Takes the info pointer of a function,
 375 -- and returns a pointer to the first word of the StgFunInfoExtra struct
 376 -- in the info table.
 377 funInfoTable info_ptr
 378   | tablesNextToCode
 379   = cmmOffsetB info_ptr (- stdInfoTableSizeB - sIZEOF_StgFunInfoExtraRev)
 380   | otherwise
 381   = cmmOffsetW info_ptr (1 + stdInfoTableSizeW)
 382                                 -- Past the entry code pointer
 383
 384 -------------------------------------------------------------------------
 385 --
 386 --      Emit the code for a closure (or return address)
 387 --      and its associated info table
 388 --
 389 -------------------------------------------------------------------------
 390
 391 -- The complication here concerns whether or not we can
 392 -- put the info table next to the code
 393
 394 emitInfoTableAndCode
 395         :: CLabel               -- Label of info table
 396         -> [CmmLit]             -- ...its invariant part
 397         -> [CmmLit]             -- ...and its variant part
 398         -> [LocalReg]           -- ...args
 399         -> [CmmBasicBlock]      -- ...and body
 400         -> Code
 401
 402 emitInfoTableAndCode info_lbl std_info extra_bits args blocks
 403   | tablesNextToCode    -- Reverse the extra_bits; and emit the top-level proc
 404   = emitProc (reverse extra_bits ++ std_info)
 405              entry_lbl args blocks
 406         -- NB: the info_lbl is discarded
 407
 408   | null blocks -- No actual code; only the info table is significant
 409   =             -- Use a zero place-holder in place of the
 410                 -- entry-label in the info table
 411     emitRODataLits info_lbl (zeroCLit : std_info ++ extra_bits)
 412
 413   | otherwise   -- Separately emit info table (with the function entry
 414   =             -- point as first entry) and the entry code
 415     do  { emitDataLits info_lbl (CmmLabel entry_lbl : std_info ++ extra_bits)
 416         ; emitProc [] entry_lbl args blocks }
 417
 418   where
 419         entry_lbl = infoLblToEntryLbl info_lbl
 420
 421 -------------------------------------------------------------------------
 422 --
 423 --      Static reference tables
 424 --
 425 -------------------------------------------------------------------------
 426
 427 -- There is just one SRT for each top level binding; all the nested
 428 -- bindings use sub-sections of this SRT.  The label is passed down to
 429 -- the nested bindings via the monad.
 430
 431 getSRTInfo :: Name -> SRT -> FCode C_SRT
 432 getSRTInfo id NoSRT = return NoC_SRT
 433 getSRTInfo id (SRT off len bmp)
 434   | len > hALF_WORD_SIZE_IN_BITS || bmp == [fromIntegral srt_escape]
 435   = do  { srt_lbl <- getSRTLabel
 436         ; let srt_desc_lbl = mkSRTDescLabel id
 437         ; emitRODataLits srt_desc_lbl
 438                    ( cmmLabelOffW srt_lbl off
 439                    : mkWordCLit (fromIntegral len)
 440                    : map mkWordCLit bmp)
 441         ; return (C_SRT srt_desc_lbl 0 srt_escape) }
 442
 443   | otherwise
 444   = do  { srt_lbl <- getSRTLabel
 445         ; return (C_SRT srt_lbl off (fromIntegral (head bmp))) }
 446                 -- The fromIntegral converts to StgHalfWord
 447
 448 srt_escape = (-1) :: StgHalfWord
 449
 450 srtLabelAndLength :: C_SRT -> CLabel -> (CmmLit, StgHalfWord)
 451 srtLabelAndLength NoC_SRT _
 452   = (zeroCLit, 0)
 453 srtLabelAndLength (C_SRT lbl off bitmap) info_lbl
 454   = (makeRelativeRefTo info_lbl $ cmmLabelOffW lbl off, bitmap)
 455
 456 -------------------------------------------------------------------------
 457 --
 458 --      Position independent code
 459 --
 460 -------------------------------------------------------------------------
 461 -- In order to support position independent code, we mustn't put absolute
 462 -- references into read-only space. Info tables in the tablesNextToCode
 463 -- case must be in .text, which is read-only, so we doctor the CmmLits
 464 -- to use relative offsets instead.
 465
 466 -- Note that this is done even when the -fPIC flag is not specified,
 467 -- as we want to keep binary compatibility between PIC and non-PIC.
 468
 469 makeRelativeRefTo :: CLabel -> CmmLit -> CmmLit
 470
 471 makeRelativeRefTo info_lbl (CmmLabel lbl)
 472   | tablesNextToCode
 473   = CmmLabelDiffOff lbl info_lbl 0
 474 makeRelativeRefTo info_lbl (CmmLabelOff lbl off)
 475   | tablesNextToCode
 476   = CmmLabelDiffOff lbl info_lbl off
 477 makeRelativeRefTo _ lit = lit