compiler/nativeGen/RegLiveness.hs

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