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