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         getSRTInfo,
  14         emitDirectReturnTarget, emitAlgReturnTarget,
  15         emitDirectReturnInstr, emitVectoredReturnInstr,
  16         mkRetInfoTable,
  17         mkStdInfoTable,
  18         stdInfoTableSizeB,
  19         mkFunGenInfoExtraBits,
  20         entryCode, closureInfoPtr,
  21         getConstrTag,
  22         infoTable, infoTableClosureType,
  23         infoTablePtrs, infoTableNonPtrs,
  24         funInfoTable,
  25         retVec
  26   ) where
  27
  28
  29 #include "HsVersions.h"
  30
  31 import ClosureInfo
  32 import SMRep
  33 import CgBindery
  34 import CgCallConv
  35 import CgUtils
  36 import CgMonad
  37
  38 import CmmUtils
  39 import Cmm
  40 import MachOp
  41 import CLabel
  42 import StgSyn
  43 import Name
  44 import DataCon
  45 import Unique
  46 import DynFlags
  47 import StaticFlags
  48
  49 import ListSetOps
  50 import Maybes
  51 import Constants
  52
  53 import Outputable
  54
  55 -------------------------------------------------------------------------
  56 --
  57 --      Generating the info table and code for a closure
  58 --
  59 -------------------------------------------------------------------------
  60
  61 -- Here we make a concrete info table, represented as a list of CmmAddr
  62 -- (it can't be simply a list of Word, because the SRT field is
  63 -- represented by a label+offset expression).
  64
  65 -- With tablesNextToCode, the layout is
  66 --      <reversed variable part>
  67 --      <normal forward StgInfoTable, but without
  68 --              an entry point at the front>
  69 --      <code>
  70 --
  71 -- Without tablesNextToCode, the layout of an info table is
  72 --      <entry label>
  73 --      <normal forward rest of StgInfoTable>
  74 --      <forward variable part>
  75 --
  76 --      See includes/InfoTables.h
  77
  78 emitClosureCodeAndInfoTable :: ClosureInfo -> [LocalReg] -> CgStmts -> Code
  79 emitClosureCodeAndInfoTable cl_info args body
  80  = do   { ty_descr_lit <-
  81                 if opt_SccProfilingOn
  82                    then mkStringCLit (closureTypeDescr cl_info)
  83                    else return (mkIntCLit 0)
  84         ; cl_descr_lit <-
  85                 if opt_SccProfilingOn
  86                    then mkStringCLit cl_descr_string
  87                    else return (mkIntCLit 0)
  88         ; let std_info = mkStdInfoTable ty_descr_lit cl_descr_lit
  89                                         cl_type srt_len layout_lit
  90
  91         ; blks <- cgStmtsToBlocks body
  92
  93         ; conName <-
  94              if is_con
  95                 then mkStringCLit $ fromJust conIdentity
  96                 else return (mkIntCLit 0)
  97
  98         ; emitInfoTableAndCode info_lbl std_info (extra_bits conName) args blks }
  99   where
 100     info_lbl  = infoTableLabelFromCI cl_info
 101
 102     cl_descr_string = closureValDescr cl_info
 103     cl_type = smRepClosureTypeInt (closureSMRep cl_info)
 104
 105     srt = closureSRT cl_info
 106     needs_srt = needsSRT srt
 107
 108     mb_con = isConstrClosure_maybe  cl_info
 109     is_con = isJust mb_con
 110
 111     (srt_label,srt_len,conIdentity)
 112         = case mb_con of
 113             Just con -> -- Constructors don't have an SRT
 114                         -- We keep the *zero-indexed* tag in the srt_len
 115                         -- field of the info table.
 116                         (mkIntCLit 0, fromIntegral (dataConTagZ con), Just $ dataConIdentity con)
 117
 118             Nothing  -> -- Not a constructor
 119                         let (label, len) = srtLabelAndLength srt info_lbl
 120                         in (label, len, Nothing)
 121
 122     ptrs       = closurePtrsSize cl_info
 123     nptrs      = size - ptrs
 124     size       = closureNonHdrSize cl_info
 125     layout_lit = packHalfWordsCLit ptrs nptrs
 126
 127     extra_bits conName
 128         | is_fun    = fun_extra_bits
 129         | is_con    = [conName]
 130         | needs_srt = [srt_label]
 131         | otherwise = []
 132
 133     maybe_fun_stuff = closureFunInfo cl_info
 134     is_fun = isJust maybe_fun_stuff
 135     (Just (arity, arg_descr)) = maybe_fun_stuff
 136
 137     fun_extra_bits
 138         | ArgGen liveness <- arg_descr
 139         = [ fun_amode,
 140             srt_label,
 141             makeRelativeRefTo info_lbl $ mkLivenessCLit liveness,
 142             slow_entry ]
 143         | needs_srt = [fun_amode, srt_label]
 144         | otherwise = [fun_amode]
 145
 146     slow_entry = makeRelativeRefTo info_lbl (CmmLabel slow_entry_label)
 147     slow_entry_label = mkSlowEntryLabel (closureName cl_info)
 148
 149     fun_amode = packHalfWordsCLit fun_type arity
 150     fun_type  = argDescrType arg_descr
 151
 152 -- We keep the *zero-indexed* tag in the srt_len field of the info
 153 -- table of a data constructor.
 154 dataConTagZ :: DataCon -> ConTagZ
 155 dataConTagZ con = dataConTag con - fIRST_TAG
 156
 157 -- A low-level way to generate the variable part of a fun-style info table.
 158 -- (must match fun_extra_bits above).  Used by the C-- parser.
 159 mkFunGenInfoExtraBits :: Int -> Int -> CmmLit -> CmmLit -> CmmLit -> [CmmLit]
 160 mkFunGenInfoExtraBits fun_type arity srt_label liveness slow_entry
 161   = [ packHalfWordsCLit fun_type arity,
 162       srt_label,
 163       liveness,
 164       slow_entry ]
 165
 166 -------------------------------------------------------------------------
 167 --
 168 --      Generating the info table and code for a return point
 169 --
 170 -------------------------------------------------------------------------
 171
 172 --      Here's the layout of a return-point info table
 173 --
 174 -- Tables next to code:
 175 --
 176 --                      <reversed vector table>
 177 --                      <srt slot>
 178 --                      <standard info table>
 179 --      ret-addr -->    <entry code (if any)>
 180 --
 181 -- Not tables-next-to-code:
 182 --
 183 --      ret-addr -->    <ptr to entry code>
 184 --                      <standard info table>
 185 --                      <srt slot>
 186 --                      <forward vector table>
 187 --
 188 --  * The vector table is only present for vectored returns
 189 --
 190 --  * The SRT slot is only there if either
 191 --      (a) there is SRT info to record, OR
 192 --      (b) if the return is vectored
 193 --   The latter (b) is necessary so that the vector is in a
 194 --   predictable place
 195
 196 vectorSlot :: CmmExpr -> CmmExpr -> CmmExpr
 197 -- Get the vector slot from the info pointer
 198 vectorSlot info_amode zero_indexed_tag
 199   | tablesNextToCode
 200   = cmmOffsetExprW (cmmOffsetW info_amode (- (stdInfoTableSizeW + 2)))
 201                    (cmmNegate zero_indexed_tag)
 202         -- The "2" is one for the SRT slot, and one more
 203         -- to get to the first word of the vector
 204
 205   | otherwise
 206   = cmmOffsetExprW (cmmOffsetW info_amode (stdInfoTableSizeW + 2))
 207                    zero_indexed_tag
 208         -- The "2" is one for the entry-code slot and one for the SRT slot
 209
 210 retVec :: CmmExpr -> CmmExpr -> CmmExpr
 211 -- Get a return vector from the info pointer
 212 retVec info_amode zero_indexed_tag
 213   = let slot = vectorSlot info_amode zero_indexed_tag
 214         table_slot = CmmLoad slot wordRep
 215 #if defined(x86_64_TARGET_ARCH)
 216         offset_slot = CmmMachOp (MO_S_Conv I32 I64) [CmmLoad slot I32]
 217         -- offsets are 32-bits on x86-64, due to the inability of
 218         -- the tools to handle 64-bit PC-relative relocations.  See also
 219         -- PprMach.pprDataItem, and InfoTables.h:OFFSET_FIELD().
 220 #else
 221         offset_slot = table_slot
 222 #endif
 223     in if tablesNextToCode
 224            then CmmMachOp (MO_Add wordRep) [offset_slot, info_amode]
 225            else table_slot
 226
 227 emitReturnTarget
 228    :: Name
 229    -> CgStmts                   -- The direct-return code (if any)
 230                                 --      (empty for vectored returns)
 231    -> [CmmLit]                  -- Vector of return points
 232                                 --      (empty for non-vectored returns)
 233    -> SRT
 234    -> FCode CLabel
 235 emitReturnTarget name stmts vector srt
 236   = do  { live_slots <- getLiveStackSlots
 237         ; liveness   <- buildContLiveness name live_slots
 238         ; srt_info   <- getSRTInfo name srt
 239
 240         ; let
 241               cl_type = case (null vector, isBigLiveness liveness) of
 242                          (True,  True)  -> rET_BIG
 243                          (True,  False) -> rET_SMALL
 244                          (False, True)  -> rET_VEC_BIG
 245                          (False, False) -> rET_VEC_SMALL
 246
 247               (std_info, extra_bits) =
 248                    mkRetInfoTable info_lbl liveness srt_info cl_type vector
 249
 250         ; blks <- cgStmtsToBlocks stmts
 251         ; emitInfoTableAndCode info_lbl std_info extra_bits args blks
 252         ; return info_lbl }
 253   where
 254     args      = {- trace "emitReturnTarget: missing args" -} []
 255     uniq      = getUnique name
 256     info_lbl  = mkReturnInfoLabel uniq
 257
 258
 259 mkRetInfoTable
 260   :: CLabel             -- info label
 261   -> Liveness           -- liveness
 262   -> C_SRT              -- SRT Info
 263   -> Int                -- type (eg. rET_SMALL)
 264   -> [CmmLit]           -- vector
 265   -> ([CmmLit],[CmmLit])
 266 mkRetInfoTable info_lbl liveness srt_info cl_type vector
 267   =  (std_info, extra_bits)
 268   where
 269         (srt_label, srt_len) = srtLabelAndLength srt_info info_lbl
 270
 271         srt_slot | need_srt  = [srt_label]
 272                  | otherwise = []
 273
 274         need_srt = needsSRT srt_info || not (null vector)
 275                 -- If there's a vector table then we must allocate
 276                 -- an SRT slot, so that the vector table is at a
 277                 -- known offset from the info pointer
 278
 279         liveness_lit = makeRelativeRefTo info_lbl $ mkLivenessCLit liveness
 280         std_info = mkStdInfoTable zeroCLit zeroCLit cl_type srt_len liveness_lit
 281         extra_bits = srt_slot ++ map (makeRelativeRefTo info_lbl) vector
 282
 283
 284 emitDirectReturnTarget
 285    :: Name
 286    -> CgStmts           -- The direct-return code
 287    -> SRT
 288    -> FCode CLabel
 289 emitDirectReturnTarget name code srt
 290   = emitReturnTarget name code [] srt
 291
 292 emitAlgReturnTarget
 293         :: Name                         -- Just for its unique
 294         -> [(ConTagZ, CgStmts)]         -- Tagged branches
 295         -> Maybe CgStmts                -- Default branch (if any)
 296         -> SRT                          -- Continuation's SRT
 297         -> CtrlReturnConvention
 298         -> FCode (CLabel, SemiTaggingStuff)
 299
 300 emitAlgReturnTarget name branches mb_deflt srt ret_conv
 301   = case ret_conv of
 302       UnvectoredReturn fam_sz -> do
 303         { blks <- getCgStmts $
 304                     emitSwitch tag_expr branches mb_deflt 0 (fam_sz - 1)
 305                 -- NB: tag_expr is zero-based
 306         ; lbl <- emitDirectReturnTarget name blks srt
 307         ; return (lbl, Nothing) }
 308                 -- Nothing: the internal branches in the switch don't have
 309                 -- global labels, so we can't use them at the 'call site'
 310
 311       VectoredReturn fam_sz -> do
 312         { let tagged_lbls = zip (map fst branches) $
 313                             map (CmmLabel . mkAltLabel uniq . fst) branches
 314               deflt_lbl | isJust mb_deflt = CmmLabel $ mkDefaultLabel uniq
 315                         | otherwise       = mkIntCLit 0
 316         ; let vector = [ assocDefault deflt_lbl tagged_lbls i
 317                        | i <- [0..fam_sz-1]]
 318         ; lbl <- emitReturnTarget name noCgStmts vector srt
 319         ; mapFCs emit_alt branches
 320         ; emit_deflt mb_deflt
 321         ; return (lbl, Just (tagged_lbls, deflt_lbl)) }
 322   where
 323     uniq = getUnique name
 324     tag_expr = getConstrTag (CmmReg nodeReg)
 325
 326     emit_alt :: (Int, CgStmts) -> FCode (Int, CmmLit)
 327         -- Emit the code for the alternative as a top-level
 328         -- code block returning a label for it
 329     emit_alt (tag, stmts) = do   { let lbl = mkAltLabel uniq tag
 330                                  ; blks <- cgStmtsToBlocks stmts
 331                                  ; emitProc [] lbl [] blks
 332                                  ; return (tag, CmmLabel lbl) }
 333
 334     emit_deflt (Just stmts) = do { let lbl = mkDefaultLabel uniq
 335                                  ; blks <- cgStmtsToBlocks stmts
 336                                  ; emitProc [] lbl [] blks
 337                                  ; return (CmmLabel lbl) }
 338     emit_deflt Nothing = return (mkIntCLit 0)
 339                 -- Nothing case: the simplifier might have eliminated a case
 340                 --               so we may have e.g. case xs of
 341                 --                                       [] -> e
 342                 -- In that situation the default should never be taken,
 343                 -- so we just use a NULL pointer
 344
 345 --------------------------------
 346 emitDirectReturnInstr :: Code
 347 emitDirectReturnInstr
 348   = do  { info_amode <- getSequelAmode
 349         ; stmtC (CmmJump (entryCode info_amode) []) }
 350
 351 emitVectoredReturnInstr :: CmmExpr      -- _Zero-indexed_ constructor tag
 352                         -> Code
 353 emitVectoredReturnInstr zero_indexed_tag
 354   = do  { info_amode <- getSequelAmode
 355                 -- HACK! assign info_amode to a temp, because retVec
 356                 -- uses it twice and the NCG doesn't have any CSE yet.
 357                 -- Only do this for the NCG, because gcc is too stupid
 358                 -- to optimise away the extra tmp (grrr).
 359         ; dflags <- getDynFlags
 360         ; x <- if hscTarget dflags == HscAsm
 361                    then do z <- newTemp wordRep
 362                            stmtC (CmmAssign z info_amode)
 363                            return (CmmReg z)
 364                    else
 365                         return info_amode
 366         ; let target = retVec x zero_indexed_tag
 367         ; stmtC (CmmJump target []) }
 368
 369
 370 -------------------------------------------------------------------------
 371 --
 372 --      Generating a standard info table
 373 --
 374 -------------------------------------------------------------------------
 375
 376 -- The standard bits of an info table.  This part of the info table
 377 -- corresponds to the StgInfoTable type defined in InfoTables.h.
 378 --
 379 -- Its shape varies with ticky/profiling/tables next to code etc
 380 -- so we can't use constant offsets from Constants
 381
 382 mkStdInfoTable
 383    :: CmmLit            -- closure type descr (profiling)
 384    -> CmmLit            -- closure descr (profiling)
 385    -> Int               -- closure type
 386    -> StgHalfWord       -- SRT length
 387    -> CmmLit            -- layout field
 388    -> [CmmLit]
 389
 390 mkStdInfoTable type_descr closure_descr cl_type srt_len layout_lit
 391  =      -- Parallel revertible-black hole field
 392     prof_info
 393         -- Ticky info (none at present)
 394         -- Debug info (none at present)
 395  ++ [layout_lit, type_lit]
 396
 397  where
 398     prof_info
 399         | opt_SccProfilingOn = [type_descr, closure_descr]
 400         | otherwise          = []
 401
 402     type_lit = packHalfWordsCLit cl_type srt_len
 403
 404 stdInfoTableSizeW :: WordOff
 405 -- The size of a standard info table varies with profiling/ticky etc,
 406 -- so we can't get it from Constants
 407 -- It must vary in sync with mkStdInfoTable
 408 stdInfoTableSizeW
 409   = size_fixed + size_prof
 410   where
 411     size_fixed = 2      -- layout, type
 412     size_prof | opt_SccProfilingOn = 2
 413               | otherwise          = 0
 414
 415 stdInfoTableSizeB = stdInfoTableSizeW * wORD_SIZE :: ByteOff
 416
 417 stdSrtBitmapOffset :: ByteOff
 418 -- Byte offset of the SRT bitmap half-word which is
 419 -- in the *higher-addressed* part of the type_lit
 420 stdSrtBitmapOffset = stdInfoTableSizeB - hALF_WORD_SIZE
 421
 422 stdClosureTypeOffset :: ByteOff
 423 -- Byte offset of the closure type half-word
 424 stdClosureTypeOffset = stdInfoTableSizeB - wORD_SIZE
 425
 426 stdPtrsOffset, stdNonPtrsOffset :: ByteOff
 427 stdPtrsOffset    = stdInfoTableSizeB - 2*wORD_SIZE
 428 stdNonPtrsOffset = stdInfoTableSizeB - 2*wORD_SIZE + hALF_WORD_SIZE
 429
 430 -------------------------------------------------------------------------
 431 --
 432 --      Accessing fields of an info table
 433 --
 434 -------------------------------------------------------------------------
 435
 436 closureInfoPtr :: CmmExpr -> CmmExpr
 437 -- Takes a closure pointer and returns the info table pointer
 438 closureInfoPtr e = CmmLoad e wordRep
 439
 440 entryCode :: CmmExpr -> CmmExpr
 441 -- Takes an info pointer (the first word of a closure)
 442 -- and returns its entry code
 443 entryCode e | tablesNextToCode = e
 444             | otherwise        = CmmLoad e wordRep
 445
 446 getConstrTag :: CmmExpr -> CmmExpr
 447 -- Takes a closure pointer, and return the *zero-indexed*
 448 -- constructor tag obtained from the info table
 449 -- This lives in the SRT field of the info table
 450 -- (constructors don't need SRTs).
 451 getConstrTag closure_ptr
 452   = CmmMachOp (MO_U_Conv halfWordRep wordRep) [infoTableConstrTag info_table]
 453   where
 454     info_table = infoTable (closureInfoPtr closure_ptr)
 455
 456 infoTable :: CmmExpr -> CmmExpr
 457 -- Takes an info pointer (the first word of a closure)
 458 -- and returns a pointer to the first word of the standard-form
 459 -- info table, excluding the entry-code word (if present)
 460 infoTable info_ptr
 461   | tablesNextToCode = cmmOffsetB info_ptr (- stdInfoTableSizeB)
 462   | otherwise        = cmmOffsetW info_ptr 1    -- Past the entry code pointer
 463
 464 infoTableConstrTag :: CmmExpr -> CmmExpr
 465 -- Takes an info table pointer (from infoTable) and returns the constr tag
 466 -- field of the info table (same as the srt_bitmap field)
 467 infoTableConstrTag = infoTableSrtBitmap
 468
 469 infoTableSrtBitmap :: CmmExpr -> CmmExpr
 470 -- Takes an info table pointer (from infoTable) and returns the srt_bitmap
 471 -- field of the info table
 472 infoTableSrtBitmap info_tbl
 473   = CmmLoad (cmmOffsetB info_tbl stdSrtBitmapOffset) halfWordRep
 474
 475 infoTableClosureType :: CmmExpr -> CmmExpr
 476 -- Takes an info table pointer (from infoTable) and returns the closure type
 477 -- field of the info table.
 478 infoTableClosureType info_tbl
 479   = CmmLoad (cmmOffsetB info_tbl stdClosureTypeOffset) halfWordRep
 480
 481 infoTablePtrs :: CmmExpr -> CmmExpr
 482 infoTablePtrs info_tbl
 483   = CmmLoad (cmmOffsetB info_tbl stdPtrsOffset) halfWordRep
 484
 485 infoTableNonPtrs :: CmmExpr -> CmmExpr
 486 infoTableNonPtrs info_tbl
 487   = CmmLoad (cmmOffsetB info_tbl stdNonPtrsOffset) halfWordRep
 488
 489 funInfoTable :: CmmExpr -> CmmExpr
 490 -- Takes the info pointer of a function,
 491 -- and returns a pointer to the first word of the StgFunInfoExtra struct
 492 -- in the info table.
 493 funInfoTable info_ptr
 494   | tablesNextToCode
 495   = cmmOffsetB info_ptr (- stdInfoTableSizeB - sIZEOF_StgFunInfoExtraRev)
 496   | otherwise
 497   = cmmOffsetW info_ptr (1 + stdInfoTableSizeW)
 498                                 -- Past the entry code pointer
 499
 500 -------------------------------------------------------------------------
 501 --
 502 --      Emit the code for a closure (or return address)
 503 --      and its associated info table
 504 --
 505 -------------------------------------------------------------------------
 506
 507 -- The complication here concerns whether or not we can
 508 -- put the info table next to the code
 509
 510 emitInfoTableAndCode
 511         :: CLabel               -- Label of info table
 512         -> [CmmLit]             -- ...its invariant part
 513         -> [CmmLit]             -- ...and its variant part
 514         -> [LocalReg]           -- ...args
 515         -> [CmmBasicBlock]      -- ...and body
 516         -> Code
 517
 518 emitInfoTableAndCode info_lbl std_info extra_bits args blocks
 519   | tablesNextToCode    -- Reverse the extra_bits; and emit the top-level proc
 520   = emitProc (reverse extra_bits ++ std_info)
 521              entry_lbl args blocks
 522         -- NB: the info_lbl is discarded
 523
 524   | null blocks -- No actual code; only the info table is significant
 525   =             -- Use a zero place-holder in place of the
 526                 -- entry-label in the info table
 527     emitRODataLits info_lbl (zeroCLit : std_info ++ extra_bits)
 528
 529   | otherwise   -- Separately emit info table (with the function entry
 530   =             -- point as first entry) and the entry code
 531     do  { emitDataLits info_lbl (CmmLabel entry_lbl : std_info ++ extra_bits)
 532         ; emitProc [] entry_lbl args blocks }
 533
 534   where
 535         entry_lbl = infoLblToEntryLbl info_lbl
 536
 537 -------------------------------------------------------------------------
 538 --
 539 --      Static reference tables
 540 --
 541 -------------------------------------------------------------------------
 542
 543 -- There is just one SRT for each top level binding; all the nested
 544 -- bindings use sub-sections of this SRT.  The label is passed down to
 545 -- the nested bindings via the monad.
 546
 547 getSRTInfo :: Name -> SRT -> FCode C_SRT
 548 getSRTInfo id NoSRT = return NoC_SRT
 549 getSRTInfo id (SRT off len bmp)
 550   | len > hALF_WORD_SIZE_IN_BITS || bmp == [fromIntegral srt_escape]
 551   = do  { srt_lbl <- getSRTLabel
 552         ; let srt_desc_lbl = mkSRTDescLabel id
 553         ; emitRODataLits srt_desc_lbl
 554                    ( cmmLabelOffW srt_lbl off
 555                    : mkWordCLit (fromIntegral len)
 556                    : map mkWordCLit bmp)
 557         ; return (C_SRT srt_desc_lbl 0 srt_escape) }
 558
 559   | otherwise
 560   = do  { srt_lbl <- getSRTLabel
 561         ; return (C_SRT srt_lbl off (fromIntegral (head bmp))) }
 562                 -- The fromIntegral converts to StgHalfWord
 563
 564 srt_escape = (-1) :: StgHalfWord
 565
 566 srtLabelAndLength :: C_SRT -> CLabel -> (CmmLit, StgHalfWord)
 567 srtLabelAndLength NoC_SRT _
 568   = (zeroCLit, 0)
 569 srtLabelAndLength (C_SRT lbl off bitmap) info_lbl
 570   = (makeRelativeRefTo info_lbl $ cmmLabelOffW lbl off, bitmap)
 571
 572 -------------------------------------------------------------------------
 573 --
 574 --      Position independent code
 575 --
 576 -------------------------------------------------------------------------
 577 -- In order to support position independent code, we mustn't put absolute
 578 -- references into read-only space. Info tables in the tablesNextToCode
 579 -- case must be in .text, which is read-only, so we doctor the CmmLits
 580 -- to use relative offsets instead.
 581
 582 -- Note that this is done even when the -fPIC flag is not specified,
 583 -- as we want to keep binary compatibility between PIC and non-PIC.
 584
 585 makeRelativeRefTo :: CLabel -> CmmLit -> CmmLit
 586
 587 makeRelativeRefTo info_lbl (CmmLabel lbl)
 588   | tablesNextToCode
 589   = CmmLabelDiffOff lbl info_lbl 0
 590 makeRelativeRefTo info_lbl (CmmLabelOff lbl off)
 591   | tablesNextToCode
 592   = CmmLabelDiffOff lbl info_lbl off
 593 makeRelativeRefTo _ lit = lit