compiler/codeGen/CgInfoTbls.hs

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