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         cmmGetClosureType,
  19         infoTable, infoTableClosureType,
  20         infoTablePtrs, infoTableNonPtrs,
  21         funInfoTable, makeRelativeRefTo
  22   ) where
  23
  24
  25 #include "HsVersions.h"
  26
  27 import ClosureInfo
  28 import SMRep
  29 import CgBindery
  30 import CgCallConv
  31 import CgUtils
  32 import CgMonad
  33
  34 import CmmUtils
  35 import Cmm
  36 import MachOp
  37 import CLabel
  38 import StgSyn
  39 import Name
  40 import DataCon
  41 import Unique
  42 import StaticFlags
  43
  44 import Maybes
  45 import Constants
  46 import Panic
  47 import Util
  48 import Outputable
  49
  50 -------------------------------------------------------------------------
  51 --
  52 --      Generating the info table and code for a closure
  53 --
  54 -------------------------------------------------------------------------
  55
  56 -- Here we make an info table of type 'CmmInfo'.  The concrete
  57 -- representation as a list of 'CmmAddr' is handled later
  58 -- in the pipeline by 'cmmToRawCmm'.
  59
  60 emitClosureCodeAndInfoTable :: ClosureInfo -> CmmFormals -> CgStmts -> Code
  61 emitClosureCodeAndInfoTable cl_info args body
  62  = do   { blks <- cgStmtsToBlocks body
  63         ; info <- mkCmmInfo cl_info
  64         ; emitInfoTableAndCode (infoLblToEntryLbl info_lbl) info args blks }
  65   where
  66     info_lbl  = infoTableLabelFromCI cl_info
  67
  68 -- We keep the *zero-indexed* tag in the srt_len field of the info
  69 -- table of a data constructor.
  70 dataConTagZ :: DataCon -> ConTagZ
  71 dataConTagZ con = dataConTag con - fIRST_TAG
  72
  73 -- Convert from 'ClosureInfo' to 'CmmInfo'.
  74 -- Not used for return points.  (The 'smRepClosureTypeInt' call would panic.)
  75 mkCmmInfo :: ClosureInfo -> FCode CmmInfo
  76 mkCmmInfo cl_info = do
  77   prof <-
  78       if opt_SccProfilingOn
  79       then do ty_descr_lit <- mkStringCLit (closureTypeDescr cl_info)
  80               cl_descr_lit <- mkStringCLit (closureValDescr cl_info)
  81               return $ ProfilingInfo
  82                          (makeRelativeRefTo info_lbl ty_descr_lit)
  83                          (makeRelativeRefTo info_lbl cl_descr_lit)
  84       else return $ ProfilingInfo (mkIntCLit 0) (mkIntCLit 0)
  85
  86   case cl_info of
  87     ConInfo { closureCon = con } -> do
  88        cstr <- mkByteStringCLit $ dataConIdentity con
  89        let conName = makeRelativeRefTo info_lbl cstr
  90            info = ConstrInfo (ptrs, nptrs)
  91                              (fromIntegral (dataConTagZ con))
  92                              conName
  93        return $ CmmInfo gc_target Nothing (CmmInfoTable prof cl_type info)
  94
  95     ClosureInfo { closureName   = name,
  96                   closureLFInfo = lf_info,
  97                   closureSRT    = srt } ->
  98        return $ CmmInfo gc_target Nothing (CmmInfoTable prof cl_type info)
  99        where
 100          info =
 101              case lf_info of
 102                LFReEntrant _ arity _ arg_descr ->
 103                    FunInfo (ptrs, nptrs)
 104                            srt
 105                            (argDescrType arg_descr)
 106                            (fromIntegral arity)
 107                            arg_descr
 108                            (CmmLabel (mkSlowEntryLabel name))
 109                LFThunk _ _ _ (SelectorThunk offset) _ ->
 110                    ThunkSelectorInfo (fromIntegral offset) srt
 111                LFThunk _ _ _ _ _ ->
 112                    ThunkInfo (ptrs, nptrs) srt
 113                _ -> panic "unexpected lambda form in mkCmmInfo"
 114   where
 115     info_lbl = infoTableLabelFromCI cl_info
 116
 117     cl_type  = smRepClosureTypeInt (closureSMRep cl_info)
 118
 119     ptrs     = fromIntegral $ closurePtrsSize cl_info
 120     size     = fromIntegral $ closureNonHdrSize cl_info
 121     nptrs    = size - ptrs
 122
 123     -- The gc_target is to inform the CPS pass when it inserts a stack check.
 124     -- Since that pass isn't used yet we'll punt for now.
 125     -- When the CPS pass is fully integrated, this should
 126     -- be replaced by the label that any heap check jumped to,
 127     -- so that branch can be shared by both the heap (from codeGen)
 128     -- and stack checks (from the CPS pass).
 129     gc_target = panic "TODO: gc_target"
 130
 131 -------------------------------------------------------------------------
 132 --
 133 --      Generating the info table and code for a return point
 134 --
 135 -------------------------------------------------------------------------
 136
 137 -- The concrete representation as a list of 'CmmAddr' is handled later
 138 -- in the pipeline by 'cmmToRawCmm'.
 139
 140 emitReturnTarget
 141    :: Name
 142    -> CgStmts                   -- The direct-return code (if any)
 143    -> FCode CLabel
 144 emitReturnTarget name stmts
 145   = do  { srt_info   <- getSRTInfo
 146         ; blks <- cgStmtsToBlocks stmts
 147         ; frame <- mkStackLayout
 148         ; let info = CmmInfo
 149                        gc_target
 150                        Nothing
 151                        (CmmInfoTable
 152                         (ProfilingInfo zeroCLit zeroCLit)
 153                         rET_SMALL -- cmmToRawCmm may convert it to rET_BIG
 154                         (ContInfo frame srt_info))
 155         ; emitInfoTableAndCode (infoLblToEntryLbl info_lbl) info args blks
 156         ; return info_lbl }
 157   where
 158     args      = {- trace "emitReturnTarget: missing args" -} []
 159     uniq      = getUnique name
 160     info_lbl  = mkReturnInfoLabel uniq
 161
 162     -- The gc_target is to inform the CPS pass when it inserts a stack check.
 163     -- Since that pass isn't used yet we'll punt for now.
 164     -- When the CPS pass is fully integrated, this should
 165     -- be replaced by the label that any heap check jumped to,
 166     -- so that branch can be shared by both the heap (from codeGen)
 167     -- and stack checks (from the CPS pass).
 168     gc_target = panic "TODO: gc_target"
 169
 170
 171 -- Build stack layout information from the state of the 'FCode' monad.
 172 -- Should go away once 'codeGen' starts using the CPS conversion
 173 -- pass to handle the stack.  Until then, this is really just
 174 -- here to convert from the 'codeGen' representation of the stack
 175 -- to the 'CmmInfo' representation of the stack.
 176 --
 177 -- See 'CmmInfo.mkLiveness' for where this is converted to a bitmap.
 178
 179 {-
 180 This seems to be a very error prone part of the code.
 181 It is surprisingly prone to off-by-one errors, because
 182 it converts between offset form (codeGen) and list form (CmmInfo).
 183 Thus a bit of explanation is in order.
 184 Fortunately, this code should go away once the code generator
 185 starts using the CPS conversion pass to handle the stack.
 186
 187 The stack looks like this:
 188
 189              |             |
 190              |-------------|
 191 frame_sp --> | return addr |
 192              |-------------|
 193              | dead slot   |
 194              |-------------|
 195              | live ptr b  |
 196              |-------------|
 197              | live ptr a  |
 198              |-------------|
 199 real_sp  --> | return addr |
 200              +-------------+
 201
 202 Both 'frame_sp' and 'real_sp' are measured downwards
 203 (i.e. larger frame_sp means smaller memory address).
 204
 205 For that frame we want a result like: [Just a, Just b, Nothing]
 206 Note that the 'head' of the list is the top
 207 of the stack, and that the return address
 208 is not present in the list (it is always assumed).
 209 -}
 210 mkStackLayout :: FCode [Maybe LocalReg]
 211 mkStackLayout = do
 212   StackUsage { realSp = real_sp,
 213                frameSp = frame_sp } <- getStkUsage
 214   binds <- getLiveStackBindings
 215   let frame_size = real_sp - frame_sp - retAddrSizeW
 216       rel_binds = reverse $ sortWith fst
 217                     [(offset - frame_sp - retAddrSizeW, b)
 218                     | (offset, b) <- binds]
 219
 220   WARN( not (all (\bind -> fst bind >= 0) rel_binds),
 221         ppr binds $$ ppr rel_binds $$
 222         ppr frame_size $$ ppr real_sp $$ ppr frame_sp )
 223     return $ stack_layout rel_binds frame_size
 224
 225 stack_layout :: [(VirtualSpOffset, CgIdInfo)]
 226              -> WordOff
 227              -> [Maybe LocalReg]
 228 stack_layout [] sizeW = replicate sizeW Nothing
 229 stack_layout ((off, bind):binds) sizeW | off == sizeW - 1 =
 230   (Just stack_bind) : (stack_layout binds (sizeW - rep_size))
 231   where
 232     rep_size = cgRepSizeW (cgIdInfoArgRep bind)
 233     stack_bind = LocalReg unique machRep kind
 234     unique = getUnique (cgIdInfoId bind)
 235     machRep = argMachRep (cgIdInfoArgRep bind)
 236     kind = if isFollowableArg (cgIdInfoArgRep bind)
 237            then KindPtr
 238            else KindNonPtr
 239 stack_layout binds@((off, _):_) sizeW | otherwise =
 240   Nothing : (stack_layout binds (sizeW - 1))
 241
 242 {- Another way to write the function that might be less error prone (untested)
 243 stack_layout offsets sizeW = result
 244   where
 245     y = map (flip lookup offsets) [0..]
 246       -- offsets -> nothing and just (each slot is one word)
 247     x = take sizeW y -- set the frame size
 248     z = clip x -- account for multi-word slots
 249     result = map mk_reg z
 250
 251     clip [] = []
 252     clip list@(x : _) = x : clip (drop count list)
 253       ASSERT(all isNothing (tail (take count list)))
 254
 255     count Nothing = 1
 256     count (Just x) = cgRepSizeW (cgIdInfoArgRep x)
 257
 258     mk_reg Nothing = Nothing
 259     mk_reg (Just x) = LocalReg unique machRep kind
 260       where
 261         unique = getUnique (cgIdInfoId x)
 262         machRep = argMachrep (cgIdInfoArgRep bind)
 263         kind = if isFollowableArg (cgIdInfoArgRep bind)
 264            then KindPtr
 265            else KindNonPtr
 266 -}
 267
 268 emitAlgReturnTarget
 269         :: Name                         -- Just for its unique
 270         -> [(ConTagZ, CgStmts)]         -- Tagged branches
 271         -> Maybe CgStmts                -- Default branch (if any)
 272         -> Int                          -- family size
 273         -> FCode (CLabel, SemiTaggingStuff)
 274
 275 emitAlgReturnTarget name branches mb_deflt fam_sz
 276   = do  { blks <- getCgStmts $
 277                     -- is the constructor tag in the node reg?
 278                     if isSmallFamily fam_sz
 279                         then do -- yes, node has constr. tag
 280                           let tag_expr = cmmConstrTag1 (CmmReg nodeReg)
 281                               branches' = [(tag+1,branch)|(tag,branch)<-branches]
 282                           emitSwitch tag_expr branches' mb_deflt 1 fam_sz
 283                         else do -- no, get tag from info table
 284                           let -- Note that ptr _always_ has tag 1
 285                               -- when the family size is big enough
 286                               untagged_ptr = cmmRegOffB nodeReg (-1)
 287                               tag_expr = getConstrTag (untagged_ptr)
 288                           emitSwitch tag_expr branches mb_deflt 0 (fam_sz - 1)
 289         ; lbl <- emitReturnTarget name blks
 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   where
 294     uniq = getUnique name
 295
 296 --------------------------------
 297 emitReturnInstr :: Code
 298 emitReturnInstr
 299   = do  { info_amode <- getSequelAmode
 300         ; stmtC (CmmJump (entryCode info_amode) []) }
 301
 302 -----------------------------------------------------------------------------
 303 --
 304 --      Info table offsets
 305 --
 306 -----------------------------------------------------------------------------
 307
 308 stdInfoTableSizeW :: WordOff
 309 -- The size of a standard info table varies with profiling/ticky etc,
 310 -- so we can't get it from Constants
 311 -- It must vary in sync with mkStdInfoTable
 312 stdInfoTableSizeW
 313   = size_fixed + size_prof
 314   where
 315     size_fixed = 2      -- layout, type
 316     size_prof | opt_SccProfilingOn = 2
 317               | otherwise          = 0
 318
 319 stdInfoTableSizeB = stdInfoTableSizeW * wORD_SIZE :: ByteOff
 320
 321 stdSrtBitmapOffset :: ByteOff
 322 -- Byte offset of the SRT bitmap half-word which is
 323 -- in the *higher-addressed* part of the type_lit
 324 stdSrtBitmapOffset = stdInfoTableSizeB - hALF_WORD_SIZE
 325
 326 stdClosureTypeOffset :: ByteOff
 327 -- Byte offset of the closure type half-word
 328 stdClosureTypeOffset = stdInfoTableSizeB - wORD_SIZE
 329
 330 stdPtrsOffset, stdNonPtrsOffset :: ByteOff
 331 stdPtrsOffset    = stdInfoTableSizeB - 2*wORD_SIZE
 332 stdNonPtrsOffset = stdInfoTableSizeB - 2*wORD_SIZE + hALF_WORD_SIZE
 333
 334 -------------------------------------------------------------------------
 335 --
 336 --      Accessing fields of an info table
 337 --
 338 -------------------------------------------------------------------------
 339
 340 closureInfoPtr :: CmmExpr -> CmmExpr
 341 -- Takes a closure pointer and returns the info table pointer
 342 closureInfoPtr e = CmmLoad e wordRep
 343
 344 entryCode :: CmmExpr -> CmmExpr
 345 -- Takes an info pointer (the first word of a closure)
 346 -- and returns its entry code
 347 entryCode e | tablesNextToCode = e
 348             | otherwise        = CmmLoad e wordRep
 349
 350 getConstrTag :: CmmExpr -> CmmExpr
 351 -- Takes a closure pointer, and return the *zero-indexed*
 352 -- constructor tag obtained from the info table
 353 -- This lives in the SRT field of the info table
 354 -- (constructors don't need SRTs).
 355 getConstrTag closure_ptr
 356   = CmmMachOp (MO_U_Conv halfWordRep wordRep) [infoTableConstrTag info_table]
 357   where
 358     info_table = infoTable (closureInfoPtr closure_ptr)
 359
 360 cmmGetClosureType :: CmmExpr -> CmmExpr
 361 -- Takes a closure pointer, and return the closure type
 362 -- obtained from the info table
 363 cmmGetClosureType closure_ptr
 364   = CmmMachOp (MO_U_Conv halfWordRep wordRep) [infoTableClosureType info_table]
 365   where
 366     info_table = infoTable (closureInfoPtr closure_ptr)
 367
 368 infoTable :: CmmExpr -> CmmExpr
 369 -- Takes an info pointer (the first word of a closure)
 370 -- and returns a pointer to the first word of the standard-form
 371 -- info table, excluding the entry-code word (if present)
 372 infoTable info_ptr
 373   | tablesNextToCode = cmmOffsetB info_ptr (- stdInfoTableSizeB)
 374   | otherwise        = cmmOffsetW info_ptr 1    -- Past the entry code pointer
 375
 376 infoTableConstrTag :: CmmExpr -> CmmExpr
 377 -- Takes an info table pointer (from infoTable) and returns the constr tag
 378 -- field of the info table (same as the srt_bitmap field)
 379 infoTableConstrTag = infoTableSrtBitmap
 380
 381 infoTableSrtBitmap :: CmmExpr -> CmmExpr
 382 -- Takes an info table pointer (from infoTable) and returns the srt_bitmap
 383 -- field of the info table
 384 infoTableSrtBitmap info_tbl
 385   = CmmLoad (cmmOffsetB info_tbl stdSrtBitmapOffset) halfWordRep
 386
 387 infoTableClosureType :: CmmExpr -> CmmExpr
 388 -- Takes an info table pointer (from infoTable) and returns the closure type
 389 -- field of the info table.
 390 infoTableClosureType info_tbl
 391   = CmmLoad (cmmOffsetB info_tbl stdClosureTypeOffset) halfWordRep
 392
 393 infoTablePtrs :: CmmExpr -> CmmExpr
 394 infoTablePtrs info_tbl
 395   = CmmLoad (cmmOffsetB info_tbl stdPtrsOffset) halfWordRep
 396
 397 infoTableNonPtrs :: CmmExpr -> CmmExpr
 398 infoTableNonPtrs info_tbl
 399   = CmmLoad (cmmOffsetB info_tbl stdNonPtrsOffset) halfWordRep
 400
 401 funInfoTable :: CmmExpr -> CmmExpr
 402 -- Takes the info pointer of a function,
 403 -- and returns a pointer to the first word of the StgFunInfoExtra struct
 404 -- in the info table.
 405 funInfoTable info_ptr
 406   | tablesNextToCode
 407   = cmmOffsetB info_ptr (- stdInfoTableSizeB - sIZEOF_StgFunInfoExtraRev)
 408   | otherwise
 409   = cmmOffsetW info_ptr (1 + stdInfoTableSizeW)
 410                                 -- Past the entry code pointer
 411
 412 -------------------------------------------------------------------------
 413 --
 414 --      Emit the code for a closure (or return address)
 415 --      and its associated info table
 416 --
 417 -------------------------------------------------------------------------
 418
 419 -- The complication here concerns whether or not we can
 420 -- put the info table next to the code
 421
 422 emitInfoTableAndCode
 423         :: CLabel               -- Label of entry or ret
 424         -> CmmInfo              -- ...the info table
 425         -> CmmFormals           -- ...args
 426         -> [CmmBasicBlock]      -- ...and body
 427         -> Code
 428
 429 emitInfoTableAndCode entry_ret_lbl info args blocks
 430   = emitProc info entry_ret_lbl args blocks
 431
 432 -------------------------------------------------------------------------
 433 --
 434 --      Static reference tables
 435 --
 436 -------------------------------------------------------------------------
 437
 438 srtLabelAndLength :: C_SRT -> CLabel -> (CmmLit, StgHalfWord)
 439 srtLabelAndLength NoC_SRT _
 440   = (zeroCLit, 0)
 441 srtLabelAndLength (C_SRT lbl off bitmap) info_lbl
 442   = (makeRelativeRefTo info_lbl $ cmmLabelOffW lbl off, bitmap)
 443
 444 -------------------------------------------------------------------------
 445 --
 446 --      Position independent code
 447 --
 448 -------------------------------------------------------------------------
 449 -- In order to support position independent code, we mustn't put absolute
 450 -- references into read-only space. Info tables in the tablesNextToCode
 451 -- case must be in .text, which is read-only, so we doctor the CmmLits
 452 -- to use relative offsets instead.
 453
 454 -- Note that this is done even when the -fPIC flag is not specified,
 455 -- as we want to keep binary compatibility between PIC and non-PIC.
 456
 457 makeRelativeRefTo :: CLabel -> CmmLit -> CmmLit
 458
 459 makeRelativeRefTo info_lbl (CmmLabel lbl)
 460   | tablesNextToCode
 461   = CmmLabelDiffOff lbl info_lbl 0
 462 makeRelativeRefTo info_lbl (CmmLabelOff lbl off)
 463   | tablesNextToCode
 464   = CmmLabelDiffOff lbl info_lbl off
 465 makeRelativeRefTo _ lit = lit