compiler/nativeGen/RegLiveness.hs

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