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