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