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
  49 -------------------------------------------------------------------------
  50 --
  51 --      Generating the info table and code for a closure
  52 --
  53 -------------------------------------------------------------------------
  54
  55 -- Here we make a concrete info table, represented as a list of CmmAddr
  56 -- (it can't be simply a list of Word, because the SRT field is
  57 -- represented by a label+offset expression).
  58
  59 -- With tablesNextToCode, the layout is
  60 --      <reversed variable part>
  61 --      <normal forward StgInfoTable, but without
  62 --              an entry point at the front>
  63 --      <code>
  64 --
  65 -- Without tablesNextToCode, the layout of an info table is
  66 --      <entry label>
  67 --      <normal forward rest of StgInfoTable>
  68 --      <forward variable part>
  69 --
  70 --      See includes/InfoTables.h
  71
  72 emitClosureCodeAndInfoTable :: ClosureInfo -> CmmFormals -> CgStmts -> Code
  73 emitClosureCodeAndInfoTable cl_info args body
  74  = do   { ty_descr_lit <-
  75                 if opt_SccProfilingOn
  76                    then do lit <- mkStringCLit (closureTypeDescr cl_info)
  77                            return (makeRelativeRefTo info_lbl lit)
  78                    else return (mkIntCLit 0)
  79         ; cl_descr_lit <-
  80                 if opt_SccProfilingOn
  81                    then do lit <- mkStringCLit cl_descr_string
  82                            return (makeRelativeRefTo info_lbl lit)
  83                    else return (mkIntCLit 0)
  84         ; let std_info = mkStdInfoTable ty_descr_lit cl_descr_lit
  85                                         cl_type srt_len layout_lit
  86
  87         ; blks <- cgStmtsToBlocks body
  88
  89         ; conName <-
  90              if is_con
  91                 then do cstr <- mkByteStringCLit $ fromJust conIdentity
  92                         return (makeRelativeRefTo info_lbl cstr)
  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),
 114                          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    -> FCode CLabel
 190 emitReturnTarget name stmts
 191   = do  { live_slots <- getLiveStackSlots
 192         ; liveness   <- buildContLiveness name live_slots
 193         ; srt_info   <- getSRTInfo
 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         -> Int                          -- family size
 233         -> FCode (CLabel, SemiTaggingStuff)
 234
 235 emitAlgReturnTarget name branches mb_deflt fam_sz
 236   = do  { blks <- getCgStmts $
 237                     emitSwitch tag_expr branches mb_deflt 0 (fam_sz - 1)
 238                 -- NB: tag_expr is zero-based
 239         ; lbl <- emitReturnTarget name blks
 240         ; return (lbl, Nothing) }
 241                 -- Nothing: the internal branches in the switch don't have
 242                 -- global labels, so we can't use them at the 'call site'
 243   where
 244     tag_expr = getConstrTag (CmmReg nodeReg)
 245
 246 --------------------------------
 247 emitReturnInstr :: Code
 248 emitReturnInstr
 249   = do  { info_amode <- getSequelAmode
 250         ; stmtC (CmmJump (entryCode info_amode) []) }
 251
 252 -------------------------------------------------------------------------
 253 --
 254 --      Generating a standard info table
 255 --
 256 -------------------------------------------------------------------------
 257
 258 -- The standard bits of an info table.  This part of the info table
 259 -- corresponds to the StgInfoTable type defined in InfoTables.h.
 260 --
 261 -- Its shape varies with ticky/profiling/tables next to code etc
 262 -- so we can't use constant offsets from Constants
 263
 264 mkStdInfoTable
 265    :: CmmLit            -- closure type descr (profiling)
 266    -> CmmLit            -- closure descr (profiling)
 267    -> Int               -- closure type
 268    -> StgHalfWord       -- SRT length
 269    -> CmmLit            -- layout field
 270    -> [CmmLit]
 271
 272 mkStdInfoTable type_descr closure_descr cl_type srt_len layout_lit
 273  =      -- Parallel revertible-black hole field
 274     prof_info
 275         -- Ticky info (none at present)
 276         -- Debug info (none at present)
 277  ++ [layout_lit, type_lit]
 278
 279  where
 280     prof_info
 281         | opt_SccProfilingOn = [type_descr, closure_descr]
 282         | otherwise          = []
 283
 284     type_lit = packHalfWordsCLit cl_type srt_len
 285
 286 stdInfoTableSizeW :: WordOff
 287 -- The size of a standard info table varies with profiling/ticky etc,
 288 -- so we can't get it from Constants
 289 -- It must vary in sync with mkStdInfoTable
 290 stdInfoTableSizeW
 291   = size_fixed + size_prof
 292   where
 293     size_fixed = 2      -- layout, type
 294     size_prof | opt_SccProfilingOn = 2
 295               | otherwise          = 0
 296
 297 stdInfoTableSizeB = stdInfoTableSizeW * wORD_SIZE :: ByteOff
 298
 299 stdSrtBitmapOffset :: ByteOff
 300 -- Byte offset of the SRT bitmap half-word which is
 301 -- in the *higher-addressed* part of the type_lit
 302 stdSrtBitmapOffset = stdInfoTableSizeB - hALF_WORD_SIZE
 303
 304 stdClosureTypeOffset :: ByteOff
 305 -- Byte offset of the closure type half-word
 306 stdClosureTypeOffset = stdInfoTableSizeB - wORD_SIZE
 307
 308 stdPtrsOffset, stdNonPtrsOffset :: ByteOff
 309 stdPtrsOffset    = stdInfoTableSizeB - 2*wORD_SIZE
 310 stdNonPtrsOffset = stdInfoTableSizeB - 2*wORD_SIZE + hALF_WORD_SIZE
 311
 312 -------------------------------------------------------------------------
 313 --
 314 --      Accessing fields of an info table
 315 --
 316 -------------------------------------------------------------------------
 317
 318 closureInfoPtr :: CmmExpr -> CmmExpr
 319 -- Takes a closure pointer and returns the info table pointer
 320 closureInfoPtr e = CmmLoad e wordRep
 321
 322 entryCode :: CmmExpr -> CmmExpr
 323 -- Takes an info pointer (the first word of a closure)
 324 -- and returns its entry code
 325 entryCode e | tablesNextToCode = e
 326             | otherwise        = CmmLoad e wordRep
 327
 328 getConstrTag :: CmmExpr -> CmmExpr
 329 -- Takes a closure pointer, and return the *zero-indexed*
 330 -- constructor tag obtained from the info table
 331 -- This lives in the SRT field of the info table
 332 -- (constructors don't need SRTs).
 333 getConstrTag closure_ptr
 334   = CmmMachOp (MO_U_Conv halfWordRep wordRep) [infoTableConstrTag info_table]
 335   where
 336     info_table = infoTable (closureInfoPtr closure_ptr)
 337
 338 infoTable :: CmmExpr -> CmmExpr
 339 -- Takes an info pointer (the first word of a closure)
 340 -- and returns a pointer to the first word of the standard-form
 341 -- info table, excluding the entry-code word (if present)
 342 infoTable info_ptr
 343   | tablesNextToCode = cmmOffsetB info_ptr (- stdInfoTableSizeB)
 344   | otherwise        = cmmOffsetW info_ptr 1    -- Past the entry code pointer
 345
 346 infoTableConstrTag :: CmmExpr -> CmmExpr
 347 -- Takes an info table pointer (from infoTable) and returns the constr tag
 348 -- field of the info table (same as the srt_bitmap field)
 349 infoTableConstrTag = infoTableSrtBitmap
 350
 351 infoTableSrtBitmap :: CmmExpr -> CmmExpr
 352 -- Takes an info table pointer (from infoTable) and returns the srt_bitmap
 353 -- field of the info table
 354 infoTableSrtBitmap info_tbl
 355   = CmmLoad (cmmOffsetB info_tbl stdSrtBitmapOffset) halfWordRep
 356
 357 infoTableClosureType :: CmmExpr -> CmmExpr
 358 -- Takes an info table pointer (from infoTable) and returns the closure type
 359 -- field of the info table.
 360 infoTableClosureType info_tbl
 361   = CmmLoad (cmmOffsetB info_tbl stdClosureTypeOffset) halfWordRep
 362
 363 infoTablePtrs :: CmmExpr -> CmmExpr
 364 infoTablePtrs info_tbl
 365   = CmmLoad (cmmOffsetB info_tbl stdPtrsOffset) halfWordRep
 366
 367 infoTableNonPtrs :: CmmExpr -> CmmExpr
 368 infoTableNonPtrs info_tbl
 369   = CmmLoad (cmmOffsetB info_tbl stdNonPtrsOffset) halfWordRep
 370
 371 funInfoTable :: CmmExpr -> CmmExpr
 372 -- Takes the info pointer of a function,
 373 -- and returns a pointer to the first word of the StgFunInfoExtra struct
 374 -- in the info table.
 375 funInfoTable info_ptr
 376   | tablesNextToCode
 377   = cmmOffsetB info_ptr (- stdInfoTableSizeB - sIZEOF_StgFunInfoExtraRev)
 378   | otherwise
 379   = cmmOffsetW info_ptr (1 + stdInfoTableSizeW)
 380                                 -- Past the entry code pointer
 381
 382 -------------------------------------------------------------------------
 383 --
 384 --      Emit the code for a closure (or return address)
 385 --      and its associated info table
 386 --
 387 -------------------------------------------------------------------------
 388
 389 -- The complication here concerns whether or not we can
 390 -- put the info table next to the code
 391
 392 emitInfoTableAndCode
 393         :: CLabel               -- Label of info table
 394         -> [CmmLit]             -- ...its invariant part
 395         -> [CmmLit]             -- ...and its variant part
 396         -> CmmFormals           -- ...args
 397         -> [CmmBasicBlock]      -- ...and body
 398         -> Code
 399
 400 emitInfoTableAndCode info_lbl std_info extra_bits args blocks
 401   | tablesNextToCode    -- Reverse the extra_bits; and emit the top-level proc
 402   = emitProc (reverse extra_bits ++ std_info)
 403              entry_lbl args blocks
 404         -- NB: the info_lbl is discarded
 405
 406   | null blocks -- No actual code; only the info table is significant
 407   =             -- Use a zero place-holder in place of the
 408                 -- entry-label in the info table
 409     emitRODataLits info_lbl (zeroCLit : std_info ++ extra_bits)
 410
 411   | otherwise   -- Separately emit info table (with the function entry
 412   =             -- point as first entry) and the entry code
 413     do  { emitDataLits info_lbl (CmmLabel entry_lbl : std_info ++ extra_bits)
 414         ; emitProc [] entry_lbl args blocks }
 415
 416   where
 417         entry_lbl = infoLblToEntryLbl info_lbl
 418
 419 -------------------------------------------------------------------------
 420 --
 421 --      Static reference tables
 422 --
 423 -------------------------------------------------------------------------
 424
 425 srtLabelAndLength :: C_SRT -> CLabel -> (CmmLit, StgHalfWord)
 426 srtLabelAndLength NoC_SRT _
 427   = (zeroCLit, 0)
 428 srtLabelAndLength (C_SRT lbl off bitmap) info_lbl
 429   = (makeRelativeRefTo info_lbl $ cmmLabelOffW lbl off, bitmap)
 430
 431 -------------------------------------------------------------------------
 432 --
 433 --      Position independent code
 434 --
 435 -------------------------------------------------------------------------
 436 -- In order to support position independent code, we mustn't put absolute
 437 -- references into read-only space. Info tables in the tablesNextToCode
 438 -- case must be in .text, which is read-only, so we doctor the CmmLits
 439 -- to use relative offsets instead.
 440
 441 -- Note that this is done even when the -fPIC flag is not specified,
 442 -- as we want to keep binary compatibility between PIC and non-PIC.
 443
 444 makeRelativeRefTo :: CLabel -> CmmLit -> CmmLit
 445
 446 makeRelativeRefTo info_lbl (CmmLabel lbl)
 447   | tablesNextToCode
 448   = CmmLabelDiffOff lbl info_lbl 0
 449 makeRelativeRefTo info_lbl (CmmLabelOff lbl off)
 450   | tablesNextToCode
 451   = CmmLabelDiffOff lbl info_lbl off
 452 makeRelativeRefTo _ lit = lit