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         emitReturnTarget, emitAlgReturnTarget,
  14         emitReturnInstr,
  15         mkRetInfoTable,
  16         mkStdInfoTable,
  17         stdInfoTableSizeB,
  18         mkFunGenInfoExtraBits,
  19         entryCode, closureInfoPtr,
  20         getConstrTag,
  21         infoTable, infoTableClosureType,
  22         infoTablePtrs, infoTableNonPtrs,
  23         funInfoTable, makeRelativeRefTo
  24   ) where
  25
  26
  27 #include "HsVersions.h"
  28
  29 import ClosureInfo
  30 import SMRep
  31 import CgBindery
  32 import CgCallConv
  33 import CgUtils
  34 import CgMonad
  35
  36 import CmmUtils
  37 import Cmm
  38 import MachOp
  39 import CLabel
  40 import StgSyn
  41 import Name
  42 import DataCon
  43 import Unique
  44 import StaticFlags
  45
  46 import Maybes
  47 import Constants
  48 import Panic
  49
  50 -------------------------------------------------------------------------
  51 --
  52 --      Generating the info table and code for a closure
  53 --
  54 -------------------------------------------------------------------------
  55
  56 -- Here we make a concrete info table, represented as a list of CmmAddr
  57 -- (it can't be simply a list of Word, because the SRT field is
  58 -- represented by a label+offset expression).
  59
  60 -- With tablesNextToCode, the layout is
  61 --      <reversed variable part>
  62 --      <normal forward StgInfoTable, but without
  63 --              an entry point at the front>
  64 --      <code>
  65 --
  66 -- Without tablesNextToCode, the layout of an info table is
  67 --      <entry label>
  68 --      <normal forward rest of StgInfoTable>
  69 --      <forward variable part>
  70 --
  71 --      See includes/InfoTables.h
  72
  73 emitClosureCodeAndInfoTable :: ClosureInfo -> CmmFormals -> CgStmts -> Code
  74 emitClosureCodeAndInfoTable cl_info args body
  75  = do   { ty_descr_lit <-
  76                 if opt_SccProfilingOn
  77                    then do lit <- mkStringCLit (closureTypeDescr cl_info)
  78                            return (makeRelativeRefTo info_lbl lit)
  79                    else return (mkIntCLit 0)
  80         ; cl_descr_lit <-
  81                 if opt_SccProfilingOn
  82                    then do lit <- mkStringCLit cl_descr_string
  83                            return (makeRelativeRefTo info_lbl lit)
  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 <- mkByteStringCLit $ fromJust conIdentity
  93                         return (makeRelativeRefTo info_lbl cstr)
  94                 else return (mkIntCLit 0)
  95
  96         ; panic "emitClosureCodeAndInfoTable" } --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),
 115                          Just $ dataConIdentity con)
 116
 117             Nothing  -> -- Not a constructor
 118                         let (label, len) = srtLabelAndLength srt info_lbl
 119                         in (label, len, Nothing)
 120
 121     ptrs       = closurePtrsSize cl_info
 122     nptrs      = size - ptrs
 123     size       = closureNonHdrSize cl_info
 124     layout_lit = packHalfWordsCLit ptrs nptrs
 125
 126     extra_bits conName
 127         | is_fun    = fun_extra_bits
 128         | is_con    = [conName]
 129         | needs_srt = [srt_label]
 130         | otherwise = []
 131
 132     maybe_fun_stuff = closureFunInfo cl_info
 133     is_fun = isJust maybe_fun_stuff
 134     (Just (arity, arg_descr)) = maybe_fun_stuff
 135
 136     fun_extra_bits
 137         | ArgGen liveness <- arg_descr
 138         = [ fun_amode,
 139             srt_label,
 140             makeRelativeRefTo info_lbl $ mkLivenessCLit liveness,
 141             slow_entry ]
 142         | needs_srt = [fun_amode, srt_label]
 143         | otherwise = [fun_amode]
 144
 145     slow_entry = makeRelativeRefTo info_lbl (CmmLabel slow_entry_label)
 146     slow_entry_label = mkSlowEntryLabel (closureName cl_info)
 147
 148     fun_amode = packHalfWordsCLit fun_type arity
 149     fun_type  = argDescrType arg_descr
 150
 151 -- We keep the *zero-indexed* tag in the srt_len field of the info
 152 -- table of a data constructor.
 153 dataConTagZ :: DataCon -> ConTagZ
 154 dataConTagZ con = dataConTag con - fIRST_TAG
 155
 156 -- A low-level way to generate the variable part of a fun-style info table.
 157 -- (must match fun_extra_bits above).  Used by the C-- parser.
 158 mkFunGenInfoExtraBits :: Int -> Int -> CmmLit -> CmmLit -> CmmLit -> [CmmLit]
 159 mkFunGenInfoExtraBits fun_type arity srt_label liveness slow_entry
 160   = [ packHalfWordsCLit fun_type arity,
 161       srt_label,
 162       liveness,
 163       slow_entry ]
 164
 165 -------------------------------------------------------------------------
 166 --
 167 --      Generating the info table and code for a return point
 168 --
 169 -------------------------------------------------------------------------
 170
 171 --      Here's the layout of a return-point info table
 172 --
 173 -- Tables next to code:
 174 --
 175 --                      <srt slot>
 176 --                      <standard info table>
 177 --      ret-addr -->    <entry code (if any)>
 178 --
 179 -- Not tables-next-to-code:
 180 --
 181 --      ret-addr -->    <ptr to entry code>
 182 --                      <standard info table>
 183 --                      <srt slot>
 184 --
 185 --  * The SRT slot is only there is SRT info to record
 186
 187 emitReturnTarget
 188    :: Name
 189    -> CgStmts                   -- The direct-return code (if any)
 190    -> FCode CLabel
 191 emitReturnTarget name stmts
 192   = do  { live_slots <- getLiveStackSlots
 193         ; liveness   <- buildContLiveness name live_slots
 194         ; srt_info   <- getSRTInfo
 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         ; panic "emitReturnTarget" --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   -> StgHalfWord        -- 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         -> Int                          -- family size
 234         -> FCode (CLabel, SemiTaggingStuff)
 235
 236 emitAlgReturnTarget name branches mb_deflt 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
 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    -> StgHalfWord       -- 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         -> CmmInfo              -- ...the info table
 396         -> CmmFormals           -- ...args
 397         -> [CmmBasicBlock]      -- ...and body
 398         -> Code
 399
 400 emitInfoTableAndCode info_lbl info args blocks
 401   = emitProc info entry_lbl args blocks
 402   where
 403         entry_lbl = infoLblToEntryLbl info_lbl
 404
 405 {-
 406 emitInfoTableAndCode
 407         :: CLabel               -- Label of info table
 408         -> [CmmLit]             -- ...its invariant part
 409         -> [CmmLit]             -- ...and its variant part
 410         -> CmmFormals           -- ...args
 411         -> [CmmBasicBlock]      -- ...and body
 412         -> Code
 413
 414 emitInfoTableAndCode info_lbl std_info extra_bits args blocks
 415   | tablesNextToCode    -- Reverse the extra_bits; and emit the top-level proc
 416   = emitProc (reverse extra_bits ++ std_info)
 417              entry_lbl args blocks
 418         -- NB: the info_lbl is discarded
 419
 420   | null blocks -- No actual code; only the info table is significant
 421   =             -- Use a zero place-holder in place of the
 422                 -- entry-label in the info table
 423     emitRODataLits info_lbl (zeroCLit : std_info ++ extra_bits)
 424
 425   | otherwise   -- Separately emit info table (with the function entry
 426   =             -- point as first entry) and the entry code
 427     do  { emitDataLits info_lbl (CmmLabel entry_lbl : std_info ++ extra_bits)
 428         ; emitProc [] entry_lbl args blocks }
 429
 430   where
 431         entry_lbl = infoLblToEntryLbl info_lbl
 432 -}
 433
 434 -------------------------------------------------------------------------
 435 --
 436 --      Static reference tables
 437 --
 438 -------------------------------------------------------------------------
 439
 440 srtLabelAndLength :: C_SRT -> CLabel -> (CmmLit, StgHalfWord)
 441 srtLabelAndLength NoC_SRT _
 442   = (zeroCLit, 0)
 443 srtLabelAndLength (C_SRT lbl off bitmap) info_lbl
 444   = (makeRelativeRefTo info_lbl $ cmmLabelOffW lbl off, bitmap)
 445
 446 -------------------------------------------------------------------------
 447 --
 448 --      Position independent code
 449 --
 450 -------------------------------------------------------------------------
 451 -- In order to support position independent code, we mustn't put absolute
 452 -- references into read-only space. Info tables in the tablesNextToCode
 453 -- case must be in .text, which is read-only, so we doctor the CmmLits
 454 -- to use relative offsets instead.
 455
 456 -- Note that this is done even when the -fPIC flag is not specified,
 457 -- as we want to keep binary compatibility between PIC and non-PIC.
 458
 459 makeRelativeRefTo :: CLabel -> CmmLit -> CmmLit
 460
 461 makeRelativeRefTo info_lbl (CmmLabel lbl)
 462   | tablesNextToCode
 463   = CmmLabelDiffOff lbl info_lbl 0
 464 makeRelativeRefTo info_lbl (CmmLabelOff lbl off)
 465   | tablesNextToCode
 466   = CmmLabelDiffOff lbl info_lbl off
 467 makeRelativeRefTo _ lit = lit