compiler/codeGen/CgInfoTbls.hs

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