compiler/codeGen/StgCmmLayout.hs

   1 -----------------------------------------------------------------------------
   2 --
   3 -- Building info tables.
   4 --
   5 -- (c) The University of Glasgow 2004-2006
   6 --
   7 -----------------------------------------------------------------------------
   8
   9 {-# OPTIONS  #-}
  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/Commentary/CodingStyle#Warnings
  14 -- for details
  15
  16 module StgCmmLayout (
  17         mkArgDescr,
  18         emitCall, emitReturn,
  19
  20         emitClosureCodeAndInfoTable,
  21
  22         slowCall, directCall,
  23
  24         mkVirtHeapOffsets, getHpRelOffset, hpRel,
  25
  26         stdInfoTableSizeB,
  27         entryCode, closureInfoPtr,
  28         getConstrTag,
  29         cmmGetClosureType,
  30         infoTable, infoTableClosureType,
  31         infoTablePtrs, infoTableNonPtrs,
  32         funInfoTable, makeRelativeRefTo
  33   ) where
  34
  35
  36 #include "HsVersions.h"
  37
  38 import StgCmmClosure
  39 import StgCmmEnv
  40 import StgCmmTicky
  41 import StgCmmUtils
  42 import StgCmmMonad
  43
  44 import MkZipCfgCmm
  45 import SMRep
  46 import CmmUtils
  47 import Cmm
  48 import CLabel
  49 import StgSyn
  50 import Id
  51 import Name
  52 import TyCon            ( PrimRep(..) )
  53 import Unique
  54 import BasicTypes       ( Arity )
  55 import StaticFlags
  56
  57 import Bitmap
  58 import Data.Bits
  59
  60 import Maybes
  61 import Constants
  62 import Util
  63 import Data.List
  64 import Outputable
  65 import FastString       ( LitString, sLit )
  66
  67 ------------------------------------------------------------------------
  68 --              Call and return sequences
  69 ------------------------------------------------------------------------
  70
  71 emitReturn :: [CmmExpr] -> FCode ()
  72 -- Return multiple values to the sequel
  73 --
  74 -- If the sequel is Return
  75 --      return (x,y)
  76 -- If the sequel is AssignTo [p,q]
  77 --      p=x; q=y;
  78 emitReturn results
  79   = do  { adjustHpBackwards
  80         ; sequel <- getSequel;
  81         ; case sequel of
  82             Return _        -> emit (mkReturn results)
  83             AssignTo regs _ -> emit (mkMultiAssign regs results)
  84     }
  85
  86 emitCall :: CmmExpr -> [CmmExpr] -> FCode ()
  87 -- (cgCall fun args) makes a call to the entry-code of 'fun',
  88 -- passing 'args', and returning the results to the current sequel
  89 emitCall fun args
  90   = do  { adjustHpBackwards
  91         ; sequel <- getSequel;
  92         ; case sequel of
  93             Return _              -> emit (mkJump fun args)
  94             AssignTo res_regs srt -> emit (mkCmmCall fun res_regs args srt)
  95     }
  96
  97 adjustHpBackwards :: FCode ()
  98 -- This function adjusts and heap pointers just before a tail call or
  99 -- return.  At a call or return, the virtual heap pointer may be less
 100 -- than the real Hp, because the latter was advanced to deal with
 101 -- the worst-case branch of the code, and we may be in a better-case
 102 -- branch.  In that case, move the real Hp *back* and retract some
 103 -- ticky allocation count.
 104 --
 105 -- It *does not* deal with high-water-mark adjustment.
 106 -- That's done by functions which allocate heap.
 107 adjustHpBackwards
 108   = do  { hp_usg <- getHpUsage
 109         ; let rHp = realHp hp_usg
 110               vHp = virtHp hp_usg
 111               adjust_words = vHp -rHp
 112         ; new_hp <- getHpRelOffset vHp
 113
 114         ; emit (if adjust_words == 0
 115                 then mkNop
 116                 else mkAssign hpReg new_hp)     -- Generates nothing when vHp==rHp
 117
 118         ; tickyAllocHeap adjust_words           -- ...ditto
 119
 120         ; setRealHp vHp
 121         }
 122
 123
 124 -------------------------------------------------------------------------
 125 --      Making calls: directCall and slowCall
 126 -------------------------------------------------------------------------
 127
 128 directCall :: CLabel -> Arity -> [StgArg] -> FCode ()
 129 -- (directCall f n args)
 130 -- calls f(arg1, ..., argn), and applies the result to the remaining args
 131 -- The function f has arity n, and there are guaranteed at least n args
 132 -- Both arity and args include void args
 133 directCall lbl arity stg_args
 134   = do  { cmm_args <- getNonVoidArgAmodes stg_args
 135         ; direct_call lbl arity cmm_args (argsLReps stg_args) }
 136
 137 slowCall :: CmmExpr -> [StgArg] -> FCode ()
 138 -- (slowCall fun args) applies fun to args, returning the results to Sequel
 139 slowCall fun stg_args
 140   = do  { cmm_args <- getNonVoidArgAmodes stg_args
 141         ; slow_call fun cmm_args (argsLReps stg_args) }
 142
 143 --------------
 144 direct_call :: CLabel -> Arity -> [CmmExpr] -> [LRep] -> FCode ()
 145 -- NB1: (length args) maybe less than (length reps), because
 146 --     the args exclude the void ones
 147 -- NB2: 'arity' refers to the *reps*
 148 direct_call lbl arity args reps
 149   | null rest_args
 150   = ASSERT( arity == length args)
 151     emitCall target args
 152
 153   | otherwise
 154   = ASSERT( arity == length initial_reps )
 155     do  { pap_id <- newTemp gcWord
 156         ; let srt = pprTrace "Urk! SRT for over-sat call"
 157                              (ppr lbl) NoC_SRT
 158                 -- XXX: what if rest_args contains static refs?
 159         ; withSequel (AssignTo [pap_id] srt)
 160                      (emitCall target args)
 161         ; slow_call (CmmReg (CmmLocal pap_id))
 162                     rest_args rest_reps }
 163   where
 164     target = CmmLit (CmmLabel lbl)
 165     (initial_reps, rest_reps) = splitAt arity reps
 166     arg_arity = count isNonV initial_reps
 167     (_, rest_args) = splitAt arg_arity args
 168
 169 --------------
 170 slow_call :: CmmExpr -> [CmmExpr] -> [LRep] -> FCode ()
 171 slow_call fun args reps
 172   = direct_call (mkRtsApFastLabel rts_fun) (arity+1)
 173                 (fun : args) (P : reps)
 174   where
 175     (rts_fun, arity) = slowCallPattern reps
 176
 177 -- These cases were found to cover about 99% of all slow calls:
 178 slowCallPattern :: [LRep] -> (LitString, Arity)
 179 -- Returns the generic apply function and arity
 180 slowCallPattern (P: P: P: P: P: P: _) = (sLit "stg_ap_pppppp", 6)
 181 slowCallPattern (P: P: P: P: P: _)    = (sLit "stg_ap_ppppp", 5)
 182 slowCallPattern (P: P: P: P: _)       = (sLit "stg_ap_pppp", 4)
 183 slowCallPattern (P: P: P: V: _)       = (sLit "stg_ap_pppv", 4)
 184 slowCallPattern (P: P: P: _)          = (sLit "stg_ap_ppp", 3)
 185 slowCallPattern (P: P: V: _)          = (sLit "stg_ap_ppv", 3)
 186 slowCallPattern (P: P: _)             = (sLit "stg_ap_pp", 2)
 187 slowCallPattern (P: V: _)             = (sLit "stg_ap_pv", 2)
 188 slowCallPattern (P: _)                = (sLit "stg_ap_p", 1)
 189 slowCallPattern (V: _)                = (sLit "stg_ap_v", 1)
 190 slowCallPattern (N: _)                = (sLit "stg_ap_n", 1)
 191 slowCallPattern (F: _)                = (sLit "stg_ap_f", 1)
 192 slowCallPattern (D: _)                = (sLit "stg_ap_d", 1)
 193 slowCallPattern (L: _)                = (sLit "stg_ap_l", 1)
 194 slowCallPattern []                    = (sLit "stg_ap_0", 0)
 195
 196
 197 -------------------------------------------------------------------------
 198 --      Classifying arguments: LRep
 199 -------------------------------------------------------------------------
 200
 201 -- LRep is not exported (even abstractly)
 202 -- It's a local helper type for classification
 203
 204 data LRep = P   -- GC Ptr
 205           | N   -- One-word non-ptr
 206           | L   -- Two-word non-ptr (long)
 207           | V   -- Void
 208           | F   -- Float
 209           | D   -- Double
 210
 211 toLRep :: PrimRep -> LRep
 212 toLRep VoidRep   = V
 213 toLRep PtrRep    = P
 214 toLRep IntRep    = N
 215 toLRep WordRep   = N
 216 toLRep AddrRep   = N
 217 toLRep Int64Rep  = L
 218 toLRep Word64Rep = L
 219 toLRep FloatRep  = F
 220 toLRep DoubleRep = D
 221
 222 isNonV :: LRep -> Bool
 223 isNonV V = False
 224 isNonV _ = True
 225
 226 argsLReps :: [StgArg] -> [LRep]
 227 argsLReps = map (toLRep . argPrimRep)
 228
 229 lRepSizeW :: LRep -> WordOff            -- Size in words
 230 lRepSizeW N = 1
 231 lRepSizeW P = 1
 232 lRepSizeW F = 1
 233 lRepSizeW L = wORD64_SIZE `quot` wORD_SIZE
 234 lRepSizeW D = dOUBLE_SIZE `quot` wORD_SIZE
 235 lRepSizeW V = 0
 236
 237 -------------------------------------------------------------------------
 238 ----    Laying out objects on the heap and stack
 239 -------------------------------------------------------------------------
 240
 241 -- The heap always grows upwards, so hpRel is easy
 242 hpRel :: VirtualHpOffset        -- virtual offset of Hp
 243       -> VirtualHpOffset        -- virtual offset of The Thing
 244       -> WordOff                -- integer word offset
 245 hpRel hp off = off - hp
 246
 247 getHpRelOffset :: VirtualHpOffset -> FCode CmmExpr
 248 getHpRelOffset virtual_offset
 249   = do  { hp_usg <- getHpUsage
 250         ; return (cmmRegOffW hpReg (hpRel (realHp hp_usg) virtual_offset)) }
 251
 252 mkVirtHeapOffsets
 253   :: Bool               -- True <=> is a thunk
 254   -> [(PrimRep,a)]      -- Things to make offsets for
 255   -> (WordOff,          -- _Total_ number of words allocated
 256       WordOff,          -- Number of words allocated for *pointers*
 257       [(a, VirtualHpOffset)])
 258
 259 -- Things with their offsets from start of object in order of
 260 -- increasing offset; BUT THIS MAY BE DIFFERENT TO INPUT ORDER
 261 -- First in list gets lowest offset, which is initial offset + 1.
 262 --
 263 -- Void arguments are removed, so output list may be shorter than
 264 -- input list
 265 --
 266 -- mkVirtHeapOffsets always returns boxed things with smaller offsets
 267 -- than the unboxed things
 268
 269 mkVirtHeapOffsets is_thunk things
 270   = let non_void_things               = filterOut (isVoidRep . fst)  things
 271         (ptrs, non_ptrs)              = partition (isGcPtrRep . fst) non_void_things
 272         (wds_of_ptrs, ptrs_w_offsets) = mapAccumL computeOffset 0 ptrs
 273         (tot_wds, non_ptrs_w_offsets) = mapAccumL computeOffset wds_of_ptrs non_ptrs
 274     in
 275     (tot_wds, wds_of_ptrs, ptrs_w_offsets ++ non_ptrs_w_offsets)
 276   where
 277     hdr_size    | is_thunk   = thunkHdrSize
 278                 | otherwise  = fixedHdrSize
 279
 280     computeOffset wds_so_far (rep, thing)
 281       = (wds_so_far + lRepSizeW (toLRep rep),
 282          (thing, hdr_size + wds_so_far))
 283
 284
 285 -------------------------------------------------------------------------
 286 --
 287 --      Making argument descriptors
 288 --
 289 --  An argument descriptor describes the layout of args on the stack,
 290 --  both for    * GC (stack-layout) purposes, and
 291 --              * saving/restoring registers when a heap-check fails
 292 --
 293 -- Void arguments aren't important, therefore (contrast constructSlowCall)
 294 --
 295 -------------------------------------------------------------------------
 296
 297 -- bring in ARG_P, ARG_N, etc.
 298 #include "../includes/StgFun.h"
 299
 300 -------------------------
 301 -- argDescrType :: ArgDescr -> StgHalfWord
 302 -- -- The "argument type" RTS field type
 303 -- argDescrType (ArgSpec n) = n
 304 -- argDescrType (ArgGen liveness)
 305 --   | isBigLiveness liveness = ARG_GEN_BIG
 306 --   | otherwise                   = ARG_GEN
 307
 308
 309 mkArgDescr :: Name -> [Id] -> FCode ArgDescr
 310 mkArgDescr nm args
 311   = case stdPattern arg_reps of
 312         Just spec_id -> return (ArgSpec spec_id)
 313         Nothing      -> do { liveness <- mkLiveness nm size bitmap
 314                            ; return (ArgGen liveness) }
 315   where
 316     arg_reps = filter isNonV (map (toLRep . idPrimRep) args)
 317         -- Getting rid of voids eases matching of standard patterns
 318
 319     bitmap   = mkBitmap arg_bits
 320     arg_bits = argBits arg_reps
 321     size     = length arg_bits
 322
 323 argBits :: [LRep] -> [Bool]     -- True for non-ptr, False for ptr
 324 argBits []              = []
 325 argBits (P   : args) = False : argBits args
 326 argBits (arg : args) = take (lRepSizeW arg) (repeat True) ++ argBits args
 327
 328 ----------------------
 329 stdPattern :: [LRep] -> Maybe StgHalfWord
 330 stdPattern reps
 331   = case reps of
 332         []  -> Just ARG_NONE    -- just void args, probably
 333         [N] -> Just ARG_N
 334         [P] -> Just ARG_N
 335         [F] -> Just ARG_F
 336         [D] -> Just ARG_D
 337         [L] -> Just ARG_L
 338
 339         [N,N] -> Just ARG_NN
 340         [N,P] -> Just ARG_NP
 341         [P,N] -> Just ARG_PN
 342         [P,P] -> Just ARG_PP
 343
 344         [N,N,N] -> Just ARG_NNN
 345         [N,N,P] -> Just ARG_NNP
 346         [N,P,N] -> Just ARG_NPN
 347         [N,P,P] -> Just ARG_NPP
 348         [P,N,N] -> Just ARG_PNN
 349         [P,N,P] -> Just ARG_PNP
 350         [P,P,N] -> Just ARG_PPN
 351         [P,P,P] -> Just ARG_PPP
 352
 353         [P,P,P,P]     -> Just ARG_PPPP
 354         [P,P,P,P,P]   -> Just ARG_PPPPP
 355         [P,P,P,P,P,P] -> Just ARG_PPPPPP
 356
 357         _ -> Nothing
 358
 359 -------------------------------------------------------------------------
 360 --
 361 --      Liveness info
 362 --
 363 -------------------------------------------------------------------------
 364
 365 -- TODO: This along with 'mkArgDescr' should be unified
 366 -- with 'CmmInfo.mkLiveness'.  However that would require
 367 -- potentially invasive changes to the 'ClosureInfo' type.
 368 -- For now, 'CmmInfo.mkLiveness' handles only continuations and
 369 -- this one handles liveness everything else.  Another distinction
 370 -- between these two is that 'CmmInfo.mkLiveness' information
 371 -- about the stack layout, and this one is information about
 372 -- the heap layout of PAPs.
 373 mkLiveness :: Name -> Int -> Bitmap -> FCode Liveness
 374 mkLiveness name size bits
 375   | size > mAX_SMALL_BITMAP_SIZE                -- Bitmap does not fit in one word
 376   = do  { let lbl = mkBitmapLabel (getUnique name)
 377         ; emitRODataLits lbl ( mkWordCLit (fromIntegral size)
 378                              : map mkWordCLit bits)
 379         ; return (BigLiveness lbl) }
 380
 381   | otherwise           -- Bitmap fits in one word
 382   = let
 383         small_bits = case bits of
 384                         []  -> 0
 385                         [b] -> fromIntegral b
 386                         _   -> panic "livenessToAddrMode"
 387     in
 388     return (smallLiveness size small_bits)
 389
 390 smallLiveness :: Int -> StgWord -> Liveness
 391 smallLiveness size small_bits = SmallLiveness bits
 392   where bits = fromIntegral size .|. (small_bits `shiftL` bITMAP_BITS_SHIFT)
 393
 394 -------------------
 395 -- isBigLiveness :: Liveness -> Bool
 396 -- isBigLiveness (BigLiveness _)   = True
 397 -- isBigLiveness (SmallLiveness _) = False
 398
 399 -------------------
 400 -- mkLivenessCLit :: Liveness -> CmmLit
 401 -- mkLivenessCLit (BigLiveness lbl)    = CmmLabel lbl
 402 -- mkLivenessCLit (SmallLiveness bits) = mkWordCLit bits
 403
 404
 405 -------------------------------------------------------------------------
 406 --
 407 --              Bitmap describing register liveness
 408 --              across GC when doing a "generic" heap check
 409 --              (a RET_DYN stack frame).
 410 --
 411 -- NB. Must agree with these macros (currently in StgMacros.h):
 412 -- GET_NON_PTRS(), GET_PTRS(), GET_LIVENESS().
 413 -------------------------------------------------------------------------
 414
 415 {-      Not used in new code gen
 416 mkRegLiveness :: [(Id, GlobalReg)] -> Int -> Int -> StgWord
 417 mkRegLiveness regs ptrs nptrs
 418   = (fromIntegral nptrs `shiftL` 16) .|.
 419     (fromIntegral ptrs  `shiftL` 24) .|.
 420     all_non_ptrs `xor` reg_bits regs
 421   where
 422     all_non_ptrs = 0xff
 423
 424     reg_bits [] = 0
 425     reg_bits ((id, VanillaReg i) : regs) | isGcPtrRep (idPrimRep id)
 426         = (1 `shiftL` (i - 1)) .|. reg_bits regs
 427     reg_bits (_ : regs)
 428         = reg_bits regs
 429 -}
 430
 431 -------------------------------------------------------------------------
 432 --
 433 --      Generating the info table and code for a closure
 434 --
 435 -------------------------------------------------------------------------
 436
 437 -- Here we make an info table of type 'CmmInfo'.  The concrete
 438 -- representation as a list of 'CmmAddr' is handled later
 439 -- in the pipeline by 'cmmToRawCmm'.
 440
 441 emitClosureCodeAndInfoTable :: ClosureInfo -> CmmFormals
 442                             -> CmmAGraph -> FCode ()
 443 emitClosureCodeAndInfoTable cl_info args body
 444  = do   { info <- mkCmmInfo cl_info
 445         ; emitProc info (infoLblToEntryLbl info_lbl) args body }
 446   where
 447     info_lbl = infoTableLabelFromCI cl_info
 448
 449 -- Convert from 'ClosureInfo' to 'CmmInfo'.
 450 -- Not used for return points.  (The 'smRepClosureTypeInt' call would panic.)
 451 mkCmmInfo :: ClosureInfo -> FCode CmmInfo
 452 mkCmmInfo cl_info
 453   = do  { prof <- if opt_SccProfilingOn then
 454                     do fd_lit <- mkStringCLit (closureTypeDescr cl_info)
 455                        ad_lit <- mkStringCLit (closureValDescr  cl_info)
 456                        return $ ProfilingInfo fd_lit ad_lit
 457                   else return $ ProfilingInfo (mkIntCLit 0) (mkIntCLit 0)
 458         ; return (CmmInfo gc_target Nothing (CmmInfoTable prof cl_type info)) }
 459   where
 460     info = closureTypeInfo cl_info
 461     cl_type  = smRepClosureTypeInt (closureSMRep cl_info)
 462
 463     -- The gc_target is to inform the CPS pass when it inserts a stack check.
 464     -- Since that pass isn't used yet we'll punt for now.
 465     -- When the CPS pass is fully integrated, this should
 466     -- be replaced by the label that any heap check jumped to,
 467     -- so that branch can be shared by both the heap (from codeGen)
 468     -- and stack checks (from the CPS pass).
 469     -- JD: Actually, we've decided to go a different route here:
 470     --     the code generator is now responsible for producing the
 471     --     stack limit check explicitly, so this field is now obsolete.
 472     gc_target = Nothing
 473
 474 -----------------------------------------------------------------------------
 475 --
 476 --      Info table offsets
 477 --
 478 -----------------------------------------------------------------------------
 479
 480 stdInfoTableSizeW :: WordOff
 481 -- The size of a standard info table varies with profiling/ticky etc,
 482 -- so we can't get it from Constants
 483 -- It must vary in sync with mkStdInfoTable
 484 stdInfoTableSizeW
 485   = size_fixed + size_prof
 486   where
 487     size_fixed = 2      -- layout, type
 488     size_prof | opt_SccProfilingOn = 2
 489               | otherwise          = 0
 490
 491 stdInfoTableSizeB  :: ByteOff
 492 stdInfoTableSizeB = stdInfoTableSizeW * wORD_SIZE :: ByteOff
 493
 494 stdSrtBitmapOffset :: ByteOff
 495 -- Byte offset of the SRT bitmap half-word which is
 496 -- in the *higher-addressed* part of the type_lit
 497 stdSrtBitmapOffset = stdInfoTableSizeB - hALF_WORD_SIZE
 498
 499 stdClosureTypeOffset :: ByteOff
 500 -- Byte offset of the closure type half-word
 501 stdClosureTypeOffset = stdInfoTableSizeB - wORD_SIZE
 502
 503 stdPtrsOffset, stdNonPtrsOffset :: ByteOff
 504 stdPtrsOffset    = stdInfoTableSizeB - 2*wORD_SIZE
 505 stdNonPtrsOffset = stdInfoTableSizeB - 2*wORD_SIZE + hALF_WORD_SIZE
 506
 507 -------------------------------------------------------------------------
 508 --
 509 --      Accessing fields of an info table
 510 --
 511 -------------------------------------------------------------------------
 512
 513 closureInfoPtr :: CmmExpr -> CmmExpr
 514 -- Takes a closure pointer and returns the info table pointer
 515 closureInfoPtr e = CmmLoad e bWord
 516
 517 entryCode :: CmmExpr -> CmmExpr
 518 -- Takes an info pointer (the first word of a closure)
 519 -- and returns its entry code
 520 entryCode e | tablesNextToCode = e
 521             | otherwise        = CmmLoad e bWord
 522
 523 getConstrTag :: CmmExpr -> CmmExpr
 524 -- Takes a closure pointer, and return the *zero-indexed*
 525 -- constructor tag obtained from the info table
 526 -- This lives in the SRT field of the info table
 527 -- (constructors don't need SRTs).
 528 getConstrTag closure_ptr
 529   = CmmMachOp (MO_UU_Conv halfWordWidth wordWidth) [infoTableConstrTag info_table]
 530   where
 531     info_table = infoTable (closureInfoPtr closure_ptr)
 532
 533 cmmGetClosureType :: CmmExpr -> CmmExpr
 534 -- Takes a closure pointer, and return the closure type
 535 -- obtained from the info table
 536 cmmGetClosureType closure_ptr
 537   = CmmMachOp (MO_UU_Conv halfWordWidth wordWidth) [infoTableClosureType info_table]
 538   where
 539     info_table = infoTable (closureInfoPtr closure_ptr)
 540
 541 infoTable :: CmmExpr -> CmmExpr
 542 -- Takes an info pointer (the first word of a closure)
 543 -- and returns a pointer to the first word of the standard-form
 544 -- info table, excluding the entry-code word (if present)
 545 infoTable info_ptr
 546   | tablesNextToCode = cmmOffsetB info_ptr (- stdInfoTableSizeB)
 547   | otherwise        = cmmOffsetW info_ptr 1    -- Past the entry code pointer
 548
 549 infoTableConstrTag :: CmmExpr -> CmmExpr
 550 -- Takes an info table pointer (from infoTable) and returns the constr tag
 551 -- field of the info table (same as the srt_bitmap field)
 552 infoTableConstrTag = infoTableSrtBitmap
 553
 554 infoTableSrtBitmap :: CmmExpr -> CmmExpr
 555 -- Takes an info table pointer (from infoTable) and returns the srt_bitmap
 556 -- field of the info table
 557 infoTableSrtBitmap info_tbl
 558   = CmmLoad (cmmOffsetB info_tbl stdSrtBitmapOffset) bHalfWord
 559
 560 infoTableClosureType :: CmmExpr -> CmmExpr
 561 -- Takes an info table pointer (from infoTable) and returns the closure type
 562 -- field of the info table.
 563 infoTableClosureType info_tbl
 564   = CmmLoad (cmmOffsetB info_tbl stdClosureTypeOffset) bHalfWord
 565
 566 infoTablePtrs :: CmmExpr -> CmmExpr
 567 infoTablePtrs info_tbl
 568   = CmmLoad (cmmOffsetB info_tbl stdPtrsOffset) bHalfWord
 569
 570 infoTableNonPtrs :: CmmExpr -> CmmExpr
 571 infoTableNonPtrs info_tbl
 572   = CmmLoad (cmmOffsetB info_tbl stdNonPtrsOffset) bHalfWord
 573
 574 funInfoTable :: CmmExpr -> CmmExpr
 575 -- Takes the info pointer of a function,
 576 -- and returns a pointer to the first word of the StgFunInfoExtra struct
 577 -- in the info table.
 578 funInfoTable info_ptr
 579   | tablesNextToCode
 580   = cmmOffsetB info_ptr (- stdInfoTableSizeB - sIZEOF_StgFunInfoExtraRev)
 581   | otherwise
 582   = cmmOffsetW info_ptr (1 + stdInfoTableSizeW)
 583                                 -- Past the entry code pointer
 584
 585 -------------------------------------------------------------------------
 586 --
 587 --      Static reference tables
 588 --
 589 -------------------------------------------------------------------------
 590
 591 -- srtLabelAndLength :: C_SRT -> CLabel -> (CmmLit, StgHalfWord)
 592 -- srtLabelAndLength NoC_SRT _
 593 --   = (zeroCLit, 0)
 594 -- srtLabelAndLength (C_SRT lbl off bitmap) info_lbl
 595 --   = (makeRelativeRefTo info_lbl $ cmmLabelOffW lbl off, bitmap)
 596
 597 -------------------------------------------------------------------------
 598 --
 599 --      Position independent code
 600 --
 601 -------------------------------------------------------------------------
 602 -- In order to support position independent code, we mustn't put absolute
 603 -- references into read-only space. Info tables in the tablesNextToCode
 604 -- case must be in .text, which is read-only, so we doctor the CmmLits
 605 -- to use relative offsets instead.
 606
 607 -- Note that this is done even when the -fPIC flag is not specified,
 608 -- as we want to keep binary compatibility between PIC and non-PIC.
 609
 610 makeRelativeRefTo :: CLabel -> CmmLit -> CmmLit
 611
 612 makeRelativeRefTo info_lbl (CmmLabel lbl)
 613   | tablesNextToCode
 614   = CmmLabelDiffOff lbl info_lbl 0
 615 makeRelativeRefTo info_lbl (CmmLabelOff lbl off)
 616   | tablesNextToCode
 617   = CmmLabelDiffOff lbl info_lbl off
 618 makeRelativeRefTo _ lit = lit