compiler/nativeGen/RegLiveness.hs

   1 -----------------------------------------------------------------------------
   2 --
   3 -- The register liveness determinator
   4 --
   5 -- (c) The University of Glasgow 2004
   6 --
   7 -----------------------------------------------------------------------------
   8 {-# OPTIONS -fno-warn-missing-signatures #-}
   9
  10 module RegLiveness (
  11         RegSet,
  12         RegMap, emptyRegMap,
  13         BlockMap, emptyBlockMap,
  14         LiveCmmTop,
  15         LiveInstr (..),
  16         Liveness (..),
  17         LiveInfo (..),
  18         LiveBasicBlock,
  19
  20         mapBlockTop,    mapBlockTopM,
  21         mapGenBlockTop, mapGenBlockTopM,
  22         stripLive,
  23         spillNatBlock,
  24         slurpConflicts,
  25         lifetimeCount,
  26         eraseDeltasLive,
  27         patchEraseLive,
  28         patchRegsLiveInstr,
  29         regLiveness
  30
  31   ) where
  32
  33 #include "HsVersions.h"
  34
  35 import MachRegs
  36 import MachInstrs
  37 import PprMach
  38 import RegAllocInfo
  39 import Cmm
  40
  41 import Digraph
  42 import Outputable
  43 import Unique
  44 import UniqSet
  45 import UniqFM
  46 import UniqSupply
  47 import Bag
  48 import State
  49
  50 import Data.List
  51 import Data.Maybe
  52
  53 -----------------------------------------------------------------------------
  54 type RegSet = UniqSet Reg
  55
  56 type RegMap a = UniqFM a
  57
  58 emptyRegMap :: UniqFM a
  59 emptyRegMap = emptyUFM
  60
  61 type BlockMap a = UniqFM a
  62
  63 emptyBlockMap :: UniqFM a
  64 emptyBlockMap = emptyUFM
  65
  66
  67 -- | A top level thing which carries liveness information.
  68 type LiveCmmTop
  69         = GenCmmTop
  70                 CmmStatic
  71                 LiveInfo
  72                 (ListGraph (GenBasicBlock LiveInstr))
  73                         -- the "instructions" here are actually more blocks,
  74                         --      single blocks are acyclic
  75                         --      multiple blocks are taken to be cyclic.
  76
  77 -- | An instruction with liveness information.
  78 data LiveInstr
  79         = Instr Instr (Maybe Liveness)
  80
  81 -- | Liveness information.
  82 --      The regs which die are ones which are no longer live in the *next* instruction
  83 --      in this sequence.
  84 --      (NB. if the instruction is a jump, these registers might still be live
  85 --      at the jump target(s) - you have to check the liveness at the destination
  86 --      block to find out).
  87
  88 data Liveness
  89         = Liveness
  90         { liveBorn      :: RegSet       -- ^ registers born in this instruction (written to for first time).
  91         , liveDieRead   :: RegSet       -- ^ registers that died because they were read for the last time.
  92         , liveDieWrite  :: RegSet }     -- ^ registers that died because they were clobbered by something.
  93
  94
  95 -- | Stash regs live on entry to each basic block in the info part of the cmm code.
  96 data LiveInfo
  97         = LiveInfo
  98                 [CmmStatic]             -- cmm static stuff
  99                 (Maybe BlockId)         -- id of the first block
 100                 (BlockMap RegSet)       -- argument locals live on entry to this block
 101
 102 -- | A basic block with liveness information.
 103 type LiveBasicBlock
 104         = GenBasicBlock LiveInstr
 105
 106
 107 instance Outputable LiveInstr where
 108         ppr (Instr instr Nothing)
 109          = ppr instr
 110
 111         ppr (Instr instr (Just live))
 112          =  ppr instr
 113                 $$ (nest 8
 114                         $ vcat
 115                         [ pprRegs (ptext SLIT("# born:    ")) (liveBorn live)
 116                         , pprRegs (ptext SLIT("# r_dying: ")) (liveDieRead live)
 117                         , pprRegs (ptext SLIT("# w_dying: ")) (liveDieWrite live) ]
 118                     $+$ space)
 119
 120          where  pprRegs :: SDoc -> RegSet -> SDoc
 121                 pprRegs name regs
 122                  | isEmptyUniqSet regs  = empty
 123                  | otherwise            = name <> (hcat $ punctuate space $ map (docToSDoc . pprUserReg) $ uniqSetToList regs)
 124
 125
 126 instance Outputable LiveInfo where
 127         ppr (LiveInfo static firstId liveOnEntry)
 128                 =  (vcat $ map ppr static)
 129                 $$ text "# firstId     = " <> ppr firstId
 130                 $$ text "# liveOnEntry = " <> ppr liveOnEntry
 131
 132
 133 -- | map a function across all the basic blocks in this code
 134 --
 135 mapBlockTop
 136         :: (LiveBasicBlock -> LiveBasicBlock)
 137         -> LiveCmmTop -> LiveCmmTop
 138
 139 mapBlockTop f cmm
 140         = evalState (mapBlockTopM (\x -> return $ f x) cmm) ()
 141
 142
 143 -- | map a function across all the basic blocks in this code (monadic version)
 144 --
 145 mapBlockTopM
 146         :: Monad m
 147         => (LiveBasicBlock -> m LiveBasicBlock)
 148         -> LiveCmmTop -> m LiveCmmTop
 149
 150 mapBlockTopM _ cmm@(CmmData{})
 151         = return cmm
 152
 153 mapBlockTopM f (CmmProc header label params (ListGraph comps))
 154  = do   comps'  <- mapM (mapBlockCompM f) comps
 155         return  $ CmmProc header label params (ListGraph comps')
 156
 157 mapBlockCompM f (BasicBlock i blocks)
 158  = do   blocks' <- mapM f blocks
 159         return  $ BasicBlock i blocks'
 160
 161
 162 -- map a function across all the basic blocks in this code
 163 mapGenBlockTop
 164         :: (GenBasicBlock             i -> GenBasicBlock            i)
 165         -> (GenCmmTop d h (ListGraph i) -> GenCmmTop d h (ListGraph i))
 166
 167 mapGenBlockTop f cmm
 168         = evalState (mapGenBlockTopM (\x -> return $ f x) cmm) ()
 169
 170
 171 -- | map a function across all the basic blocks in this code (monadic version)
 172 mapGenBlockTopM
 173         :: Monad m
 174         => (GenBasicBlock            i  -> m (GenBasicBlock            i))
 175         -> (GenCmmTop d h (ListGraph i) -> m (GenCmmTop d h (ListGraph i)))
 176
 177 mapGenBlockTopM _ cmm@(CmmData{})
 178         = return cmm
 179
 180 mapGenBlockTopM f (CmmProc header label params (ListGraph blocks))
 181  = do   blocks' <- mapM f blocks
 182         return  $ CmmProc header label params (ListGraph blocks')
 183
 184
 185 -- | Slurp out the list of register conflicts and reg-reg moves from this top level thing.
 186 --      Slurping of conflicts and moves is wrapped up together so we don't have
 187 --      to make two passes over the same code when we want to build the graph.
 188 --
 189 slurpConflicts :: LiveCmmTop -> (Bag (UniqSet Reg), Bag (Reg, Reg))
 190 slurpConflicts live
 191         = slurpCmm (emptyBag, emptyBag) live
 192
 193  where  slurpCmm   rs  CmmData{}                = rs
 194         slurpCmm   rs (CmmProc info _ _ (ListGraph blocks))
 195                 = foldl' (slurpComp info) rs blocks
 196
 197         slurpComp  info rs (BasicBlock _ blocks)
 198                 = foldl' (slurpBlock info) rs blocks
 199
 200         slurpBlock info rs (BasicBlock blockId instrs)
 201                 | LiveInfo _ _ blockLive        <- info
 202                 , Just rsLiveEntry              <- lookupUFM blockLive blockId
 203                 , (conflicts, moves)            <- slurpLIs rsLiveEntry rs instrs
 204                 = (consBag rsLiveEntry conflicts, moves)
 205
 206                 | otherwise
 207                 = error "RegLiveness.slurpBlock: bad block"
 208
 209         slurpLIs rsLive (conflicts, moves) []
 210                 = (consBag rsLive conflicts, moves)
 211
 212         slurpLIs rsLive rs (Instr _ Nothing     : lis)  = slurpLIs rsLive rs lis
 213
 214         slurpLIs rsLiveEntry (conflicts, moves) (Instr instr (Just live) : lis)
 215          = let
 216                 -- regs that die because they are read for the last time at the start of an instruction
 217                 --      are not live across it.
 218                 rsLiveAcross    = rsLiveEntry `minusUniqSet` (liveDieRead live)
 219
 220                 -- regs live on entry to the next instruction.
 221                 --      be careful of orphans, make sure to delete dying regs _after_ unioning
 222                 --      in the ones that are born here.
 223                 rsLiveNext      = (rsLiveAcross `unionUniqSets` (liveBorn     live))
 224                                                 `minusUniqSet`  (liveDieWrite live)
 225
 226                 -- orphan vregs are the ones that die in the same instruction they are born in.
 227                 --      these are likely to be results that are never used, but we still
 228                 --      need to assign a hreg to them..
 229                 rsOrphans       = intersectUniqSets
 230                                         (liveBorn live)
 231                                         (unionUniqSets (liveDieWrite live) (liveDieRead live))
 232
 233                 --
 234                 rsConflicts     = unionUniqSets rsLiveNext rsOrphans
 235
 236           in    case isRegRegMove instr of
 237                  Just rr        -> slurpLIs rsLiveNext
 238                                         ( consBag rsConflicts conflicts
 239                                         , consBag rr moves) lis
 240
 241                  Nothing        -> slurpLIs rsLiveNext
 242                                         ( consBag rsConflicts conflicts
 243                                         , moves) lis
 244
 245
 246 -- | Strip away liveness information, yielding NatCmmTop
 247
 248 stripLive :: LiveCmmTop -> NatCmmTop
 249 stripLive live
 250         = stripCmm live
 251
 252  where  stripCmm (CmmData sec ds)       = CmmData sec ds
 253         stripCmm (CmmProc (LiveInfo info _ _) label params (ListGraph comps))
 254                 = CmmProc info label params (ListGraph $ concatMap stripComp comps)
 255
 256         stripComp  (BasicBlock _ blocks)        = map stripBlock blocks
 257         stripBlock (BasicBlock i instrs)        = BasicBlock i (map stripLI instrs)
 258         stripLI    (Instr instr _)              = instr
 259
 260
 261 -- | Make real spill instructions out of SPILL, RELOAD pseudos
 262
 263 spillNatBlock :: NatBasicBlock -> NatBasicBlock
 264 spillNatBlock (BasicBlock i is)
 265  =      BasicBlock i instrs'
 266  where  (instrs', _)
 267                 = runState (spillNat [] is) 0
 268
 269         spillNat acc []
 270          =      return (reverse acc)
 271
 272         spillNat acc (DELTA i : instrs)
 273          = do   put i
 274                 spillNat acc instrs
 275
 276         spillNat acc (SPILL reg slot : instrs)
 277          = do   delta   <- get
 278                 spillNat (mkSpillInstr reg delta slot : acc) instrs
 279
 280         spillNat acc (RELOAD slot reg : instrs)
 281          = do   delta   <- get
 282                 spillNat (mkLoadInstr reg delta slot : acc) instrs
 283
 284         spillNat acc (instr : instrs)
 285          =      spillNat (instr : acc) instrs
 286
 287
 288 -- | Slurp out a map of how many times each register was live upon entry to an instruction.
 289
 290 lifetimeCount
 291         :: LiveCmmTop
 292         -> UniqFM (Reg, Int)    -- ^ reg -> (reg, count)
 293
 294 lifetimeCount cmm
 295         = countCmm emptyUFM cmm
 296  where
 297         countCmm fm  CmmData{}          = fm
 298         countCmm fm (CmmProc info _ _ (ListGraph blocks))
 299                 = foldl' (countComp info) fm blocks
 300
 301         countComp info fm (BasicBlock _ blocks)
 302                 = foldl' (countBlock info) fm blocks
 303
 304         countBlock info fm (BasicBlock blockId instrs)
 305                 | LiveInfo _ _ blockLive        <- info
 306                 , Just rsLiveEntry              <- lookupUFM blockLive blockId
 307                 = countLIs rsLiveEntry fm instrs
 308
 309                 | otherwise
 310                 = error "RegLiveness.countBlock: bad block"
 311
 312         countLIs _      fm []                           = fm
 313         countLIs rsLive fm (Instr _ Nothing : lis)      = countLIs rsLive fm lis
 314
 315         countLIs rsLiveEntry fm (Instr _ (Just live) : lis)
 316          = let
 317                 rsLiveAcross    = rsLiveEntry `minusUniqSet` (liveDieRead live)
 318
 319                 rsLiveNext      = (rsLiveAcross `unionUniqSets` (liveBorn     live))
 320                                                  `minusUniqSet` (liveDieWrite live)
 321
 322                 add r fm        = addToUFM_C
 323                                         (\(r1, l1) (_, l2) -> (r1, l1 + l2))
 324                                         fm r (r, 1)
 325
 326                 fm'             = foldUniqSet add fm rsLiveEntry
 327            in   countLIs rsLiveNext fm' lis
 328
 329
 330 -- | Erase Delta instructions.
 331
 332 eraseDeltasLive :: LiveCmmTop -> LiveCmmTop
 333 eraseDeltasLive cmm
 334         = mapBlockTop eraseBlock cmm
 335  where
 336         isDelta (DELTA _)       = True
 337         isDelta _               = False
 338
 339         eraseBlock (BasicBlock id lis)
 340                 = BasicBlock id
 341                 $ filter (\(Instr i _) -> not $ isDelta i)
 342                 $ lis
 343
 344
 345 -- | Patch the registers in this code according to this register mapping.
 346 --      also erase reg -> reg moves when the reg is the same.
 347 --      also erase reg -> reg moves when the destination dies in this instr.
 348
 349 patchEraseLive
 350         :: (Reg -> Reg)
 351         -> LiveCmmTop -> LiveCmmTop
 352
 353 patchEraseLive patchF cmm
 354         = patchCmm cmm
 355  where
 356         patchCmm cmm@CmmData{}  = cmm
 357
 358         patchCmm (CmmProc info label params (ListGraph comps))
 359          | LiveInfo static id blockMap  <- info
 360          = let  patchRegSet set = mkUniqSet $ map patchF $ uniqSetToList set
 361                 blockMap'       = mapUFM patchRegSet blockMap
 362
 363                 info'           = LiveInfo static id blockMap'
 364            in   CmmProc info' label params $ ListGraph $ map patchComp comps
 365
 366         patchComp (BasicBlock id blocks)
 367                 = BasicBlock id $ map patchBlock blocks
 368
 369         patchBlock (BasicBlock id lis)
 370                 = BasicBlock id $ patchInstrs lis
 371
 372         patchInstrs []          = []
 373         patchInstrs (li : lis)
 374
 375                 | Instr i (Just live)   <- li'
 376                 , Just (r1, r2) <- isRegRegMove i
 377                 , eatMe r1 r2 live
 378                 = patchInstrs lis
 379
 380                 | otherwise
 381                 = li' : patchInstrs lis
 382
 383                 where   li'     = patchRegsLiveInstr patchF li
 384
 385         eatMe   r1 r2 live
 386                 -- source and destination regs are the same
 387                 | r1 == r2      = True
 388
 389                 -- desination reg is never used
 390                 | elementOfUniqSet r2 (liveBorn live)
 391                 , elementOfUniqSet r2 (liveDieRead live) || elementOfUniqSet r2 (liveDieWrite live)
 392                 = True
 393
 394                 | otherwise     = False
 395
 396
 397 -- | Patch registers in this LiveInstr, including the liveness information.
 398 --
 399 patchRegsLiveInstr
 400         :: (Reg -> Reg)
 401         -> LiveInstr -> LiveInstr
 402
 403 patchRegsLiveInstr patchF li
 404  = case li of
 405         Instr instr Nothing
 406          -> Instr (patchRegs instr patchF) Nothing
 407
 408         Instr instr (Just live)
 409          -> Instr
 410                 (patchRegs instr patchF)
 411                 (Just live
 412                         { -- WARNING: have to go via lists here because patchF changes the uniq in the Reg
 413                           liveBorn      = mkUniqSet $ map patchF $ uniqSetToList $ liveBorn live
 414                         , liveDieRead   = mkUniqSet $ map patchF $ uniqSetToList $ liveDieRead live
 415                         , liveDieWrite  = mkUniqSet $ map patchF $ uniqSetToList $ liveDieWrite live })
 416
 417
 418 ---------------------------------------------------------------------------------
 419 -- Annotate code with register liveness information
 420 --
 421 regLiveness
 422         :: NatCmmTop
 423         -> UniqSM LiveCmmTop
 424
 425 regLiveness (CmmData i d)
 426         = returnUs $ CmmData i d
 427
 428 regLiveness (CmmProc info lbl params (ListGraph []))
 429         = returnUs $ CmmProc
 430                         (LiveInfo info Nothing emptyUFM)
 431                         lbl params (ListGraph [])
 432
 433 regLiveness (CmmProc info lbl params (ListGraph blocks@(first : _)))
 434  = let  first_id                = blockId first
 435         sccs                    = sccBlocks blocks
 436         (ann_sccs, block_live)  = computeLiveness sccs
 437
 438         liveBlocks
 439          = map (\scc -> case scc of
 440                         AcyclicSCC  b@(BasicBlock l _)          -> BasicBlock l [b]
 441                         CyclicSCC  bs@(BasicBlock l _ : _)      -> BasicBlock l bs
 442                         CyclicSCC  []
 443                          -> panic "RegLiveness.regLiveness: no blocks in scc list")
 444                  $ ann_sccs
 445
 446    in   returnUs $ CmmProc
 447                         (LiveInfo info (Just first_id) block_live)
 448                         lbl params (ListGraph liveBlocks)
 449
 450
 451 sccBlocks :: [NatBasicBlock] -> [SCC NatBasicBlock]
 452 sccBlocks blocks = stronglyConnComp graph
 453   where
 454         getOutEdges :: [Instr] -> [BlockId]
 455         getOutEdges instrs = foldl' (\a x -> jumpDests x a) [] instrs
 456
 457         graph = [ (block, getUnique id, map getUnique (getOutEdges instrs))
 458                 | block@(BasicBlock id instrs) <- blocks ]
 459
 460
 461 -- -----------------------------------------------------------------------------
 462 -- Computing liveness
 463
 464 computeLiveness
 465    :: [SCC NatBasicBlock]
 466    -> ([SCC LiveBasicBlock],            -- instructions annotated with list of registers
 467                                         -- which are "dead after this instruction".
 468        BlockMap RegSet)                 -- blocks annontated with set of live registers
 469                                         -- on entry to the block.
 470
 471   -- NOTE: on entry, the SCCs are in "reverse" order: later blocks may transfer
 472   -- control to earlier ones only.  The SCCs returned are in the *opposite*
 473   -- order, which is exactly what we want for the next pass.
 474
 475 computeLiveness sccs
 476         = livenessSCCs emptyBlockMap [] sccs
 477
 478
 479 livenessSCCs
 480        :: BlockMap RegSet
 481        -> [SCC LiveBasicBlock]          -- accum
 482        -> [SCC NatBasicBlock]
 483        -> ([SCC LiveBasicBlock], BlockMap RegSet)
 484
 485 livenessSCCs blockmap done [] = (done, blockmap)
 486
 487 livenessSCCs blockmap done (AcyclicSCC block : sccs)
 488  = let  (blockmap', block')     = livenessBlock blockmap block
 489    in   livenessSCCs blockmap' (AcyclicSCC block' : done) sccs
 490
 491 livenessSCCs blockmap done
 492         (CyclicSCC blocks : sccs) =
 493         livenessSCCs blockmap' (CyclicSCC blocks':done) sccs
 494  where      (blockmap', blocks')
 495                 = iterateUntilUnchanged linearLiveness equalBlockMaps
 496                                       blockmap blocks
 497
 498             iterateUntilUnchanged
 499                 :: (a -> b -> (a,c)) -> (a -> a -> Bool)
 500                 -> a -> b
 501                 -> (a,c)
 502
 503             iterateUntilUnchanged f eq a b
 504                 = head $
 505                   concatMap tail $
 506                   groupBy (\(a1, _) (a2, _) -> eq a1 a2) $
 507                   iterate (\(a, _) -> f a b) $
 508                   (a, error "RegisterAlloc.livenessSCCs")
 509
 510
 511             linearLiveness :: BlockMap RegSet -> [NatBasicBlock]
 512                            -> (BlockMap RegSet, [LiveBasicBlock])
 513             linearLiveness = mapAccumL livenessBlock
 514
 515                 -- probably the least efficient way to compare two
 516                 -- BlockMaps for equality.
 517             equalBlockMaps a b
 518                 = a' == b'
 519               where a' = map f $ ufmToList a
 520                     b' = map f $ ufmToList b
 521                     f (key,elt) = (key, uniqSetToList elt)
 522
 523
 524
 525 -- | Annotate a basic block with register liveness information.
 526 --
 527 livenessBlock
 528         :: BlockMap RegSet
 529         -> NatBasicBlock
 530         -> (BlockMap RegSet, LiveBasicBlock)
 531
 532 livenessBlock blockmap (BasicBlock block_id instrs)
 533  = let
 534         (regsLiveOnEntry, instrs1)
 535                 = livenessBack emptyUniqSet blockmap [] (reverse instrs)
 536         blockmap'       = addToUFM blockmap block_id regsLiveOnEntry
 537
 538         instrs2         = livenessForward regsLiveOnEntry instrs1
 539
 540         output          = BasicBlock block_id instrs2
 541
 542    in   ( blockmap', output)
 543
 544 -- | Calculate liveness going forwards,
 545 --      filling in when regs are born
 546
 547 livenessForward
 548         :: RegSet                       -- regs live on this instr
 549         -> [LiveInstr] -> [LiveInstr]
 550
 551 livenessForward _           []  = []
 552 livenessForward rsLiveEntry (li@(Instr instr mLive) : lis)
 553         | Nothing               <- mLive
 554         = li : livenessForward rsLiveEntry lis
 555
 556         | Just live     <- mLive
 557         , RU _ written  <- regUsage instr
 558         = let
 559                 -- Regs that are written to but weren't live on entry to this instruction
 560                 --      are recorded as being born here.
 561                 rsBorn          = mkUniqSet
 562                                 $ filter (\r -> not $ elementOfUniqSet r rsLiveEntry) written
 563
 564                 rsLiveNext      = (rsLiveEntry `unionUniqSets` rsBorn)
 565                                         `minusUniqSet` (liveDieRead live)
 566                                         `minusUniqSet` (liveDieWrite live)
 567
 568         in Instr instr (Just live { liveBorn = rsBorn })
 569                 : livenessForward rsLiveNext lis
 570
 571 livenessForward _ _             = panic "RegLiveness.livenessForward: no match"
 572
 573
 574 -- | Calculate liveness going backwards,
 575 --      filling in when regs die, and what regs are live across each instruction
 576
 577 livenessBack
 578         :: RegSet                       -- regs live on this instr
 579         -> BlockMap RegSet              -- regs live on entry to other BBs
 580         -> [LiveInstr]                  -- instructions (accum)
 581         -> [Instr]                      -- instructions
 582         -> (RegSet, [LiveInstr])
 583
 584 livenessBack liveregs _        done []  = (liveregs, done)
 585
 586 livenessBack liveregs blockmap acc (instr : instrs)
 587  = let  (liveregs', instr')     = liveness1 liveregs blockmap instr
 588    in   livenessBack liveregs' blockmap (instr' : acc) instrs
 589
 590 -- don't bother tagging comments or deltas with liveness
 591 liveness1 liveregs _   (instr@COMMENT{})
 592         = (liveregs, Instr instr Nothing)
 593
 594 liveness1 liveregs _   (instr@DELTA{})
 595         = (liveregs, Instr instr Nothing)
 596
 597 liveness1 liveregs blockmap instr
 598
 599       | not_a_branch
 600       = (liveregs1, Instr instr
 601                         (Just $ Liveness
 602                         { liveBorn      = emptyUniqSet
 603                         , liveDieRead   = mkUniqSet r_dying
 604                         , liveDieWrite  = mkUniqSet w_dying }))
 605
 606       | otherwise
 607       = (liveregs_br, Instr instr
 608                         (Just $ Liveness
 609                         { liveBorn      = emptyUniqSet
 610                         , liveDieRead   = mkUniqSet r_dying_br
 611                         , liveDieWrite  = mkUniqSet w_dying }))
 612
 613       where
 614             RU read written = regUsage instr
 615
 616             -- registers that were written here are dead going backwards.
 617             -- registers that were read here are live going backwards.
 618             liveregs1   = (liveregs `delListFromUniqSet` written)
 619                                     `addListToUniqSet` read
 620
 621             -- registers that are not live beyond this point, are recorded
 622             --  as dying here.
 623             r_dying     = [ reg | reg <- read, reg `notElem` written,
 624                               not (elementOfUniqSet reg liveregs) ]
 625
 626             w_dying     = [ reg | reg <- written,
 627                              not (elementOfUniqSet reg liveregs) ]
 628
 629             -- union in the live regs from all the jump destinations of this
 630             -- instruction.
 631             targets      = jumpDests instr [] -- where we go from here
 632             not_a_branch = null targets
 633
 634             targetLiveRegs target
 635                   = case lookupUFM blockmap target of
 636                                 Just ra -> ra
 637                                 Nothing -> emptyBlockMap
 638
 639             live_from_branch = unionManyUniqSets (map targetLiveRegs targets)
 640
 641             liveregs_br = liveregs1 `unionUniqSets` live_from_branch
 642
 643             -- registers that are live only in the branch targets should
 644             -- be listed as dying here.
 645             live_branch_only = live_from_branch `minusUniqSet` liveregs
 646             r_dying_br  = uniqSetToList (mkUniqSet r_dying `unionUniqSets`
 647                                         live_branch_only)
 648
 649
 650
 651