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         stdInfoTableSizeB,
  16         entryCode, closureInfoPtr,
  17         getConstrTag,
  18         infoTable, infoTableClosureType,
  19         infoTablePtrs, infoTableNonPtrs,
  20         funInfoTable, makeRelativeRefTo
  21   ) where
  22
  23
  24 #include "HsVersions.h"
  25
  26 import ClosureInfo
  27 import SMRep
  28 import CgBindery
  29 import CgCallConv
  30 import CgUtils
  31 import CgMonad
  32
  33 import CmmUtils
  34 import Cmm
  35 import MachOp
  36 import CLabel
  37 import StgSyn
  38 import Name
  39 import DataCon
  40 import Unique
  41 import StaticFlags
  42
  43 import Maybes
  44 import Constants
  45 import Panic
  46 import Util
  47 import Outputable
  48
  49 -------------------------------------------------------------------------
  50 --
  51 --      Generating the info table and code for a closure
  52 --
  53 -------------------------------------------------------------------------
  54
  55 -- Here we make an info table of type 'CmmInfo'.  The concrete
  56 -- representation as a list of 'CmmAddr' is handled later
  57 -- in the pipeline by 'cmmToRawCmm'.
  58
  59 emitClosureCodeAndInfoTable :: ClosureInfo -> CmmFormals -> CgStmts -> Code
  60 emitClosureCodeAndInfoTable cl_info args body
  61  = do   { blks <- cgStmtsToBlocks body
  62         ; info <- mkCmmInfo cl_info
  63         ; emitInfoTableAndCode info_lbl info args blks }
  64   where
  65     info_lbl  = infoTableLabelFromCI cl_info
  66
  67 -- We keep the *zero-indexed* tag in the srt_len field of the info
  68 -- table of a data constructor.
  69 dataConTagZ :: DataCon -> ConTagZ
  70 dataConTagZ con = dataConTag con - fIRST_TAG
  71
  72 -- Convert from 'ClosureInfo' to 'CmmInfo'.
  73 -- Not used for return points.  (The 'smRepClosureTypeInt' call would panic.)
  74 mkCmmInfo :: ClosureInfo -> FCode CmmInfo
  75 mkCmmInfo cl_info = do
  76   prof <-
  77       if opt_SccProfilingOn
  78       then do ty_descr_lit <- mkStringCLit (closureTypeDescr cl_info)
  79               cl_descr_lit <- mkStringCLit (closureValDescr cl_info)
  80               return $ ProfilingInfo
  81                          (makeRelativeRefTo info_lbl ty_descr_lit)
  82                          (makeRelativeRefTo info_lbl cl_descr_lit)
  83       else return $ ProfilingInfo (mkIntCLit 0) (mkIntCLit 0)
  84
  85   case cl_info of
  86     ConInfo { closureCon = con } -> do
  87        cstr <- mkByteStringCLit $ dataConIdentity con
  88        let conName = makeRelativeRefTo info_lbl cstr
  89            info = ConstrInfo (ptrs, nptrs)
  90                              (fromIntegral (dataConTagZ con))
  91                              conName
  92        return $ CmmInfo prof gc_target cl_type info
  93
  94     ClosureInfo { closureName   = name,
  95                   closureLFInfo = lf_info,
  96                   closureSRT    = srt } ->
  97        return $ CmmInfo prof gc_target cl_type info
  98        where
  99          info =
 100              case lf_info of
 101                LFReEntrant _ arity _ arg_descr ->
 102                    FunInfo (ptrs, nptrs)
 103                            srt
 104                            (argDescrType arg_descr)
 105                            (fromIntegral arity)
 106                            arg_descr
 107                            (CmmLabel (mkSlowEntryLabel name))
 108                LFThunk _ _ _ (SelectorThunk offset) _ ->
 109                    ThunkSelectorInfo (fromIntegral offset) srt
 110                LFThunk _ _ _ _ _ ->
 111                    ThunkInfo (ptrs, nptrs) srt
 112                _ -> panic "unexpected lambda form in mkCmmInfo"
 113   where
 114     info_lbl = infoTableLabelFromCI cl_info
 115
 116     cl_type  = smRepClosureTypeInt (closureSMRep cl_info)
 117
 118     ptrs     = fromIntegral $ closurePtrsSize cl_info
 119     size     = fromIntegral $ closureNonHdrSize cl_info
 120     nptrs    = size - ptrs
 121
 122     -- The gc_target is to inform the CPS pass when it inserts a stack check.
 123     -- Since that pass isn't used yet we'll punt for now.
 124     -- When the CPS pass is fully integrated, this should
 125     -- be replaced by the label that any heap check jumped to,
 126     -- so that branch can be shared by both the heap (from codeGen)
 127     -- and stack checks (from the CPS pass).
 128     gc_target = panic "TODO: gc_target"
 129
 130 -------------------------------------------------------------------------
 131 --
 132 --      Generating the info table and code for a return point
 133 --
 134 -------------------------------------------------------------------------
 135
 136 -- The concrete representation as a list of 'CmmAddr' is handled later
 137 -- in the pipeline by 'cmmToRawCmm'.
 138
 139 emitReturnTarget
 140    :: Name
 141    -> CgStmts                   -- The direct-return code (if any)
 142    -> FCode CLabel
 143 emitReturnTarget name stmts
 144   = do  { srt_info   <- getSRTInfo
 145         ; blks <- cgStmtsToBlocks stmts
 146         ; frame <- mkStackLayout
 147         ; let info = CmmInfo
 148                        (ProfilingInfo zeroCLit zeroCLit)
 149                        gc_target
 150                        rET_SMALL -- cmmToRawCmm may convert it to rET_BIG
 151                        (ContInfo frame srt_info)
 152         ; emitInfoTableAndCode info_lbl info args blks
 153         ; return info_lbl }
 154   where
 155     args      = {- trace "emitReturnTarget: missing args" -} []
 156     uniq      = getUnique name
 157     info_lbl  = mkReturnInfoLabel uniq
 158
 159     -- The gc_target is to inform the CPS pass when it inserts a stack check.
 160     -- Since that pass isn't used yet we'll punt for now.
 161     -- When the CPS pass is fully integrated, this should
 162     -- be replaced by the label that any heap check jumped to,
 163     -- so that branch can be shared by both the heap (from codeGen)
 164     -- and stack checks (from the CPS pass).
 165     gc_target = panic "TODO: gc_target"
 166
 167
 168 -- Build stack layout information from the state of the 'FCode' monad.
 169 -- Should go away once 'codeGen' starts using the CPS conversion
 170 -- pass to handle the stack.  Until then, this is really just
 171 -- here to convert from the 'codeGen' representation of the stack
 172 -- to the 'CmmInfo' representation of the stack.
 173 --
 174 -- See 'CmmInfo.mkLiveness' for where this is converted to a bitmap.
 175
 176 {-
 177 This seems to be a very error prone part of the code.
 178 It is surprisingly prone to off-by-one errors, because
 179 it converts between offset form (codeGen) and list form (CmmInfo).
 180 Thus a bit of explanation is in order.
 181 Fortunately, this code should go away once the code generator
 182 starts using the CPS conversion pass to handle the stack.
 183
 184 The stack looks like this:
 185
 186              |             |
 187              |-------------|
 188 frame_sp --> | return addr |
 189              |-------------|
 190              | dead slot   |
 191              |-------------|
 192              | live ptr b  |
 193              |-------------|
 194              | live ptr a  |
 195              |-------------|
 196 real_sp  --> | return addr |
 197              +-------------+
 198
 199 Both 'frame_sp' and 'real_sp' are measured downwards
 200 (i.e. larger frame_sp means smaller memory address).
 201
 202 For that frame we want a result like: [Just a, Just b, Nothing]
 203 Note that the 'head' of the list is the top
 204 of the stack, and that the return address
 205 is not present in the list (it is always assumed).
 206 -}
 207 mkStackLayout :: FCode [Maybe LocalReg]
 208 mkStackLayout = do
 209   StackUsage { realSp = real_sp,
 210                frameSp = frame_sp } <- getStkUsage
 211   binds <- getLiveStackBindings
 212   let frame_size = real_sp - frame_sp - retAddrSizeW
 213       rel_binds = reverse $ sortWith fst
 214                     [(offset - frame_sp - retAddrSizeW, b)
 215                     | (offset, b) <- binds]
 216
 217   WARN( not (all (\bind -> fst bind >= 0) rel_binds),
 218         ppr binds $$ ppr rel_binds $$
 219         ppr frame_size $$ ppr real_sp $$ ppr frame_sp )
 220     return $ stack_layout rel_binds frame_size
 221
 222 stack_layout :: [(VirtualSpOffset, CgIdInfo)]
 223              -> WordOff
 224              -> [Maybe LocalReg]
 225 stack_layout [] sizeW = replicate sizeW Nothing
 226 stack_layout ((off, bind):binds) sizeW | off == sizeW - 1 =
 227   (Just stack_bind) : (stack_layout binds (sizeW - rep_size))
 228   where
 229     rep_size = cgRepSizeW (cgIdInfoArgRep bind)
 230     stack_bind = LocalReg unique machRep kind
 231     unique = getUnique (cgIdInfoId bind)
 232     machRep = argMachRep (cgIdInfoArgRep bind)
 233     kind = if isFollowableArg (cgIdInfoArgRep bind)
 234            then KindPtr
 235            else KindNonPtr
 236 stack_layout binds@((off, _):_) sizeW | otherwise =
 237   Nothing : (stack_layout binds (sizeW - 1))
 238
 239 {- Another way to write the function that might be less error prone (untested)
 240 stack_layout offsets sizeW = result
 241   where
 242     y = map (flip lookup offsets) [0..]
 243       -- offsets -> nothing and just (each slot is one word)
 244     x = take sizeW y -- set the frame size
 245     z = clip x -- account for multi-word slots
 246     result = map mk_reg z
 247
 248     clip [] = []
 249     clip list@(x : _) = x : clip (drop count list)
 250       ASSERT(all isNothing (tail (take count list)))
 251
 252     count Nothing = 1
 253     count (Just x) = cgRepSizeW (cgIdInfoArgRep x)
 254
 255     mk_reg Nothing = Nothing
 256     mk_reg (Just x) = LocalReg unique machRep kind
 257       where
 258         unique = getUnique (cgIdInfoId x)
 259         machRep = argMachrep (cgIdInfoArgRep bind)
 260         kind = if isFollowableArg (cgIdInfoArgRep bind)
 261            then KindPtr
 262            else KindNonPtr
 263 -}
 264
 265 emitAlgReturnTarget
 266         :: Name                         -- Just for its unique
 267         -> [(ConTagZ, CgStmts)]         -- Tagged branches
 268         -> Maybe CgStmts                -- Default branch (if any)
 269         -> Int                          -- family size
 270         -> FCode (CLabel, SemiTaggingStuff)
 271
 272 emitAlgReturnTarget name branches mb_deflt fam_sz
 273   = do  { blks <- getCgStmts $
 274                     emitSwitch tag_expr branches mb_deflt 0 (fam_sz - 1)
 275                 -- NB: tag_expr is zero-based
 276         ; lbl <- emitReturnTarget name blks
 277         ; return (lbl, Nothing) }
 278                 -- Nothing: the internal branches in the switch don't have
 279                 -- global labels, so we can't use them at the 'call site'
 280   where
 281     tag_expr = getConstrTag (CmmReg nodeReg)
 282
 283 --------------------------------
 284 emitReturnInstr :: Code
 285 emitReturnInstr
 286   = do  { info_amode <- getSequelAmode
 287         ; stmtC (CmmJump (entryCode info_amode) []) }
 288
 289 -----------------------------------------------------------------------------
 290 --
 291 --      Info table offsets
 292 --
 293 -----------------------------------------------------------------------------
 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         -> CmmInfo              -- ...the info table
 404         -> CmmFormals           -- ...args
 405         -> [CmmBasicBlock]      -- ...and body
 406         -> Code
 407
 408 emitInfoTableAndCode info_lbl info args blocks
 409   = emitProc info entry_lbl args blocks
 410   where
 411         entry_lbl = infoLblToEntryLbl info_lbl
 412
 413 -------------------------------------------------------------------------
 414 --
 415 --      Static reference tables
 416 --
 417 -------------------------------------------------------------------------
 418
 419 srtLabelAndLength :: C_SRT -> CLabel -> (CmmLit, StgHalfWord)
 420 srtLabelAndLength NoC_SRT _
 421   = (zeroCLit, 0)
 422 srtLabelAndLength (C_SRT lbl off bitmap) info_lbl
 423   = (makeRelativeRefTo info_lbl $ cmmLabelOffW lbl off, bitmap)
 424
 425 -------------------------------------------------------------------------
 426 --
 427 --      Position independent code
 428 --
 429 -------------------------------------------------------------------------
 430 -- In order to support position independent code, we mustn't put absolute
 431 -- references into read-only space. Info tables in the tablesNextToCode
 432 -- case must be in .text, which is read-only, so we doctor the CmmLits
 433 -- to use relative offsets instead.
 434
 435 -- Note that this is done even when the -fPIC flag is not specified,
 436 -- as we want to keep binary compatibility between PIC and non-PIC.
 437
 438 makeRelativeRefTo :: CLabel -> CmmLit -> CmmLit
 439
 440 makeRelativeRefTo info_lbl (CmmLabel lbl)
 441   | tablesNextToCode
 442   = CmmLabelDiffOff lbl info_lbl 0
 443 makeRelativeRefTo info_lbl (CmmLabelOff lbl off)
 444   | tablesNextToCode
 445   = CmmLabelDiffOff lbl info_lbl off
 446 makeRelativeRefTo _ lit = lit