ghc/compiler/codeGen/CgInfoTbls.hs

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