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, mapSCCM,
22 mapGenBlockTop, mapGenBlockTopM,
38 import Cmm hiding (RegSet)
55 import qualified Data.Map as Map
57 -----------------------------------------------------------------------------
58 type RegSet = UniqSet Reg
60 type RegMap a = UniqFM a
62 emptyRegMap :: UniqFM a
63 emptyRegMap = emptyUFM
65 type BlockMap a = BlockEnv a
67 emptyBlockMap :: BlockEnv a
68 emptyBlockMap = emptyBlockEnv
71 -- | A top level thing which carries liveness information.
76 [SCC (LiveBasicBlock instr)]
79 -- | The register allocator also wants to use SPILL/RELOAD meta instructions,
80 -- so we'll keep those here.
82 -- | A real machine instruction
85 -- | spill this reg to a stack slot
88 -- | reload this reg from a stack slot
91 instance Instruction instr => Instruction (InstrSR instr) where
94 Instr instr -> regUsageOfInstr instr
95 SPILL reg _ -> RU [reg] []
96 RELOAD _ reg -> RU [] [reg]
100 Instr instr -> Instr (patchRegsOfInstr instr f)
101 SPILL reg slot -> SPILL (f reg) slot
102 RELOAD slot reg -> RELOAD slot (f reg)
106 Instr instr -> isJumpishInstr instr
111 Instr instr -> jumpDestsOfInstr instr
116 Instr instr -> Instr (patchJumpInstr instr f)
119 mkSpillInstr = error "mkSpillInstr[InstrSR]: Not making SPILL meta-instr"
120 mkLoadInstr = error "mkLoadInstr[InstrSR]: Not making LOAD meta-instr"
124 Instr instr -> takeDeltaInstr instr
129 Instr instr -> isMetaInstr instr
132 mkRegRegMoveInstr r1 r2 = Instr (mkRegRegMoveInstr r1 r2)
134 takeRegRegMoveInstr i
136 Instr instr -> takeRegRegMoveInstr instr
139 mkJumpInstr target = map Instr (mkJumpInstr target)
143 -- | An instruction with liveness information.
145 = LiveInstr (InstrSR instr) (Maybe Liveness)
147 -- | Liveness information.
148 -- The regs which die are ones which are no longer live in the *next* instruction
150 -- (NB. if the instruction is a jump, these registers might still be live
151 -- at the jump target(s) - you have to check the liveness at the destination
152 -- block to find out).
156 { liveBorn :: RegSet -- ^ registers born in this instruction (written to for first time).
157 , liveDieRead :: RegSet -- ^ registers that died because they were read for the last time.
158 , liveDieWrite :: RegSet } -- ^ registers that died because they were clobbered by something.
161 -- | Stash regs live on entry to each basic block in the info part of the cmm code.
164 [CmmStatic] -- cmm static stuff
165 (Maybe BlockId) -- id of the first block
166 (Maybe (BlockMap RegSet)) -- argument locals live on entry to this block
167 (Map BlockId (Set Int)) -- stack slots live on entry to this block
170 -- | A basic block with liveness information.
171 type LiveBasicBlock instr
172 = GenBasicBlock (LiveInstr instr)
175 instance Outputable instr
176 => Outputable (InstrSR instr) where
178 ppr (Instr realInstr)
183 ptext (sLit "\tSPILL"),
187 ptext (sLit "SLOT") <> parens (int slot)]
189 ppr (RELOAD slot reg)
191 ptext (sLit "\tRELOAD"),
193 ptext (sLit "SLOT") <> parens (int slot),
197 instance Outputable instr
198 => Outputable (LiveInstr instr) where
200 ppr (LiveInstr instr Nothing)
203 ppr (LiveInstr instr (Just live))
207 [ pprRegs (ptext (sLit "# born: ")) (liveBorn live)
208 , pprRegs (ptext (sLit "# r_dying: ")) (liveDieRead live)
209 , pprRegs (ptext (sLit "# w_dying: ")) (liveDieWrite live) ]
212 where pprRegs :: SDoc -> RegSet -> SDoc
214 | isEmptyUniqSet regs = empty
215 | otherwise = name <> (hcat $ punctuate space $ map ppr $ uniqSetToList regs)
217 instance Outputable LiveInfo where
218 ppr (LiveInfo static firstId liveVRegsOnEntry liveSlotsOnEntry)
219 = (vcat $ map ppr static)
220 $$ text "# firstId = " <> ppr firstId
221 $$ text "# liveVRegsOnEntry = " <> ppr liveVRegsOnEntry
222 $$ text "# liveSlotsOnEntry = " <> text (show liveSlotsOnEntry)
226 -- | map a function across all the basic blocks in this code
229 :: (LiveBasicBlock instr -> LiveBasicBlock instr)
230 -> LiveCmmTop instr -> LiveCmmTop instr
233 = evalState (mapBlockTopM (\x -> return $ f x) cmm) ()
236 -- | map a function across all the basic blocks in this code (monadic version)
240 => (LiveBasicBlock instr -> m (LiveBasicBlock instr))
241 -> LiveCmmTop instr -> m (LiveCmmTop instr)
243 mapBlockTopM _ cmm@(CmmData{})
246 mapBlockTopM f (CmmProc header label params sccs)
247 = do sccs' <- mapM (mapSCCM f) sccs
248 return $ CmmProc header label params sccs'
250 mapSCCM :: Monad m => (a -> m b) -> SCC a -> m (SCC b)
251 mapSCCM f (AcyclicSCC x)
253 return $ AcyclicSCC x'
255 mapSCCM f (CyclicSCC xs)
256 = do xs' <- mapM f xs
257 return $ CyclicSCC xs'
260 -- map a function across all the basic blocks in this code
262 :: (GenBasicBlock i -> GenBasicBlock i)
263 -> (GenCmmTop d h (ListGraph i) -> GenCmmTop d h (ListGraph i))
266 = evalState (mapGenBlockTopM (\x -> return $ f x) cmm) ()
269 -- | map a function across all the basic blocks in this code (monadic version)
272 => (GenBasicBlock i -> m (GenBasicBlock i))
273 -> (GenCmmTop d h (ListGraph i) -> m (GenCmmTop d h (ListGraph i)))
275 mapGenBlockTopM _ cmm@(CmmData{})
278 mapGenBlockTopM f (CmmProc header label params (ListGraph blocks))
279 = do blocks' <- mapM f blocks
280 return $ CmmProc header label params (ListGraph blocks')
283 -- | Slurp out the list of register conflicts and reg-reg moves from this top level thing.
284 -- Slurping of conflicts and moves is wrapped up together so we don't have
285 -- to make two passes over the same code when we want to build the graph.
290 -> (Bag (UniqSet Reg), Bag (Reg, Reg))
293 = slurpCmm (emptyBag, emptyBag) live
295 where slurpCmm rs CmmData{} = rs
296 slurpCmm rs (CmmProc info _ _ sccs)
297 = foldl' (slurpSCC info) rs sccs
299 slurpSCC info rs (AcyclicSCC b)
300 = slurpBlock info rs b
302 slurpSCC info rs (CyclicSCC bs)
303 = foldl' (slurpBlock info) rs bs
305 slurpBlock info rs (BasicBlock blockId instrs)
306 | LiveInfo _ _ (Just blockLive) _ <- info
307 , Just rsLiveEntry <- lookupBlockEnv blockLive blockId
308 , (conflicts, moves) <- slurpLIs rsLiveEntry rs instrs
309 = (consBag rsLiveEntry conflicts, moves)
312 = panic "Liveness.slurpConflicts: bad block"
314 slurpLIs rsLive (conflicts, moves) []
315 = (consBag rsLive conflicts, moves)
317 slurpLIs rsLive rs (LiveInstr _ Nothing : lis)
318 = slurpLIs rsLive rs lis
320 slurpLIs rsLiveEntry (conflicts, moves) (LiveInstr instr (Just live) : lis)
322 -- regs that die because they are read for the last time at the start of an instruction
323 -- are not live across it.
324 rsLiveAcross = rsLiveEntry `minusUniqSet` (liveDieRead live)
326 -- regs live on entry to the next instruction.
327 -- be careful of orphans, make sure to delete dying regs _after_ unioning
328 -- in the ones that are born here.
329 rsLiveNext = (rsLiveAcross `unionUniqSets` (liveBorn live))
330 `minusUniqSet` (liveDieWrite live)
332 -- orphan vregs are the ones that die in the same instruction they are born in.
333 -- these are likely to be results that are never used, but we still
334 -- need to assign a hreg to them..
335 rsOrphans = intersectUniqSets
337 (unionUniqSets (liveDieWrite live) (liveDieRead live))
340 rsConflicts = unionUniqSets rsLiveNext rsOrphans
342 in case takeRegRegMoveInstr instr of
343 Just rr -> slurpLIs rsLiveNext
344 ( consBag rsConflicts conflicts
345 , consBag rr moves) lis
347 Nothing -> slurpLIs rsLiveNext
348 ( consBag rsConflicts conflicts
352 -- | For spill\/reloads
358 -- If we can arrange that v1 and v2 are allocated to the same hreg it's more likely
359 -- the spill\/reload instrs can be cleaned and replaced by a nop reg-reg move.
363 :: forall instr. Instruction instr
367 slurpReloadCoalesce live
368 = slurpCmm emptyBag live
371 slurpCmm :: Bag (Reg, Reg)
372 -> GenCmmTop t t1 [SCC (LiveBasicBlock instr)]
374 slurpCmm cs CmmData{} = cs
375 slurpCmm cs (CmmProc _ _ _ sccs)
376 = slurpComp cs (flattenSCCs sccs)
378 slurpComp :: Bag (Reg, Reg)
379 -> [LiveBasicBlock instr]
382 = let (moveBags, _) = runState (slurpCompM blocks) emptyUFM
383 in unionManyBags (cs : moveBags)
385 slurpCompM :: [LiveBasicBlock instr]
386 -> State (UniqFM [UniqFM Reg]) [Bag (Reg, Reg)]
388 = do -- run the analysis once to record the mapping across jumps.
389 mapM_ (slurpBlock False) blocks
391 -- run it a second time while using the information from the last pass.
392 -- We /could/ run this many more times to deal with graphical control
393 -- flow and propagating info across multiple jumps, but it's probably
394 -- not worth the trouble.
395 mapM (slurpBlock True) blocks
397 slurpBlock :: Bool -> LiveBasicBlock instr
398 -> State (UniqFM [UniqFM Reg]) (Bag (Reg, Reg))
399 slurpBlock propagate (BasicBlock blockId instrs)
400 = do -- grab the slot map for entry to this block
401 slotMap <- if propagate
402 then getSlotMap blockId
405 (_, mMoves) <- mapAccumLM slurpLI slotMap instrs
406 return $ listToBag $ catMaybes mMoves
408 slurpLI :: UniqFM Reg -- current slotMap
410 -> State (UniqFM [UniqFM Reg]) -- blockId -> [slot -> reg]
411 -- for tracking slotMaps across jumps
413 ( UniqFM Reg -- new slotMap
414 , Maybe (Reg, Reg)) -- maybe a new coalesce edge
418 -- remember what reg was stored into the slot
419 | LiveInstr (SPILL reg slot) _ <- li
420 , slotMap' <- addToUFM slotMap slot reg
421 = return (slotMap', Nothing)
423 -- add an edge betwen the this reg and the last one stored into the slot
424 | LiveInstr (RELOAD slot reg) _ <- li
425 = case lookupUFM slotMap slot of
427 | reg /= reg2 -> return (slotMap, Just (reg, reg2))
428 | otherwise -> return (slotMap, Nothing)
430 Nothing -> return (slotMap, Nothing)
432 -- if we hit a jump, remember the current slotMap
433 | LiveInstr (Instr instr) _ <- li
434 , targets <- jumpDestsOfInstr instr
436 = do mapM_ (accSlotMap slotMap) targets
437 return (slotMap, Nothing)
440 = return (slotMap, Nothing)
442 -- record a slotmap for an in edge to this block
443 accSlotMap slotMap blockId
444 = modify (\s -> addToUFM_C (++) s blockId [slotMap])
446 -- work out the slot map on entry to this block
447 -- if we have slot maps for multiple in-edges then we need to merge them.
450 let slotMaps = fromMaybe [] (lookupUFM map blockId)
451 return $ foldr mergeSlotMaps emptyUFM slotMaps
453 mergeSlotMaps :: UniqFM Reg -> UniqFM Reg -> UniqFM Reg
454 mergeSlotMaps map1 map2
456 $ [ (k, r1) | (k, r1) <- ufmToList map1
457 , case lookupUFM map2 k of
459 Just r2 -> r1 == r2 ]
462 -- | Strip away liveness information, yielding NatCmmTop
464 :: (Outputable instr, Instruction instr)
471 where stripCmm (CmmData sec ds) = CmmData sec ds
473 stripCmm (CmmProc (LiveInfo info (Just first_id) _ _) label params sccs)
474 = let final_blocks = flattenSCCs sccs
476 -- make sure the block that was first in the input list
477 -- stays at the front of the output. This is the entry point
478 -- of the proc, and it needs to come first.
480 = partition ((== first_id) . blockId) final_blocks
482 in CmmProc info label params
483 (ListGraph $ map stripLiveBlock $ first' : rest')
485 -- procs used for stg_split_markers don't contain any blocks, and have no first_id.
486 stripCmm (CmmProc (LiveInfo info Nothing _ _) label params [])
487 = CmmProc info label params (ListGraph [])
489 -- If the proc has blocks but we don't know what the first one was, then we're dead.
491 = pprPanic "RegAlloc.Liveness.stripLive: no first_id on proc" (ppr proc)
494 -- | Strip away liveness information from a basic block,
495 -- and make real spill instructions out of SPILL, RELOAD pseudos along the way.
499 => LiveBasicBlock instr
500 -> NatBasicBlock instr
502 stripLiveBlock (BasicBlock i lis)
503 = BasicBlock i instrs'
506 = runState (spillNat [] lis) 0
509 = return (reverse acc)
511 spillNat acc (LiveInstr (SPILL reg slot) _ : instrs)
513 spillNat (mkSpillInstr reg delta slot : acc) instrs
515 spillNat acc (LiveInstr (RELOAD slot reg) _ : instrs)
517 spillNat (mkLoadInstr reg delta slot : acc) instrs
519 spillNat acc (LiveInstr (Instr instr) _ : instrs)
520 | Just i <- takeDeltaInstr instr
524 spillNat acc (LiveInstr (Instr instr) _ : instrs)
525 = spillNat (instr : acc) instrs
528 -- | Erase Delta instructions.
536 = mapBlockTop eraseBlock cmm
538 eraseBlock (BasicBlock id lis)
540 $ filter (\(LiveInstr i _) -> not $ isJust $ takeDeltaInstr i)
544 -- | Patch the registers in this code according to this register mapping.
545 -- also erase reg -> reg moves when the reg is the same.
546 -- also erase reg -> reg moves when the destination dies in this instr.
550 -> LiveCmmTop instr -> LiveCmmTop instr
552 patchEraseLive patchF cmm
555 patchCmm cmm@CmmData{} = cmm
557 patchCmm (CmmProc info label params sccs)
558 | LiveInfo static id (Just blockMap) mLiveSlots <- info
560 patchRegSet set = mkUniqSet $ map patchF $ uniqSetToList set
561 blockMap' = mapBlockEnv patchRegSet blockMap
563 info' = LiveInfo static id (Just blockMap') mLiveSlots
564 in CmmProc info' label params $ map patchSCC sccs
567 = panic "RegAlloc.Liveness.patchEraseLive: no blockMap"
569 patchSCC (AcyclicSCC b) = AcyclicSCC (patchBlock b)
570 patchSCC (CyclicSCC bs) = CyclicSCC (map patchBlock bs)
572 patchBlock (BasicBlock id lis)
573 = BasicBlock id $ patchInstrs lis
576 patchInstrs (li : lis)
578 | LiveInstr i (Just live) <- li'
579 , Just (r1, r2) <- takeRegRegMoveInstr i
584 = li' : patchInstrs lis
586 where li' = patchRegsLiveInstr patchF li
589 -- source and destination regs are the same
592 -- desination reg is never used
593 | elementOfUniqSet r2 (liveBorn live)
594 , elementOfUniqSet r2 (liveDieRead live) || elementOfUniqSet r2 (liveDieWrite live)
600 -- | Patch registers in this LiveInstr, including the liveness information.
605 -> LiveInstr instr -> LiveInstr instr
607 patchRegsLiveInstr patchF li
609 LiveInstr instr Nothing
610 -> LiveInstr (patchRegsOfInstr instr patchF) Nothing
612 LiveInstr instr (Just live)
614 (patchRegsOfInstr instr patchF)
616 { -- WARNING: have to go via lists here because patchF changes the uniq in the Reg
617 liveBorn = mkUniqSet $ map patchF $ uniqSetToList $ liveBorn live
618 , liveDieRead = mkUniqSet $ map patchF $ uniqSetToList $ liveDieRead live
619 , liveDieWrite = mkUniqSet $ map patchF $ uniqSetToList $ liveDieWrite live })
622 --------------------------------------------------------------------------------
623 -- | Convert a NatCmmTop to a LiveCmmTop, with empty liveness information
630 natCmmTopToLive (CmmData i d)
633 natCmmTopToLive (CmmProc info lbl params (ListGraph []))
634 = CmmProc (LiveInfo info Nothing Nothing Map.empty)
637 natCmmTopToLive (CmmProc info lbl params (ListGraph blocks@(first : _)))
638 = let first_id = blockId first
639 sccs = sccBlocks blocks
640 sccsLive = map (fmap (\(BasicBlock l instrs) ->
641 BasicBlock l (map (\i -> LiveInstr (Instr i) Nothing) instrs)))
644 in CmmProc (LiveInfo info (Just first_id) Nothing Map.empty)
650 => [NatBasicBlock instr]
651 -> [SCC (NatBasicBlock instr)]
653 sccBlocks blocks = stronglyConnCompFromEdgedVertices graph
655 getOutEdges :: Instruction instr => [instr] -> [BlockId]
656 getOutEdges instrs = concat $ map jumpDestsOfInstr instrs
658 graph = [ (block, getUnique id, map getUnique (getOutEdges instrs))
659 | block@(BasicBlock id instrs) <- blocks ]
662 ---------------------------------------------------------------------------------
663 -- Annotate code with register liveness information
666 :: (Outputable instr, Instruction instr)
668 -> UniqSM (LiveCmmTop instr)
670 regLiveness (CmmData i d)
671 = returnUs $ CmmData i d
673 regLiveness (CmmProc info lbl params [])
674 | LiveInfo static mFirst _ _ <- info
676 (LiveInfo static mFirst (Just emptyBlockEnv) Map.empty)
679 regLiveness (CmmProc info lbl params sccs)
680 | LiveInfo static mFirst _ liveSlotsOnEntry <- info
681 = let (ann_sccs, block_live) = computeLiveness sccs
683 in returnUs $ CmmProc (LiveInfo static mFirst (Just block_live) liveSlotsOnEntry)
687 -- -----------------------------------------------------------------------------
688 -- | Check ordering of Blocks
689 -- The computeLiveness function requires SCCs to be in reverse dependent order.
690 -- If they're not the liveness information will be wrong, and we'll get a bad allocation.
691 -- Better to check for this precondition explicitly or some other poor sucker will
692 -- waste a day staring at bad assembly code..
694 checkIsReverseDependent
696 => [SCC (LiveBasicBlock instr)] -- ^ SCCs of blocks that we're about to run the liveness determinator on.
697 -> Maybe BlockId -- ^ BlockIds that fail the test (if any)
699 checkIsReverseDependent sccs'
700 = go emptyUniqSet sccs'
705 go blocksSeen (AcyclicSCC block : sccs)
706 = let dests = slurpJumpDestsOfBlock block
707 blocksSeen' = unionUniqSets blocksSeen $ mkUniqSet [blockId block]
708 badDests = dests `minusUniqSet` blocksSeen'
709 in case uniqSetToList badDests of
710 [] -> go blocksSeen' sccs
713 go blocksSeen (CyclicSCC blocks : sccs)
714 = let dests = unionManyUniqSets $ map slurpJumpDestsOfBlock blocks
715 blocksSeen' = unionUniqSets blocksSeen $ mkUniqSet $ map blockId blocks
716 badDests = dests `minusUniqSet` blocksSeen'
717 in case uniqSetToList badDests of
718 [] -> go blocksSeen' sccs
721 slurpJumpDestsOfBlock (BasicBlock _ instrs)
723 $ map (mkUniqSet . jumpDestsOfInstr)
724 [ i | LiveInstr i _ <- instrs]
727 -- | If we've compute liveness info for this code already we have to reverse
728 -- the SCCs in each top to get them back to the right order so we can do it again.
729 reverseBlocksInTops :: LiveCmmTop instr -> LiveCmmTop instr
730 reverseBlocksInTops top
733 CmmProc info lbl params sccs -> CmmProc info lbl params (reverse sccs)
736 -- | Computing liveness
738 -- On entry, the SCCs must be in "reverse" order: later blocks may transfer
739 -- control to earlier ones only, else `panic`.
741 -- The SCCs returned are in the *opposite* order, which is exactly what we
742 -- want for the next pass.
745 :: (Outputable instr, Instruction instr)
746 => [SCC (LiveBasicBlock instr)]
747 -> ([SCC (LiveBasicBlock instr)], -- instructions annotated with list of registers
748 -- which are "dead after this instruction".
749 BlockMap RegSet) -- blocks annontated with set of live registers
750 -- on entry to the block.
753 = case checkIsReverseDependent sccs of
754 Nothing -> livenessSCCs emptyBlockMap [] sccs
755 Just bad -> pprPanic "RegAlloc.Liveness.computeLivenss"
756 (vcat [ text "SCCs aren't in reverse dependent order"
757 , text "bad blockId" <+> ppr bad
763 -> [SCC (LiveBasicBlock instr)] -- accum
764 -> [SCC (LiveBasicBlock instr)]
765 -> ( [SCC (LiveBasicBlock instr)]
768 livenessSCCs blockmap done []
771 livenessSCCs blockmap done (AcyclicSCC block : sccs)
772 = let (blockmap', block') = livenessBlock blockmap block
773 in livenessSCCs blockmap' (AcyclicSCC block' : done) sccs
775 livenessSCCs blockmap done
776 (CyclicSCC blocks : sccs) =
777 livenessSCCs blockmap' (CyclicSCC blocks':done) sccs
778 where (blockmap', blocks')
779 = iterateUntilUnchanged linearLiveness equalBlockMaps
782 iterateUntilUnchanged
783 :: (a -> b -> (a,c)) -> (a -> a -> Bool)
787 iterateUntilUnchanged f eq a b
790 groupBy (\(a1, _) (a2, _) -> eq a1 a2) $
791 iterate (\(a, _) -> f a b) $
792 (a, panic "RegLiveness.livenessSCCs")
797 => BlockMap RegSet -> [LiveBasicBlock instr]
798 -> (BlockMap RegSet, [LiveBasicBlock instr])
800 linearLiveness = mapAccumL livenessBlock
802 -- probably the least efficient way to compare two
803 -- BlockMaps for equality.
806 where a' = map f $ blockEnvToList a
807 b' = map f $ blockEnvToList b
808 f (key,elt) = (key, uniqSetToList elt)
812 -- | Annotate a basic block with register liveness information.
817 -> LiveBasicBlock instr
818 -> (BlockMap RegSet, LiveBasicBlock instr)
820 livenessBlock blockmap (BasicBlock block_id instrs)
822 (regsLiveOnEntry, instrs1)
823 = livenessBack emptyUniqSet blockmap [] (reverse instrs)
824 blockmap' = extendBlockEnv blockmap block_id regsLiveOnEntry
826 instrs2 = livenessForward regsLiveOnEntry instrs1
828 output = BasicBlock block_id instrs2
830 in ( blockmap', output)
832 -- | Calculate liveness going forwards,
833 -- filling in when regs are born
837 => RegSet -- regs live on this instr
838 -> [LiveInstr instr] -> [LiveInstr instr]
840 livenessForward _ [] = []
841 livenessForward rsLiveEntry (li@(LiveInstr instr mLive) : lis)
843 = li : livenessForward rsLiveEntry lis
846 , RU _ written <- regUsageOfInstr instr
848 -- Regs that are written to but weren't live on entry to this instruction
849 -- are recorded as being born here.
851 $ filter (\r -> not $ elementOfUniqSet r rsLiveEntry) written
853 rsLiveNext = (rsLiveEntry `unionUniqSets` rsBorn)
854 `minusUniqSet` (liveDieRead live)
855 `minusUniqSet` (liveDieWrite live)
857 in LiveInstr instr (Just live { liveBorn = rsBorn })
858 : livenessForward rsLiveNext lis
860 livenessForward _ _ = panic "RegLiveness.livenessForward: no match"
863 -- | Calculate liveness going backwards,
864 -- filling in when regs die, and what regs are live across each instruction
868 => RegSet -- regs live on this instr
869 -> BlockMap RegSet -- regs live on entry to other BBs
870 -> [LiveInstr instr] -- instructions (accum)
871 -> [LiveInstr instr] -- instructions
872 -> (RegSet, [LiveInstr instr])
874 livenessBack liveregs _ done [] = (liveregs, done)
876 livenessBack liveregs blockmap acc (instr : instrs)
877 = let (liveregs', instr') = liveness1 liveregs blockmap instr
878 in livenessBack liveregs' blockmap (instr' : acc) instrs
881 -- don't bother tagging comments or deltas with liveness
887 -> (RegSet, LiveInstr instr)
889 liveness1 liveregs _ (LiveInstr instr _)
891 = (liveregs, LiveInstr instr Nothing)
893 liveness1 liveregs blockmap (LiveInstr instr _)
896 = (liveregs1, LiveInstr instr
898 { liveBorn = emptyUniqSet
899 , liveDieRead = mkUniqSet r_dying
900 , liveDieWrite = mkUniqSet w_dying }))
903 = (liveregs_br, LiveInstr instr
905 { liveBorn = emptyUniqSet
906 , liveDieRead = mkUniqSet r_dying_br
907 , liveDieWrite = mkUniqSet w_dying }))
910 RU read written = regUsageOfInstr instr
912 -- registers that were written here are dead going backwards.
913 -- registers that were read here are live going backwards.
914 liveregs1 = (liveregs `delListFromUniqSet` written)
915 `addListToUniqSet` read
917 -- registers that are not live beyond this point, are recorded
919 r_dying = [ reg | reg <- read, reg `notElem` written,
920 not (elementOfUniqSet reg liveregs) ]
922 w_dying = [ reg | reg <- written,
923 not (elementOfUniqSet reg liveregs) ]
925 -- union in the live regs from all the jump destinations of this
927 targets = jumpDestsOfInstr instr -- where we go from here
928 not_a_branch = null targets
930 targetLiveRegs target
931 = case lookupBlockEnv blockmap target of
933 Nothing -> emptyRegMap
935 live_from_branch = unionManyUniqSets (map targetLiveRegs targets)
937 liveregs_br = liveregs1 `unionUniqSets` live_from_branch
939 -- registers that are live only in the branch targets should
940 -- be listed as dying here.
941 live_branch_only = live_from_branch `minusUniqSet` liveregs
942 r_dying_br = uniqSetToList (mkUniqSet r_dying `unionUniqSets`