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
  47 import Maybes
  48 import Constants
  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 -> [LocalReg] -> 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         ; 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    -> SRT
 191    -> FCode CLabel
 192 emitReturnTarget name stmts srt
 193   = do  { live_slots <- getLiveStackSlots
 194         ; liveness   <- buildContLiveness name live_slots
 195         ; srt_info   <- getSRTInfo name srt
 196
 197         ; let
 198               cl_type | isBigLiveness liveness = rET_BIG
 199                       | otherwise              = rET_SMALL
 200
 201               (std_info, extra_bits) =
 202                    mkRetInfoTable info_lbl liveness srt_info cl_type
 203
 204         ; blks <- cgStmtsToBlocks stmts
 205         ; emitInfoTableAndCode info_lbl std_info extra_bits args blks
 206         ; return info_lbl }
 207   where
 208     args      = {- trace "emitReturnTarget: missing args" -} []
 209     uniq      = getUnique name
 210     info_lbl  = mkReturnInfoLabel uniq
 211
 212
 213 mkRetInfoTable
 214   :: CLabel             -- info label
 215   -> Liveness           -- liveness
 216   -> C_SRT              -- SRT Info
 217   -> Int                -- type (eg. rET_SMALL)
 218   -> ([CmmLit],[CmmLit])
 219 mkRetInfoTable info_lbl liveness srt_info cl_type
 220   =  (std_info, srt_slot)
 221   where
 222         (srt_label, srt_len) = srtLabelAndLength srt_info info_lbl
 223
 224         srt_slot | needsSRT srt_info = [srt_label]
 225                  | otherwise         = []
 226
 227         liveness_lit = makeRelativeRefTo info_lbl $ mkLivenessCLit liveness
 228         std_info = mkStdInfoTable zeroCLit zeroCLit cl_type srt_len liveness_lit
 229
 230 emitAlgReturnTarget
 231         :: Name                         -- Just for its unique
 232         -> [(ConTagZ, CgStmts)]         -- Tagged branches
 233         -> Maybe CgStmts                -- Default branch (if any)
 234         -> SRT                          -- Continuation's SRT
 235         -> Int                          -- family size
 236         -> FCode (CLabel, SemiTaggingStuff)
 237
 238 emitAlgReturnTarget name branches mb_deflt srt fam_sz
 239   = do  { blks <- getCgStmts $
 240                     emitSwitch tag_expr branches mb_deflt 0 (fam_sz - 1)
 241                 -- NB: tag_expr is zero-based
 242         ; lbl <- emitReturnTarget name blks srt
 243         ; return (lbl, Nothing) }
 244                 -- Nothing: the internal branches in the switch don't have
 245                 -- global labels, so we can't use them at the 'call site'
 246   where
 247     tag_expr = getConstrTag (CmmReg nodeReg)
 248
 249 --------------------------------
 250 emitReturnInstr :: Code
 251 emitReturnInstr
 252   = do  { info_amode <- getSequelAmode
 253         ; stmtC (CmmJump (entryCode info_amode) []) }
 254
 255 -------------------------------------------------------------------------
 256 --
 257 --      Generating a standard info table
 258 --
 259 -------------------------------------------------------------------------
 260
 261 -- The standard bits of an info table.  This part of the info table
 262 -- corresponds to the StgInfoTable type defined in InfoTables.h.
 263 --
 264 -- Its shape varies with ticky/profiling/tables next to code etc
 265 -- so we can't use constant offsets from Constants
 266
 267 mkStdInfoTable
 268    :: CmmLit            -- closure type descr (profiling)
 269    -> CmmLit            -- closure descr (profiling)
 270    -> Int               -- closure type
 271    -> StgHalfWord       -- SRT length
 272    -> CmmLit            -- layout field
 273    -> [CmmLit]
 274
 275 mkStdInfoTable type_descr closure_descr cl_type srt_len layout_lit
 276  =      -- Parallel revertible-black hole field
 277     prof_info
 278         -- Ticky info (none at present)
 279         -- Debug info (none at present)
 280  ++ [layout_lit, type_lit]
 281
 282  where
 283     prof_info
 284         | opt_SccProfilingOn = [type_descr, closure_descr]
 285         | otherwise          = []
 286
 287     type_lit = packHalfWordsCLit cl_type srt_len
 288
 289 stdInfoTableSizeW :: WordOff
 290 -- The size of a standard info table varies with profiling/ticky etc,
 291 -- so we can't get it from Constants
 292 -- It must vary in sync with mkStdInfoTable
 293 stdInfoTableSizeW
 294   = size_fixed + size_prof
 295   where
 296     size_fixed = 2      -- layout, type
 297     size_prof | opt_SccProfilingOn = 2
 298               | otherwise          = 0
 299
 300 stdInfoTableSizeB = stdInfoTableSizeW * wORD_SIZE :: ByteOff
 301
 302 stdSrtBitmapOffset :: ByteOff
 303 -- Byte offset of the SRT bitmap half-word which is
 304 -- in the *higher-addressed* part of the type_lit
 305 stdSrtBitmapOffset = stdInfoTableSizeB - hALF_WORD_SIZE
 306
 307 stdClosureTypeOffset :: ByteOff
 308 -- Byte offset of the closure type half-word
 309 stdClosureTypeOffset = stdInfoTableSizeB - wORD_SIZE
 310
 311 stdPtrsOffset, stdNonPtrsOffset :: ByteOff
 312 stdPtrsOffset    = stdInfoTableSizeB - 2*wORD_SIZE
 313 stdNonPtrsOffset = stdInfoTableSizeB - 2*wORD_SIZE + hALF_WORD_SIZE
 314
 315 -------------------------------------------------------------------------
 316 --
 317 --      Accessing fields of an info table
 318 --
 319 -------------------------------------------------------------------------
 320
 321 closureInfoPtr :: CmmExpr -> CmmExpr
 322 -- Takes a closure pointer and returns the info table pointer
 323 closureInfoPtr e = CmmLoad e wordRep
 324
 325 entryCode :: CmmExpr -> CmmExpr
 326 -- Takes an info pointer (the first word of a closure)
 327 -- and returns its entry code
 328 entryCode e | tablesNextToCode = e
 329             | otherwise        = CmmLoad e wordRep
 330
 331 getConstrTag :: CmmExpr -> CmmExpr
 332 -- Takes a closure pointer, and return the *zero-indexed*
 333 -- constructor tag obtained from the info table
 334 -- This lives in the SRT field of the info table
 335 -- (constructors don't need SRTs).
 336 getConstrTag closure_ptr
 337   = CmmMachOp (MO_U_Conv halfWordRep wordRep) [infoTableConstrTag info_table]
 338   where
 339     info_table = infoTable (closureInfoPtr closure_ptr)
 340
 341 infoTable :: CmmExpr -> CmmExpr
 342 -- Takes an info pointer (the first word of a closure)
 343 -- and returns a pointer to the first word of the standard-form
 344 -- info table, excluding the entry-code word (if present)
 345 infoTable info_ptr
 346   | tablesNextToCode = cmmOffsetB info_ptr (- stdInfoTableSizeB)
 347   | otherwise        = cmmOffsetW info_ptr 1    -- Past the entry code pointer
 348
 349 infoTableConstrTag :: CmmExpr -> CmmExpr
 350 -- Takes an info table pointer (from infoTable) and returns the constr tag
 351 -- field of the info table (same as the srt_bitmap field)
 352 infoTableConstrTag = infoTableSrtBitmap
 353
 354 infoTableSrtBitmap :: CmmExpr -> CmmExpr
 355 -- Takes an info table pointer (from infoTable) and returns the srt_bitmap
 356 -- field of the info table
 357 infoTableSrtBitmap info_tbl
 358   = CmmLoad (cmmOffsetB info_tbl stdSrtBitmapOffset) halfWordRep
 359
 360 infoTableClosureType :: CmmExpr -> CmmExpr
 361 -- Takes an info table pointer (from infoTable) and returns the closure type
 362 -- field of the info table.
 363 infoTableClosureType info_tbl
 364   = CmmLoad (cmmOffsetB info_tbl stdClosureTypeOffset) halfWordRep
 365
 366 infoTablePtrs :: CmmExpr -> CmmExpr
 367 infoTablePtrs info_tbl
 368   = CmmLoad (cmmOffsetB info_tbl stdPtrsOffset) halfWordRep
 369
 370 infoTableNonPtrs :: CmmExpr -> CmmExpr
 371 infoTableNonPtrs info_tbl
 372   = CmmLoad (cmmOffsetB info_tbl stdNonPtrsOffset) halfWordRep
 373
 374 funInfoTable :: CmmExpr -> CmmExpr
 375 -- Takes the info pointer of a function,
 376 -- and returns a pointer to the first word of the StgFunInfoExtra struct
 377 -- in the info table.
 378 funInfoTable info_ptr
 379   | tablesNextToCode
 380   = cmmOffsetB info_ptr (- stdInfoTableSizeB - sIZEOF_StgFunInfoExtraRev)
 381   | otherwise
 382   = cmmOffsetW info_ptr (1 + stdInfoTableSizeW)
 383                                 -- Past the entry code pointer
 384
 385 -------------------------------------------------------------------------
 386 --
 387 --      Emit the code for a closure (or return address)
 388 --      and its associated info table
 389 --
 390 -------------------------------------------------------------------------
 391
 392 -- The complication here concerns whether or not we can
 393 -- put the info table next to the code
 394
 395 emitInfoTableAndCode
 396         :: CLabel               -- Label of info table
 397         -> [CmmLit]             -- ...its invariant part
 398         -> [CmmLit]             -- ...and its variant part
 399         -> [LocalReg]           -- ...args
 400         -> [CmmBasicBlock]      -- ...and body
 401         -> Code
 402
 403 emitInfoTableAndCode info_lbl std_info extra_bits args blocks
 404   | tablesNextToCode    -- Reverse the extra_bits; and emit the top-level proc
 405   = emitProc (reverse extra_bits ++ std_info)
 406              entry_lbl args blocks
 407         -- NB: the info_lbl is discarded
 408
 409   | null blocks -- No actual code; only the info table is significant
 410   =             -- Use a zero place-holder in place of the
 411                 -- entry-label in the info table
 412     emitRODataLits info_lbl (zeroCLit : std_info ++ extra_bits)
 413
 414   | otherwise   -- Separately emit info table (with the function entry
 415   =             -- point as first entry) and the entry code
 416     do  { emitDataLits info_lbl (CmmLabel entry_lbl : std_info ++ extra_bits)
 417         ; emitProc [] entry_lbl args blocks }
 418
 419   where
 420         entry_lbl = infoLblToEntryLbl info_lbl
 421
 422 -------------------------------------------------------------------------
 423 --
 424 --      Static reference tables
 425 --
 426 -------------------------------------------------------------------------
 427
 428 -- There is just one SRT for each top level binding; all the nested
 429 -- bindings use sub-sections of this SRT.  The label is passed down to
 430 -- the nested bindings via the monad.
 431
 432 getSRTInfo :: Name -> SRT -> FCode C_SRT
 433 getSRTInfo id NoSRT = return NoC_SRT
 434 getSRTInfo id (SRT off len bmp)
 435   | len > hALF_WORD_SIZE_IN_BITS || bmp == [fromIntegral srt_escape]
 436   = do  { srt_lbl <- getSRTLabel
 437         ; let srt_desc_lbl = mkSRTDescLabel id
 438         ; emitRODataLits srt_desc_lbl
 439                    ( cmmLabelOffW srt_lbl off
 440                    : mkWordCLit (fromIntegral len)
 441                    : map mkWordCLit bmp)
 442         ; return (C_SRT srt_desc_lbl 0 srt_escape) }
 443
 444   | otherwise
 445   = do  { srt_lbl <- getSRTLabel
 446         ; return (C_SRT srt_lbl off (fromIntegral (head bmp))) }
 447                 -- The fromIntegral converts to StgHalfWord
 448
 449 srt_escape = (-1) :: StgHalfWord
 450
 451 srtLabelAndLength :: C_SRT -> CLabel -> (CmmLit, StgHalfWord)
 452 srtLabelAndLength NoC_SRT _
 453   = (zeroCLit, 0)
 454 srtLabelAndLength (C_SRT lbl off bitmap) info_lbl
 455   = (makeRelativeRefTo info_lbl $ cmmLabelOffW lbl off, bitmap)
 456
 457 -------------------------------------------------------------------------
 458 --
 459 --      Position independent code
 460 --
 461 -------------------------------------------------------------------------
 462 -- In order to support position independent code, we mustn't put absolute
 463 -- references into read-only space. Info tables in the tablesNextToCode
 464 -- case must be in .text, which is read-only, so we doctor the CmmLits
 465 -- to use relative offsets instead.
 466
 467 -- Note that this is done even when the -fPIC flag is not specified,
 468 -- as we want to keep binary compatibility between PIC and non-PIC.
 469
 470 makeRelativeRefTo :: CLabel -> CmmLit -> CmmLit
 471
 472 makeRelativeRefTo info_lbl (CmmLabel lbl)
 473   | tablesNextToCode
 474   = CmmLabelDiffOff lbl info_lbl 0
 475 makeRelativeRefTo info_lbl (CmmLabelOff lbl off)
 476   | tablesNextToCode
 477   = CmmLabelDiffOff lbl info_lbl off
 478 makeRelativeRefTo _ lit = lit