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