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 gc_target Nothing (CmmInfoTable prof cl_type info)
  93
  94     ClosureInfo { closureName   = name,
  95                   closureLFInfo = lf_info,
  96                   closureSRT    = srt } ->
  97        return $ CmmInfo gc_target Nothing (CmmInfoTable prof 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                        gc_target
 149                        Nothing
 150                        (CmmInfoTable
 151                         (ProfilingInfo zeroCLit zeroCLit)
 152                         rET_SMALL -- cmmToRawCmm may convert it to rET_BIG
 153                         (ContInfo frame srt_info))
 154         ; emitInfoTableAndCode info_lbl info args blks
 155         ; return info_lbl }
 156   where
 157     args      = {- trace "emitReturnTarget: missing args" -} []
 158     uniq      = getUnique name
 159     info_lbl  = mkReturnInfoLabel uniq
 160
 161     -- The gc_target is to inform the CPS pass when it inserts a stack check.
 162     -- Since that pass isn't used yet we'll punt for now.
 163     -- When the CPS pass is fully integrated, this should
 164     -- be replaced by the label that any heap check jumped to,
 165     -- so that branch can be shared by both the heap (from codeGen)
 166     -- and stack checks (from the CPS pass).
 167     gc_target = panic "TODO: gc_target"
 168
 169
 170 -- Build stack layout information from the state of the 'FCode' monad.
 171 -- Should go away once 'codeGen' starts using the CPS conversion
 172 -- pass to handle the stack.  Until then, this is really just
 173 -- here to convert from the 'codeGen' representation of the stack
 174 -- to the 'CmmInfo' representation of the stack.
 175 --
 176 -- See 'CmmInfo.mkLiveness' for where this is converted to a bitmap.
 177
 178 {-
 179 This seems to be a very error prone part of the code.
 180 It is surprisingly prone to off-by-one errors, because
 181 it converts between offset form (codeGen) and list form (CmmInfo).
 182 Thus a bit of explanation is in order.
 183 Fortunately, this code should go away once the code generator
 184 starts using the CPS conversion pass to handle the stack.
 185
 186 The stack looks like this:
 187
 188              |             |
 189              |-------------|
 190 frame_sp --> | return addr |
 191              |-------------|
 192              | dead slot   |
 193              |-------------|
 194              | live ptr b  |
 195              |-------------|
 196              | live ptr a  |
 197              |-------------|
 198 real_sp  --> | return addr |
 199              +-------------+
 200
 201 Both 'frame_sp' and 'real_sp' are measured downwards
 202 (i.e. larger frame_sp means smaller memory address).
 203
 204 For that frame we want a result like: [Just a, Just b, Nothing]
 205 Note that the 'head' of the list is the top
 206 of the stack, and that the return address
 207 is not present in the list (it is always assumed).
 208 -}
 209 mkStackLayout :: FCode [Maybe LocalReg]
 210 mkStackLayout = do
 211   StackUsage { realSp = real_sp,
 212                frameSp = frame_sp } <- getStkUsage
 213   binds <- getLiveStackBindings
 214   let frame_size = real_sp - frame_sp - retAddrSizeW
 215       rel_binds = reverse $ sortWith fst
 216                     [(offset - frame_sp - retAddrSizeW, b)
 217                     | (offset, b) <- binds]
 218
 219   WARN( not (all (\bind -> fst bind >= 0) rel_binds),
 220         ppr binds $$ ppr rel_binds $$
 221         ppr frame_size $$ ppr real_sp $$ ppr frame_sp )
 222     return $ stack_layout rel_binds frame_size
 223
 224 stack_layout :: [(VirtualSpOffset, CgIdInfo)]
 225              -> WordOff
 226              -> [Maybe LocalReg]
 227 stack_layout [] sizeW = replicate sizeW Nothing
 228 stack_layout ((off, bind):binds) sizeW | off == sizeW - 1 =
 229   (Just stack_bind) : (stack_layout binds (sizeW - rep_size))
 230   where
 231     rep_size = cgRepSizeW (cgIdInfoArgRep bind)
 232     stack_bind = LocalReg unique machRep kind
 233     unique = getUnique (cgIdInfoId bind)
 234     machRep = argMachRep (cgIdInfoArgRep bind)
 235     kind = if isFollowableArg (cgIdInfoArgRep bind)
 236            then KindPtr
 237            else KindNonPtr
 238 stack_layout binds@((off, _):_) sizeW | otherwise =
 239   Nothing : (stack_layout binds (sizeW - 1))
 240
 241 {- Another way to write the function that might be less error prone (untested)
 242 stack_layout offsets sizeW = result
 243   where
 244     y = map (flip lookup offsets) [0..]
 245       -- offsets -> nothing and just (each slot is one word)
 246     x = take sizeW y -- set the frame size
 247     z = clip x -- account for multi-word slots
 248     result = map mk_reg z
 249
 250     clip [] = []
 251     clip list@(x : _) = x : clip (drop count list)
 252       ASSERT(all isNothing (tail (take count list)))
 253
 254     count Nothing = 1
 255     count (Just x) = cgRepSizeW (cgIdInfoArgRep x)
 256
 257     mk_reg Nothing = Nothing
 258     mk_reg (Just x) = LocalReg unique machRep kind
 259       where
 260         unique = getUnique (cgIdInfoId x)
 261         machRep = argMachrep (cgIdInfoArgRep bind)
 262         kind = if isFollowableArg (cgIdInfoArgRep bind)
 263            then KindPtr
 264            else KindNonPtr
 265 -}
 266
 267 emitAlgReturnTarget
 268         :: Name                         -- Just for its unique
 269         -> [(ConTagZ, CgStmts)]         -- Tagged branches
 270         -> Maybe CgStmts                -- Default branch (if any)
 271         -> Int                          -- family size
 272         -> FCode (CLabel, SemiTaggingStuff)
 273
 274 emitAlgReturnTarget name branches mb_deflt fam_sz
 275   = do  { blks <- getCgStmts $
 276                     emitSwitch tag_expr branches mb_deflt 0 (fam_sz - 1)
 277                 -- NB: tag_expr is zero-based
 278         ; lbl <- emitReturnTarget name blks
 279         ; return (lbl, Nothing) }
 280                 -- Nothing: the internal branches in the switch don't have
 281                 -- global labels, so we can't use them at the 'call site'
 282   where
 283     tag_expr = getConstrTag (CmmReg nodeReg)
 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 = stdInfoTableSizeW * wORD_SIZE :: ByteOff
 309
 310 stdSrtBitmapOffset :: ByteOff
 311 -- Byte offset of the SRT bitmap half-word which is
 312 -- in the *higher-addressed* part of the type_lit
 313 stdSrtBitmapOffset = stdInfoTableSizeB - hALF_WORD_SIZE
 314
 315 stdClosureTypeOffset :: ByteOff
 316 -- Byte offset of the closure type half-word
 317 stdClosureTypeOffset = stdInfoTableSizeB - wORD_SIZE
 318
 319 stdPtrsOffset, stdNonPtrsOffset :: ByteOff
 320 stdPtrsOffset    = stdInfoTableSizeB - 2*wORD_SIZE
 321 stdNonPtrsOffset = stdInfoTableSizeB - 2*wORD_SIZE + hALF_WORD_SIZE
 322
 323 -------------------------------------------------------------------------
 324 --
 325 --      Accessing fields of an info table
 326 --
 327 -------------------------------------------------------------------------
 328
 329 closureInfoPtr :: CmmExpr -> CmmExpr
 330 -- Takes a closure pointer and returns the info table pointer
 331 closureInfoPtr e = CmmLoad e wordRep
 332
 333 entryCode :: CmmExpr -> CmmExpr
 334 -- Takes an info pointer (the first word of a closure)
 335 -- and returns its entry code
 336 entryCode e | tablesNextToCode = e
 337             | otherwise        = CmmLoad e wordRep
 338
 339 getConstrTag :: CmmExpr -> CmmExpr
 340 -- Takes a closure pointer, and return the *zero-indexed*
 341 -- constructor tag obtained from the info table
 342 -- This lives in the SRT field of the info table
 343 -- (constructors don't need SRTs).
 344 getConstrTag closure_ptr
 345   = CmmMachOp (MO_U_Conv halfWordRep wordRep) [infoTableConstrTag info_table]
 346   where
 347     info_table = infoTable (closureInfoPtr closure_ptr)
 348
 349 infoTable :: CmmExpr -> CmmExpr
 350 -- Takes an info pointer (the first word of a closure)
 351 -- and returns a pointer to the first word of the standard-form
 352 -- info table, excluding the entry-code word (if present)
 353 infoTable info_ptr
 354   | tablesNextToCode = cmmOffsetB info_ptr (- stdInfoTableSizeB)
 355   | otherwise        = cmmOffsetW info_ptr 1    -- Past the entry code pointer
 356
 357 infoTableConstrTag :: CmmExpr -> CmmExpr
 358 -- Takes an info table pointer (from infoTable) and returns the constr tag
 359 -- field of the info table (same as the srt_bitmap field)
 360 infoTableConstrTag = infoTableSrtBitmap
 361
 362 infoTableSrtBitmap :: CmmExpr -> CmmExpr
 363 -- Takes an info table pointer (from infoTable) and returns the srt_bitmap
 364 -- field of the info table
 365 infoTableSrtBitmap info_tbl
 366   = CmmLoad (cmmOffsetB info_tbl stdSrtBitmapOffset) halfWordRep
 367
 368 infoTableClosureType :: CmmExpr -> CmmExpr
 369 -- Takes an info table pointer (from infoTable) and returns the closure type
 370 -- field of the info table.
 371 infoTableClosureType info_tbl
 372   = CmmLoad (cmmOffsetB info_tbl stdClosureTypeOffset) halfWordRep
 373
 374 infoTablePtrs :: CmmExpr -> CmmExpr
 375 infoTablePtrs info_tbl
 376   = CmmLoad (cmmOffsetB info_tbl stdPtrsOffset) halfWordRep
 377
 378 infoTableNonPtrs :: CmmExpr -> CmmExpr
 379 infoTableNonPtrs info_tbl
 380   = CmmLoad (cmmOffsetB info_tbl stdNonPtrsOffset) halfWordRep
 381
 382 funInfoTable :: CmmExpr -> CmmExpr
 383 -- Takes the info pointer of a function,
 384 -- and returns a pointer to the first word of the StgFunInfoExtra struct
 385 -- in the info table.
 386 funInfoTable info_ptr
 387   | tablesNextToCode
 388   = cmmOffsetB info_ptr (- stdInfoTableSizeB - sIZEOF_StgFunInfoExtraRev)
 389   | otherwise
 390   = cmmOffsetW info_ptr (1 + stdInfoTableSizeW)
 391                                 -- Past the entry code pointer
 392
 393 -------------------------------------------------------------------------
 394 --
 395 --      Emit the code for a closure (or return address)
 396 --      and its associated info table
 397 --
 398 -------------------------------------------------------------------------
 399
 400 -- The complication here concerns whether or not we can
 401 -- put the info table next to the code
 402
 403 emitInfoTableAndCode
 404         :: CLabel               -- Label of info table
 405         -> CmmInfo              -- ...the info table
 406         -> CmmFormals           -- ...args
 407         -> [CmmBasicBlock]      -- ...and body
 408         -> Code
 409
 410 emitInfoTableAndCode info_lbl info args blocks
 411   = emitProc info entry_lbl args blocks
 412   where
 413         entry_lbl = infoLblToEntryLbl info_lbl
 414
 415 -------------------------------------------------------------------------
 416 --
 417 --      Static reference tables
 418 --
 419 -------------------------------------------------------------------------
 420
 421 srtLabelAndLength :: C_SRT -> CLabel -> (CmmLit, StgHalfWord)
 422 srtLabelAndLength NoC_SRT _
 423   = (zeroCLit, 0)
 424 srtLabelAndLength (C_SRT lbl off bitmap) info_lbl
 425   = (makeRelativeRefTo info_lbl $ cmmLabelOffW lbl off, bitmap)
 426
 427 -------------------------------------------------------------------------
 428 --
 429 --      Position independent code
 430 --
 431 -------------------------------------------------------------------------
 432 -- In order to support position independent code, we mustn't put absolute
 433 -- references into read-only space. Info tables in the tablesNextToCode
 434 -- case must be in .text, which is read-only, so we doctor the CmmLits
 435 -- to use relative offsets instead.
 436
 437 -- Note that this is done even when the -fPIC flag is not specified,
 438 -- as we want to keep binary compatibility between PIC and non-PIC.
 439
 440 makeRelativeRefTo :: CLabel -> CmmLit -> CmmLit
 441
 442 makeRelativeRefTo info_lbl (CmmLabel lbl)
 443   | tablesNextToCode
 444   = CmmLabelDiffOff lbl info_lbl 0
 445 makeRelativeRefTo info_lbl (CmmLabelOff lbl off)
 446   | tablesNextToCode
 447   = CmmLabelDiffOff lbl info_lbl off
 448 makeRelativeRefTo _ lit = lit