1 -----------------------------------------------------------------------------
3 -- The register liveness determinator
5 -- (c) The University of Glasgow 2004
7 -----------------------------------------------------------------------------
8 {-# OPTIONS -Wall -fno-warn-name-shadowing #-}
10 module RegAlloc.Liveness (
13 BlockMap, emptyBlockMap,
21 mapBlockTop, mapBlockTopM,
22 mapGenBlockTop, mapGenBlockTopM,
39 import Cmm hiding (RegSet)
55 -----------------------------------------------------------------------------
56 type RegSet = UniqSet Reg
58 type RegMap a = UniqFM a
60 emptyRegMap :: UniqFM a
61 emptyRegMap = emptyUFM
63 type BlockMap a = BlockEnv a
65 emptyBlockMap :: BlockEnv a
66 emptyBlockMap = emptyBlockEnv
69 -- | A top level thing which carries liveness information.
74 [SCC (LiveBasicBlock instr)]
77 -- | The register allocator also wants to use SPILL/RELOAD meta instructions,
78 -- so we'll keep those here.
80 -- | A real machine instruction
83 -- | spill this reg to a stack slot
86 -- | reload this reg from a stack slot
89 instance Instruction instr => Instruction (InstrSR instr) where
92 Instr instr -> regUsageOfInstr instr
93 SPILL reg _ -> RU [reg] []
94 RELOAD _ reg -> RU [] [reg]
98 Instr instr -> Instr (patchRegsOfInstr instr f)
99 SPILL reg slot -> SPILL (f reg) slot
100 RELOAD slot reg -> RELOAD slot (f reg)
104 Instr instr -> isJumpishInstr instr
109 Instr instr -> jumpDestsOfInstr instr
114 Instr instr -> Instr (patchJumpInstr instr f)
117 mkSpillInstr = error "mkSpillInstr[InstrSR]: Not making SPILL meta-instr"
118 mkLoadInstr = error "mkLoadInstr[InstrSR]: Not making LOAD meta-instr"
122 Instr instr -> takeDeltaInstr instr
127 Instr instr -> isMetaInstr instr
130 mkRegRegMoveInstr r1 r2 = Instr (mkRegRegMoveInstr r1 r2)
132 takeRegRegMoveInstr i
134 Instr instr -> takeRegRegMoveInstr instr
137 mkJumpInstr target = map Instr (mkJumpInstr target)
141 -- | An instruction with liveness information.
143 = LiveInstr (InstrSR instr) (Maybe Liveness)
145 -- | Liveness information.
146 -- The regs which die are ones which are no longer live in the *next* instruction
148 -- (NB. if the instruction is a jump, these registers might still be live
149 -- at the jump target(s) - you have to check the liveness at the destination
150 -- block to find out).
154 { liveBorn :: RegSet -- ^ registers born in this instruction (written to for first time).
155 , liveDieRead :: RegSet -- ^ registers that died because they were read for the last time.
156 , liveDieWrite :: RegSet } -- ^ registers that died because they were clobbered by something.
159 -- | Stash regs live on entry to each basic block in the info part of the cmm code.
162 [CmmStatic] -- cmm static stuff
163 (Maybe BlockId) -- id of the first block
164 (Maybe (BlockMap RegSet)) -- argument locals live on entry to this block
166 -- | A basic block with liveness information.
167 type LiveBasicBlock instr
168 = GenBasicBlock (LiveInstr instr)
171 instance Outputable instr
172 => Outputable (InstrSR instr) where
174 ppr (Instr realInstr)
179 ptext (sLit "\tSPILL"),
183 ptext (sLit "SLOT") <> parens (int slot)]
185 ppr (RELOAD slot reg)
187 ptext (sLit "\tRELOAD"),
189 ptext (sLit "SLOT") <> parens (int slot),
193 instance Outputable instr
194 => Outputable (LiveInstr instr) where
196 ppr (LiveInstr instr Nothing)
199 ppr (LiveInstr instr (Just live))
203 [ pprRegs (ptext (sLit "# born: ")) (liveBorn live)
204 , pprRegs (ptext (sLit "# r_dying: ")) (liveDieRead live)
205 , pprRegs (ptext (sLit "# w_dying: ")) (liveDieWrite live) ]
208 where pprRegs :: SDoc -> RegSet -> SDoc
210 | isEmptyUniqSet regs = empty
211 | otherwise = name <> (hcat $ punctuate space $ map ppr $ uniqSetToList regs)
213 instance Outputable LiveInfo where
214 ppr (LiveInfo static firstId liveOnEntry)
215 = (vcat $ map ppr static)
216 $$ text "# firstId = " <> ppr firstId
217 $$ text "# liveOnEntry = " <> ppr liveOnEntry
221 -- | map a function across all the basic blocks in this code
224 :: (LiveBasicBlock instr -> LiveBasicBlock instr)
225 -> LiveCmmTop instr -> LiveCmmTop instr
228 = evalState (mapBlockTopM (\x -> return $ f x) cmm) ()
231 -- | map a function across all the basic blocks in this code (monadic version)
235 => (LiveBasicBlock instr -> m (LiveBasicBlock instr))
236 -> LiveCmmTop instr -> m (LiveCmmTop instr)
238 mapBlockTopM _ cmm@(CmmData{})
241 mapBlockTopM f (CmmProc header label params sccs)
242 = do sccs' <- mapM (mapSCCM f) sccs
243 return $ CmmProc header label params sccs'
245 mapSCCM :: Monad m => (a -> m b) -> SCC a -> m (SCC b)
246 mapSCCM f (AcyclicSCC x)
248 return $ AcyclicSCC x'
250 mapSCCM f (CyclicSCC xs)
251 = do xs' <- mapM f xs
252 return $ CyclicSCC xs'
255 -- map a function across all the basic blocks in this code
257 :: (GenBasicBlock i -> GenBasicBlock i)
258 -> (GenCmmTop d h (ListGraph i) -> GenCmmTop d h (ListGraph i))
261 = evalState (mapGenBlockTopM (\x -> return $ f x) cmm) ()
264 -- | map a function across all the basic blocks in this code (monadic version)
267 => (GenBasicBlock i -> m (GenBasicBlock i))
268 -> (GenCmmTop d h (ListGraph i) -> m (GenCmmTop d h (ListGraph i)))
270 mapGenBlockTopM _ cmm@(CmmData{})
273 mapGenBlockTopM f (CmmProc header label params (ListGraph blocks))
274 = do blocks' <- mapM f blocks
275 return $ CmmProc header label params (ListGraph blocks')
278 -- | Slurp out the list of register conflicts and reg-reg moves from this top level thing.
279 -- Slurping of conflicts and moves is wrapped up together so we don't have
280 -- to make two passes over the same code when we want to build the graph.
285 -> (Bag (UniqSet Reg), Bag (Reg, Reg))
288 = slurpCmm (emptyBag, emptyBag) live
290 where slurpCmm rs CmmData{} = rs
291 slurpCmm rs (CmmProc info _ _ sccs)
292 = foldl' (slurpSCC info) rs sccs
294 slurpSCC info rs (AcyclicSCC b)
295 = slurpBlock info rs b
297 slurpSCC info rs (CyclicSCC bs)
298 = foldl' (slurpBlock info) rs bs
300 slurpBlock info rs (BasicBlock blockId instrs)
301 | LiveInfo _ _ (Just blockLive) <- info
302 , Just rsLiveEntry <- lookupBlockEnv blockLive blockId
303 , (conflicts, moves) <- slurpLIs rsLiveEntry rs instrs
304 = (consBag rsLiveEntry conflicts, moves)
307 = panic "Liveness.slurpConflicts: bad block"
309 slurpLIs rsLive (conflicts, moves) []
310 = (consBag rsLive conflicts, moves)
312 slurpLIs rsLive rs (LiveInstr _ Nothing : lis)
313 = slurpLIs rsLive rs lis
315 slurpLIs rsLiveEntry (conflicts, moves) (LiveInstr instr (Just live) : lis)
317 -- regs that die because they are read for the last time at the start of an instruction
318 -- are not live across it.
319 rsLiveAcross = rsLiveEntry `minusUniqSet` (liveDieRead live)
321 -- regs live on entry to the next instruction.
322 -- be careful of orphans, make sure to delete dying regs _after_ unioning
323 -- in the ones that are born here.
324 rsLiveNext = (rsLiveAcross `unionUniqSets` (liveBorn live))
325 `minusUniqSet` (liveDieWrite live)
327 -- orphan vregs are the ones that die in the same instruction they are born in.
328 -- these are likely to be results that are never used, but we still
329 -- need to assign a hreg to them..
330 rsOrphans = intersectUniqSets
332 (unionUniqSets (liveDieWrite live) (liveDieRead live))
335 rsConflicts = unionUniqSets rsLiveNext rsOrphans
337 in case takeRegRegMoveInstr instr of
338 Just rr -> slurpLIs rsLiveNext
339 ( consBag rsConflicts conflicts
340 , consBag rr moves) lis
342 Nothing -> slurpLIs rsLiveNext
343 ( consBag rsConflicts conflicts
347 -- | For spill\/reloads
353 -- If we can arrange that v1 and v2 are allocated to the same hreg it's more likely
354 -- the spill\/reload instrs can be cleaned and replaced by a nop reg-reg move.
362 slurpReloadCoalesce live
363 = slurpCmm emptyBag live
365 where slurpCmm cs CmmData{} = cs
366 slurpCmm cs (CmmProc _ _ _ sccs)
367 = slurpComp cs (flattenSCCs sccs)
370 = let (moveBags, _) = runState (slurpCompM blocks) emptyUFM
371 in unionManyBags (cs : moveBags)
374 = do -- run the analysis once to record the mapping across jumps.
375 mapM_ (slurpBlock False) blocks
377 -- run it a second time while using the information from the last pass.
378 -- We /could/ run this many more times to deal with graphical control
379 -- flow and propagating info across multiple jumps, but it's probably
380 -- not worth the trouble.
381 mapM (slurpBlock True) blocks
383 slurpBlock propagate (BasicBlock blockId instrs)
384 = do -- grab the slot map for entry to this block
385 slotMap <- if propagate
386 then getSlotMap blockId
389 (_, mMoves) <- mapAccumLM slurpLI slotMap instrs
390 return $ listToBag $ catMaybes mMoves
392 slurpLI :: Instruction instr
393 => UniqFM Reg -- current slotMap
395 -> State (UniqFM [UniqFM Reg]) -- blockId -> [slot -> reg]
396 -- for tracking slotMaps across jumps
398 ( UniqFM Reg -- new slotMap
399 , Maybe (Reg, Reg)) -- maybe a new coalesce edge
403 -- remember what reg was stored into the slot
404 | LiveInstr (SPILL reg slot) _ <- li
405 , slotMap' <- addToUFM slotMap slot reg
406 = return (slotMap', Nothing)
408 -- add an edge betwen the this reg and the last one stored into the slot
409 | LiveInstr (RELOAD slot reg) _ <- li
410 = case lookupUFM slotMap slot of
412 | reg /= reg2 -> return (slotMap, Just (reg, reg2))
413 | otherwise -> return (slotMap, Nothing)
415 Nothing -> return (slotMap, Nothing)
417 -- if we hit a jump, remember the current slotMap
418 | LiveInstr (Instr instr) _ <- li
419 , targets <- jumpDestsOfInstr instr
421 = do mapM_ (accSlotMap slotMap) targets
422 return (slotMap, Nothing)
425 = return (slotMap, Nothing)
427 -- record a slotmap for an in edge to this block
428 accSlotMap slotMap blockId
429 = modify (\s -> addToUFM_C (++) s blockId [slotMap])
431 -- work out the slot map on entry to this block
432 -- if we have slot maps for multiple in-edges then we need to merge them.
435 let slotMaps = fromMaybe [] (lookupUFM map blockId)
436 return $ foldr mergeSlotMaps emptyUFM slotMaps
438 mergeSlotMaps :: UniqFM Reg -> UniqFM Reg -> UniqFM Reg
439 mergeSlotMaps map1 map2
441 $ [ (k, r1) | (k, r1) <- ufmToList map1
442 , case lookupUFM map2 k of
444 Just r2 -> r1 == r2 ]
447 -- | Strip away liveness information, yielding NatCmmTop
449 :: (Outputable instr, Instruction instr)
456 where stripCmm (CmmData sec ds) = CmmData sec ds
458 stripCmm (CmmProc (LiveInfo info (Just first_id) _) label params sccs)
459 = let final_blocks = flattenSCCs sccs
461 -- make sure the block that was first in the input list
462 -- stays at the front of the output. This is the entry point
463 -- of the proc, and it needs to come first.
465 = partition ((== first_id) . blockId) final_blocks
467 in CmmProc info label params
468 (ListGraph $ map stripLiveBlock $ first' : rest')
470 -- procs used for stg_split_markers don't contain any blocks, and have no first_id.
471 stripCmm (CmmProc (LiveInfo info Nothing _) label params [])
472 = CmmProc info label params (ListGraph [])
474 -- If the proc has blocks but we don't know what the first one was, then we're dead.
476 = pprPanic "RegAlloc.Liveness.stripLive: no first_id on proc" (ppr proc)
479 -- | Strip away liveness information from a basic block,
480 -- and make real spill instructions out of SPILL, RELOAD pseudos along the way.
484 => LiveBasicBlock instr
485 -> NatBasicBlock instr
487 stripLiveBlock (BasicBlock i lis)
488 = BasicBlock i instrs'
491 = runState (spillNat [] lis) 0
494 = return (reverse acc)
496 spillNat acc (LiveInstr (SPILL reg slot) _ : instrs)
498 spillNat (mkSpillInstr reg delta slot : acc) instrs
500 spillNat acc (LiveInstr (RELOAD slot reg) _ : instrs)
502 spillNat (mkLoadInstr reg delta slot : acc) instrs
504 spillNat acc (LiveInstr (Instr instr) _ : instrs)
505 | Just i <- takeDeltaInstr instr
509 spillNat acc (LiveInstr (Instr instr) _ : instrs)
510 = spillNat (instr : acc) instrs
513 -- | Erase Delta instructions.
521 = mapBlockTop eraseBlock cmm
523 eraseBlock (BasicBlock id lis)
525 $ filter (\(LiveInstr i _) -> not $ isJust $ takeDeltaInstr i)
529 -- | Patch the registers in this code according to this register mapping.
530 -- also erase reg -> reg moves when the reg is the same.
531 -- also erase reg -> reg moves when the destination dies in this instr.
536 -> LiveCmmTop instr -> LiveCmmTop instr
538 patchEraseLive patchF cmm
541 patchCmm cmm@CmmData{} = cmm
543 patchCmm (CmmProc info label params sccs)
544 | LiveInfo static id (Just blockMap) <- info
546 patchRegSet set = mkUniqSet $ map patchF $ uniqSetToList set
547 blockMap' = mapBlockEnv patchRegSet blockMap
549 info' = LiveInfo static id (Just blockMap')
550 in CmmProc info' label params $ map patchSCC sccs
553 = panic "RegAlloc.Liveness.patchEraseLive: no blockMap"
555 patchSCC (AcyclicSCC b) = AcyclicSCC (patchBlock b)
556 patchSCC (CyclicSCC bs) = CyclicSCC (map patchBlock bs)
558 patchBlock (BasicBlock id lis)
559 = BasicBlock id $ patchInstrs lis
562 patchInstrs (li : lis)
564 | LiveInstr i (Just live) <- li'
565 , Just (r1, r2) <- takeRegRegMoveInstr i
570 = li' : patchInstrs lis
572 where li' = patchRegsLiveInstr patchF li
575 -- source and destination regs are the same
578 -- desination reg is never used
579 | elementOfUniqSet r2 (liveBorn live)
580 , elementOfUniqSet r2 (liveDieRead live) || elementOfUniqSet r2 (liveDieWrite live)
586 -- | Patch registers in this LiveInstr, including the liveness information.
591 -> LiveInstr instr -> LiveInstr instr
593 patchRegsLiveInstr patchF li
595 LiveInstr instr Nothing
596 -> LiveInstr (patchRegsOfInstr instr patchF) Nothing
598 LiveInstr instr (Just live)
600 (patchRegsOfInstr instr patchF)
602 { -- WARNING: have to go via lists here because patchF changes the uniq in the Reg
603 liveBorn = mkUniqSet $ map patchF $ uniqSetToList $ liveBorn live
604 , liveDieRead = mkUniqSet $ map patchF $ uniqSetToList $ liveDieRead live
605 , liveDieWrite = mkUniqSet $ map patchF $ uniqSetToList $ liveDieWrite live })
608 --------------------------------------------------------------------------------
609 -- | Convert a NatCmmTop to a LiveCmmTop, with empty liveness information
616 natCmmTopToLive (CmmData i d)
619 natCmmTopToLive (CmmProc info lbl params (ListGraph []))
620 = CmmProc (LiveInfo info Nothing Nothing)
623 natCmmTopToLive (CmmProc info lbl params (ListGraph blocks@(first : _)))
624 = let first_id = blockId first
625 sccs = sccBlocks blocks
626 sccsLive = map (fmap (\(BasicBlock l instrs) ->
627 BasicBlock l (map (\i -> LiveInstr (Instr i) Nothing) instrs)))
630 in CmmProc (LiveInfo info (Just first_id) Nothing)
636 => [NatBasicBlock instr]
637 -> [SCC (NatBasicBlock instr)]
639 sccBlocks blocks = stronglyConnCompFromEdgedVertices graph
641 getOutEdges :: Instruction instr => [instr] -> [BlockId]
642 getOutEdges instrs = concat $ map jumpDestsOfInstr instrs
644 graph = [ (block, getUnique id, map getUnique (getOutEdges instrs))
645 | block@(BasicBlock id instrs) <- blocks ]
648 ---------------------------------------------------------------------------------
649 -- Annotate code with register liveness information
652 :: (Outputable instr, Instruction instr)
654 -> UniqSM (LiveCmmTop instr)
656 regLiveness (CmmData i d)
657 = returnUs $ CmmData i d
659 regLiveness (CmmProc info lbl params [])
660 | LiveInfo static mFirst _ <- info
662 (LiveInfo static mFirst (Just emptyBlockEnv))
665 regLiveness (CmmProc info lbl params sccs)
666 | LiveInfo static mFirst _ <- info
667 = let (ann_sccs, block_live) = computeLiveness sccs
669 in returnUs $ CmmProc (LiveInfo static mFirst (Just block_live))
676 -- -----------------------------------------------------------------------------
677 -- | Check ordering of Blocks
678 -- The computeLiveness function requires SCCs to be in reverse dependent order.
679 -- If they're not the liveness information will be wrong, and we'll get a bad allocation.
680 -- Better to check for this precondition explicitly or some other poor sucker will
681 -- waste a day staring at bad assembly code..
683 checkIsReverseDependent
685 => [SCC (LiveBasicBlock instr)] -- ^ SCCs of blocks that we're about to run the liveness determinator on.
686 -> Maybe BlockId -- ^ BlockIds that fail the test (if any)
688 checkIsReverseDependent sccs'
689 = go emptyUniqSet sccs'
691 where go blockssSeen []
694 go blocksSeen (AcyclicSCC block : sccs)
695 = let dests = slurpJumpDestsOfBlock block
696 blocksSeen' = unionUniqSets blocksSeen $ mkUniqSet [blockId block]
697 badDests = dests `minusUniqSet` blocksSeen'
698 in case uniqSetToList badDests of
699 [] -> go blocksSeen' sccs
702 go blocksSeen (CyclicSCC blocks : sccs)
703 = let dests = unionManyUniqSets $ map slurpJumpDestsOfBlock blocks
704 blocksSeen' = unionUniqSets blocksSeen $ mkUniqSet $ map blockId blocks
705 badDests = dests `minusUniqSet` blocksSeen'
706 in case uniqSetToList badDests of
707 [] -> go blocksSeen' sccs
710 slurpJumpDestsOfBlock (BasicBlock blockId instrs)
712 $ map (mkUniqSet . jumpDestsOfInstr)
713 [ i | LiveInstr i _ <- instrs]
716 -- | Computing liveness
718 -- On entry, the SCCs must be in "reverse" order: later blocks may transfer
719 -- control to earlier ones only, else `panic`.
721 -- The SCCs returned are in the *opposite* order, which is exactly what we
722 -- want for the next pass.
725 :: (Outputable instr, Instruction instr)
726 => [SCC (LiveBasicBlock instr)]
727 -> ([SCC (LiveBasicBlock instr)], -- instructions annotated with list of registers
728 -- which are "dead after this instruction".
729 BlockMap RegSet) -- blocks annontated with set of live registers
730 -- on entry to the block.
733 = case checkIsReverseDependent sccs of
734 Nothing -> livenessSCCs emptyBlockMap [] sccs
735 Just bad -> pprPanic "RegAlloc.Liveness.computeLivenss"
736 (vcat [ text "SCCs aren't in reverse dependent order"
737 , text "bad blockId" <+> ppr bad
743 -> [SCC (LiveBasicBlock instr)] -- accum
744 -> [SCC (LiveBasicBlock instr)]
745 -> ( [SCC (LiveBasicBlock instr)]
748 livenessSCCs blockmap done []
751 livenessSCCs blockmap done (AcyclicSCC block : sccs)
752 = let (blockmap', block') = livenessBlock blockmap block
753 in livenessSCCs blockmap' (AcyclicSCC block' : done) sccs
755 livenessSCCs blockmap done
756 (CyclicSCC blocks : sccs) =
757 livenessSCCs blockmap' (CyclicSCC blocks':done) sccs
758 where (blockmap', blocks')
759 = iterateUntilUnchanged linearLiveness equalBlockMaps
762 iterateUntilUnchanged
763 :: (a -> b -> (a,c)) -> (a -> a -> Bool)
767 iterateUntilUnchanged f eq a b
770 groupBy (\(a1, _) (a2, _) -> eq a1 a2) $
771 iterate (\(a, _) -> f a b) $
772 (a, panic "RegLiveness.livenessSCCs")
777 => BlockMap RegSet -> [LiveBasicBlock instr]
778 -> (BlockMap RegSet, [LiveBasicBlock instr])
780 linearLiveness = mapAccumL livenessBlock
782 -- probably the least efficient way to compare two
783 -- BlockMaps for equality.
786 where a' = map f $ blockEnvToList a
787 b' = map f $ blockEnvToList b
788 f (key,elt) = (key, uniqSetToList elt)
792 -- | Annotate a basic block with register liveness information.
797 -> LiveBasicBlock instr
798 -> (BlockMap RegSet, LiveBasicBlock instr)
800 livenessBlock blockmap (BasicBlock block_id instrs)
802 (regsLiveOnEntry, instrs1)
803 = livenessBack emptyUniqSet blockmap [] (reverse instrs)
804 blockmap' = extendBlockEnv blockmap block_id regsLiveOnEntry
806 instrs2 = livenessForward regsLiveOnEntry instrs1
808 output = BasicBlock block_id instrs2
810 in ( blockmap', output)
812 -- | Calculate liveness going forwards,
813 -- filling in when regs are born
817 => RegSet -- regs live on this instr
818 -> [LiveInstr instr] -> [LiveInstr instr]
820 livenessForward _ [] = []
821 livenessForward rsLiveEntry (li@(LiveInstr instr mLive) : lis)
823 = li : livenessForward rsLiveEntry lis
826 , RU _ written <- regUsageOfInstr instr
828 -- Regs that are written to but weren't live on entry to this instruction
829 -- are recorded as being born here.
831 $ filter (\r -> not $ elementOfUniqSet r rsLiveEntry) written
833 rsLiveNext = (rsLiveEntry `unionUniqSets` rsBorn)
834 `minusUniqSet` (liveDieRead live)
835 `minusUniqSet` (liveDieWrite live)
837 in LiveInstr instr (Just live { liveBorn = rsBorn })
838 : livenessForward rsLiveNext lis
840 livenessForward _ _ = panic "RegLiveness.livenessForward: no match"
843 -- | Calculate liveness going backwards,
844 -- filling in when regs die, and what regs are live across each instruction
848 => RegSet -- regs live on this instr
849 -> BlockMap RegSet -- regs live on entry to other BBs
850 -> [LiveInstr instr] -- instructions (accum)
851 -> [LiveInstr instr] -- instructions
852 -> (RegSet, [LiveInstr instr])
854 livenessBack liveregs _ done [] = (liveregs, done)
856 livenessBack liveregs blockmap acc (instr : instrs)
857 = let (liveregs', instr') = liveness1 liveregs blockmap instr
858 in livenessBack liveregs' blockmap (instr' : acc) instrs
861 -- don't bother tagging comments or deltas with liveness
867 -> (RegSet, LiveInstr instr)
869 liveness1 liveregs _ (LiveInstr instr _)
871 = (liveregs, LiveInstr instr Nothing)
873 liveness1 liveregs blockmap (LiveInstr instr _)
876 = (liveregs1, LiveInstr instr
878 { liveBorn = emptyUniqSet
879 , liveDieRead = mkUniqSet r_dying
880 , liveDieWrite = mkUniqSet w_dying }))
883 = (liveregs_br, LiveInstr instr
885 { liveBorn = emptyUniqSet
886 , liveDieRead = mkUniqSet r_dying_br
887 , liveDieWrite = mkUniqSet w_dying }))
890 RU read written = regUsageOfInstr instr
892 -- registers that were written here are dead going backwards.
893 -- registers that were read here are live going backwards.
894 liveregs1 = (liveregs `delListFromUniqSet` written)
895 `addListToUniqSet` read
897 -- registers that are not live beyond this point, are recorded
899 r_dying = [ reg | reg <- read, reg `notElem` written,
900 not (elementOfUniqSet reg liveregs) ]
902 w_dying = [ reg | reg <- written,
903 not (elementOfUniqSet reg liveregs) ]
905 -- union in the live regs from all the jump destinations of this
907 targets = jumpDestsOfInstr instr -- where we go from here
908 not_a_branch = null targets
910 targetLiveRegs target
911 = case lookupBlockEnv blockmap target of
913 Nothing -> emptyRegMap
915 live_from_branch = unionManyUniqSets (map targetLiveRegs targets)
917 liveregs_br = liveregs1 `unionUniqSets` live_from_branch
919 -- registers that are live only in the branch targets should
920 -- be listed as dying here.
921 live_branch_only = live_from_branch `minusUniqSet` liveregs
922 r_dying_br = uniqSetToList (mkUniqSet r_dying `unionUniqSets`