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