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 OldCmm 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
68 -- | A top level thing which carries liveness information.
73 [SCC (LiveBasicBlock instr)]
76 -- | The register allocator also wants to use SPILL/RELOAD meta instructions,
77 -- so we'll keep those here.
79 -- | A real machine instruction
82 -- | spill this reg to a stack slot
85 -- | reload this reg from a stack slot
88 instance Instruction instr => Instruction (InstrSR instr) where
91 Instr instr -> regUsageOfInstr instr
92 SPILL reg _ -> RU [reg] []
93 RELOAD _ reg -> RU [] [reg]
97 Instr instr -> Instr (patchRegsOfInstr instr f)
98 SPILL reg slot -> SPILL (f reg) slot
99 RELOAD slot reg -> RELOAD slot (f reg)
103 Instr instr -> isJumpishInstr instr
108 Instr instr -> jumpDestsOfInstr instr
113 Instr instr -> Instr (patchJumpInstr instr f)
116 mkSpillInstr = error "mkSpillInstr[InstrSR]: Not making SPILL meta-instr"
117 mkLoadInstr = error "mkLoadInstr[InstrSR]: Not making LOAD meta-instr"
121 Instr instr -> takeDeltaInstr instr
126 Instr instr -> isMetaInstr instr
129 mkRegRegMoveInstr r1 r2 = Instr (mkRegRegMoveInstr r1 r2)
131 takeRegRegMoveInstr i
133 Instr instr -> takeRegRegMoveInstr instr
136 mkJumpInstr target = map Instr (mkJumpInstr target)
140 -- | An instruction with liveness information.
142 = LiveInstr (InstrSR instr) (Maybe Liveness)
144 -- | Liveness information.
145 -- The regs which die are ones which are no longer live in the *next* instruction
147 -- (NB. if the instruction is a jump, these registers might still be live
148 -- at the jump target(s) - you have to check the liveness at the destination
149 -- block to find out).
153 { liveBorn :: RegSet -- ^ registers born in this instruction (written to for first time).
154 , liveDieRead :: RegSet -- ^ registers that died because they were read for the last time.
155 , liveDieWrite :: RegSet } -- ^ registers that died because they were clobbered by something.
158 -- | Stash regs live on entry to each basic block in the info part of the cmm code.
161 [CmmStatic] -- cmm static stuff
162 (Maybe BlockId) -- id of the first block
163 (Maybe (BlockMap RegSet)) -- argument locals live on entry to this block
164 (Map BlockId (Set Int)) -- stack slots live on entry to this block
167 -- | A basic block with liveness information.
168 type LiveBasicBlock instr
169 = GenBasicBlock (LiveInstr instr)
172 instance Outputable instr
173 => Outputable (InstrSR instr) where
175 ppr (Instr realInstr)
180 ptext (sLit "\tSPILL"),
184 ptext (sLit "SLOT") <> parens (int slot)]
186 ppr (RELOAD slot reg)
188 ptext (sLit "\tRELOAD"),
190 ptext (sLit "SLOT") <> parens (int slot),
194 instance Outputable instr
195 => Outputable (LiveInstr instr) where
197 ppr (LiveInstr instr Nothing)
200 ppr (LiveInstr instr (Just live))
204 [ pprRegs (ptext (sLit "# born: ")) (liveBorn live)
205 , pprRegs (ptext (sLit "# r_dying: ")) (liveDieRead live)
206 , pprRegs (ptext (sLit "# w_dying: ")) (liveDieWrite live) ]
209 where pprRegs :: SDoc -> RegSet -> SDoc
211 | isEmptyUniqSet regs = empty
212 | otherwise = name <> (hcat $ punctuate space $ map ppr $ uniqSetToList regs)
214 instance Outputable LiveInfo where
215 ppr (LiveInfo static firstId liveVRegsOnEntry liveSlotsOnEntry)
216 = (vcat $ map ppr static)
217 $$ text "# firstId = " <> ppr firstId
218 $$ text "# liveVRegsOnEntry = " <> ppr liveVRegsOnEntry
219 $$ text "# liveSlotsOnEntry = " <> text (show liveSlotsOnEntry)
223 -- | map a function across all the basic blocks in this code
226 :: (LiveBasicBlock instr -> LiveBasicBlock instr)
227 -> LiveCmmTop instr -> LiveCmmTop instr
230 = evalState (mapBlockTopM (\x -> return $ f x) cmm) ()
233 -- | map a function across all the basic blocks in this code (monadic version)
237 => (LiveBasicBlock instr -> m (LiveBasicBlock instr))
238 -> LiveCmmTop instr -> m (LiveCmmTop instr)
240 mapBlockTopM _ cmm@(CmmData{})
243 mapBlockTopM f (CmmProc header label sccs)
244 = do sccs' <- mapM (mapSCCM f) sccs
245 return $ CmmProc header label sccs'
247 mapSCCM :: Monad m => (a -> m b) -> SCC a -> m (SCC b)
248 mapSCCM f (AcyclicSCC x)
250 return $ AcyclicSCC x'
252 mapSCCM f (CyclicSCC xs)
253 = do xs' <- mapM f xs
254 return $ CyclicSCC xs'
257 -- map a function across all the basic blocks in this code
259 :: (GenBasicBlock i -> GenBasicBlock i)
260 -> (GenCmmTop d h (ListGraph i) -> GenCmmTop d h (ListGraph i))
263 = evalState (mapGenBlockTopM (\x -> return $ f x) cmm) ()
266 -- | map a function across all the basic blocks in this code (monadic version)
269 => (GenBasicBlock i -> m (GenBasicBlock i))
270 -> (GenCmmTop d h (ListGraph i) -> m (GenCmmTop d h (ListGraph i)))
272 mapGenBlockTopM _ cmm@(CmmData{})
275 mapGenBlockTopM f (CmmProc header label (ListGraph blocks))
276 = do blocks' <- mapM f blocks
277 return $ CmmProc header label (ListGraph blocks')
280 -- | Slurp out the list of register conflicts and reg-reg moves from this top level thing.
281 -- Slurping of conflicts and moves is wrapped up together so we don't have
282 -- to make two passes over the same code when we want to build the graph.
287 -> (Bag (UniqSet Reg), Bag (Reg, Reg))
290 = slurpCmm (emptyBag, emptyBag) live
292 where slurpCmm rs CmmData{} = rs
293 slurpCmm rs (CmmProc info _ sccs)
294 = foldl' (slurpSCC info) rs sccs
296 slurpSCC info rs (AcyclicSCC b)
297 = slurpBlock info rs b
299 slurpSCC info rs (CyclicSCC bs)
300 = foldl' (slurpBlock info) rs bs
302 slurpBlock info rs (BasicBlock blockId instrs)
303 | LiveInfo _ _ (Just blockLive) _ <- info
304 , Just rsLiveEntry <- mapLookup blockId blockLive
305 , (conflicts, moves) <- slurpLIs rsLiveEntry rs instrs
306 = (consBag rsLiveEntry conflicts, moves)
309 = panic "Liveness.slurpConflicts: bad block"
311 slurpLIs rsLive (conflicts, moves) []
312 = (consBag rsLive conflicts, moves)
314 slurpLIs rsLive rs (LiveInstr _ Nothing : lis)
315 = slurpLIs rsLive rs lis
317 slurpLIs rsLiveEntry (conflicts, moves) (LiveInstr instr (Just live) : lis)
319 -- regs that die because they are read for the last time at the start of an instruction
320 -- are not live across it.
321 rsLiveAcross = rsLiveEntry `minusUniqSet` (liveDieRead live)
323 -- regs live on entry to the next instruction.
324 -- be careful of orphans, make sure to delete dying regs _after_ unioning
325 -- in the ones that are born here.
326 rsLiveNext = (rsLiveAcross `unionUniqSets` (liveBorn live))
327 `minusUniqSet` (liveDieWrite live)
329 -- orphan vregs are the ones that die in the same instruction they are born in.
330 -- these are likely to be results that are never used, but we still
331 -- need to assign a hreg to them..
332 rsOrphans = intersectUniqSets
334 (unionUniqSets (liveDieWrite live) (liveDieRead live))
337 rsConflicts = unionUniqSets rsLiveNext rsOrphans
339 in case takeRegRegMoveInstr instr of
340 Just rr -> slurpLIs rsLiveNext
341 ( consBag rsConflicts conflicts
342 , consBag rr moves) lis
344 Nothing -> slurpLIs rsLiveNext
345 ( consBag rsConflicts conflicts
349 -- | For spill\/reloads
355 -- If we can arrange that v1 and v2 are allocated to the same hreg it's more likely
356 -- the spill\/reload instrs can be cleaned and replaced by a nop reg-reg move.
360 :: forall instr. Instruction instr
364 slurpReloadCoalesce live
365 = slurpCmm emptyBag live
368 slurpCmm :: Bag (Reg, Reg)
369 -> GenCmmTop t t1 [SCC (LiveBasicBlock instr)]
371 slurpCmm cs CmmData{} = cs
372 slurpCmm cs (CmmProc _ _ sccs)
373 = slurpComp cs (flattenSCCs sccs)
375 slurpComp :: Bag (Reg, Reg)
376 -> [LiveBasicBlock instr]
379 = let (moveBags, _) = runState (slurpCompM blocks) emptyUFM
380 in unionManyBags (cs : moveBags)
382 slurpCompM :: [LiveBasicBlock instr]
383 -> State (UniqFM [UniqFM Reg]) [Bag (Reg, Reg)]
385 = do -- run the analysis once to record the mapping across jumps.
386 mapM_ (slurpBlock False) blocks
388 -- run it a second time while using the information from the last pass.
389 -- We /could/ run this many more times to deal with graphical control
390 -- flow and propagating info across multiple jumps, but it's probably
391 -- not worth the trouble.
392 mapM (slurpBlock True) blocks
394 slurpBlock :: Bool -> LiveBasicBlock instr
395 -> State (UniqFM [UniqFM Reg]) (Bag (Reg, Reg))
396 slurpBlock propagate (BasicBlock blockId instrs)
397 = do -- grab the slot map for entry to this block
398 slotMap <- if propagate
399 then getSlotMap blockId
402 (_, mMoves) <- mapAccumLM slurpLI slotMap instrs
403 return $ listToBag $ catMaybes mMoves
405 slurpLI :: UniqFM Reg -- current slotMap
407 -> State (UniqFM [UniqFM Reg]) -- blockId -> [slot -> reg]
408 -- for tracking slotMaps across jumps
410 ( UniqFM Reg -- new slotMap
411 , Maybe (Reg, Reg)) -- maybe a new coalesce edge
415 -- remember what reg was stored into the slot
416 | LiveInstr (SPILL reg slot) _ <- li
417 , slotMap' <- addToUFM slotMap slot reg
418 = return (slotMap', Nothing)
420 -- add an edge betwen the this reg and the last one stored into the slot
421 | LiveInstr (RELOAD slot reg) _ <- li
422 = case lookupUFM slotMap slot of
424 | reg /= reg2 -> return (slotMap, Just (reg, reg2))
425 | otherwise -> return (slotMap, Nothing)
427 Nothing -> return (slotMap, Nothing)
429 -- if we hit a jump, remember the current slotMap
430 | LiveInstr (Instr instr) _ <- li
431 , targets <- jumpDestsOfInstr instr
433 = do mapM_ (accSlotMap slotMap) targets
434 return (slotMap, Nothing)
437 = return (slotMap, Nothing)
439 -- record a slotmap for an in edge to this block
440 accSlotMap slotMap blockId
441 = modify (\s -> addToUFM_C (++) s blockId [slotMap])
443 -- work out the slot map on entry to this block
444 -- if we have slot maps for multiple in-edges then we need to merge them.
447 let slotMaps = fromMaybe [] (lookupUFM map blockId)
448 return $ foldr mergeSlotMaps emptyUFM slotMaps
450 mergeSlotMaps :: UniqFM Reg -> UniqFM Reg -> UniqFM Reg
451 mergeSlotMaps map1 map2
453 $ [ (k, r1) | (k, r1) <- ufmToList map1
454 , case lookupUFM map2 k of
456 Just r2 -> r1 == r2 ]
459 -- | Strip away liveness information, yielding NatCmmTop
461 :: (Outputable instr, Instruction instr)
468 where stripCmm (CmmData sec ds) = CmmData sec ds
469 stripCmm (CmmProc (LiveInfo info (Just first_id) _ _) label sccs)
470 = let final_blocks = flattenSCCs sccs
472 -- make sure the block that was first in the input list
473 -- stays at the front of the output. This is the entry point
474 -- of the proc, and it needs to come first.
476 = partition ((== first_id) . blockId) final_blocks
478 in CmmProc info label
479 (ListGraph $ map stripLiveBlock $ first' : rest')
481 -- procs used for stg_split_markers don't contain any blocks, and have no first_id.
482 stripCmm (CmmProc (LiveInfo info Nothing _ _) label [])
483 = CmmProc info label (ListGraph [])
485 -- If the proc has blocks but we don't know what the first one was, then we're dead.
487 = pprPanic "RegAlloc.Liveness.stripLive: no first_id on proc" (ppr proc)
490 -- | Strip away liveness information from a basic block,
491 -- and make real spill instructions out of SPILL, RELOAD pseudos along the way.
495 => LiveBasicBlock instr
496 -> NatBasicBlock instr
498 stripLiveBlock (BasicBlock i lis)
499 = BasicBlock i instrs'
502 = runState (spillNat [] lis) 0
505 = return (reverse acc)
507 spillNat acc (LiveInstr (SPILL reg slot) _ : instrs)
509 spillNat (mkSpillInstr reg delta slot : acc) instrs
511 spillNat acc (LiveInstr (RELOAD slot reg) _ : instrs)
513 spillNat (mkLoadInstr reg delta slot : acc) instrs
515 spillNat acc (LiveInstr (Instr instr) _ : instrs)
516 | Just i <- takeDeltaInstr instr
520 spillNat acc (LiveInstr (Instr instr) _ : instrs)
521 = spillNat (instr : acc) instrs
524 -- | Erase Delta instructions.
532 = mapBlockTop eraseBlock cmm
534 eraseBlock (BasicBlock id lis)
536 $ filter (\(LiveInstr i _) -> not $ isJust $ takeDeltaInstr i)
540 -- | Patch the registers in this code according to this register mapping.
541 -- also erase reg -> reg moves when the reg is the same.
542 -- also erase reg -> reg moves when the destination dies in this instr.
546 -> LiveCmmTop instr -> LiveCmmTop instr
548 patchEraseLive patchF cmm
551 patchCmm cmm@CmmData{} = cmm
553 patchCmm (CmmProc info label sccs)
554 | LiveInfo static id (Just blockMap) mLiveSlots <- info
556 patchRegSet set = mkUniqSet $ map patchF $ uniqSetToList set
557 blockMap' = mapMap patchRegSet blockMap
559 info' = LiveInfo static id (Just blockMap') mLiveSlots
560 in CmmProc info' label $ map patchSCC sccs
563 = panic "RegAlloc.Liveness.patchEraseLive: no blockMap"
565 patchSCC (AcyclicSCC b) = AcyclicSCC (patchBlock b)
566 patchSCC (CyclicSCC bs) = CyclicSCC (map patchBlock bs)
568 patchBlock (BasicBlock id lis)
569 = BasicBlock id $ patchInstrs lis
572 patchInstrs (li : lis)
574 | LiveInstr i (Just live) <- li'
575 , Just (r1, r2) <- takeRegRegMoveInstr i
580 = li' : patchInstrs lis
582 where li' = patchRegsLiveInstr patchF li
585 -- source and destination regs are the same
588 -- desination reg is never used
589 | elementOfUniqSet r2 (liveBorn live)
590 , elementOfUniqSet r2 (liveDieRead live) || elementOfUniqSet r2 (liveDieWrite live)
596 -- | Patch registers in this LiveInstr, including the liveness information.
601 -> LiveInstr instr -> LiveInstr instr
603 patchRegsLiveInstr patchF li
605 LiveInstr instr Nothing
606 -> LiveInstr (patchRegsOfInstr instr patchF) Nothing
608 LiveInstr instr (Just live)
610 (patchRegsOfInstr instr patchF)
612 { -- WARNING: have to go via lists here because patchF changes the uniq in the Reg
613 liveBorn = mkUniqSet $ map patchF $ uniqSetToList $ liveBorn live
614 , liveDieRead = mkUniqSet $ map patchF $ uniqSetToList $ liveDieRead live
615 , liveDieWrite = mkUniqSet $ map patchF $ uniqSetToList $ liveDieWrite live })
618 --------------------------------------------------------------------------------
619 -- | Convert a NatCmmTop to a LiveCmmTop, with empty liveness information
626 natCmmTopToLive (CmmData i d)
629 natCmmTopToLive (CmmProc info lbl (ListGraph []))
630 = CmmProc (LiveInfo info Nothing Nothing Map.empty) lbl []
632 natCmmTopToLive (CmmProc info lbl (ListGraph blocks@(first : _)))
633 = let first_id = blockId first
634 sccs = sccBlocks blocks
635 sccsLive = map (fmap (\(BasicBlock l instrs) ->
636 BasicBlock l (map (\i -> LiveInstr (Instr i) Nothing) instrs)))
639 in CmmProc (LiveInfo info (Just first_id) Nothing Map.empty) lbl sccsLive
644 => [NatBasicBlock instr]
645 -> [SCC (NatBasicBlock instr)]
647 sccBlocks blocks = stronglyConnCompFromEdgedVertices graph
649 getOutEdges :: Instruction instr => [instr] -> [BlockId]
650 getOutEdges instrs = concat $ map jumpDestsOfInstr instrs
652 graph = [ (block, getUnique id, map getUnique (getOutEdges instrs))
653 | block@(BasicBlock id instrs) <- blocks ]
656 ---------------------------------------------------------------------------------
657 -- Annotate code with register liveness information
660 :: (Outputable instr, Instruction instr)
662 -> UniqSM (LiveCmmTop instr)
664 regLiveness (CmmData i d)
665 = returnUs $ CmmData i d
667 regLiveness (CmmProc info lbl [])
668 | LiveInfo static mFirst _ _ <- info
670 (LiveInfo static mFirst (Just mapEmpty) Map.empty)
673 regLiveness (CmmProc info lbl sccs)
674 | LiveInfo static mFirst _ liveSlotsOnEntry <- info
675 = let (ann_sccs, block_live) = computeLiveness sccs
677 in returnUs $ CmmProc (LiveInfo static mFirst (Just block_live) liveSlotsOnEntry)
681 -- -----------------------------------------------------------------------------
682 -- | Check ordering of Blocks
683 -- The computeLiveness function requires SCCs to be in reverse dependent order.
684 -- If they're not the liveness information will be wrong, and we'll get a bad allocation.
685 -- Better to check for this precondition explicitly or some other poor sucker will
686 -- waste a day staring at bad assembly code..
688 checkIsReverseDependent
690 => [SCC (LiveBasicBlock instr)] -- ^ SCCs of blocks that we're about to run the liveness determinator on.
691 -> Maybe BlockId -- ^ BlockIds that fail the test (if any)
693 checkIsReverseDependent sccs'
694 = go emptyUniqSet sccs'
699 go blocksSeen (AcyclicSCC block : sccs)
700 = let dests = slurpJumpDestsOfBlock block
701 blocksSeen' = unionUniqSets blocksSeen $ mkUniqSet [blockId block]
702 badDests = dests `minusUniqSet` blocksSeen'
703 in case uniqSetToList badDests of
704 [] -> go blocksSeen' sccs
707 go blocksSeen (CyclicSCC blocks : sccs)
708 = let dests = unionManyUniqSets $ map slurpJumpDestsOfBlock blocks
709 blocksSeen' = unionUniqSets blocksSeen $ mkUniqSet $ map blockId blocks
710 badDests = dests `minusUniqSet` blocksSeen'
711 in case uniqSetToList badDests of
712 [] -> go blocksSeen' sccs
715 slurpJumpDestsOfBlock (BasicBlock _ instrs)
717 $ map (mkUniqSet . jumpDestsOfInstr)
718 [ i | LiveInstr i _ <- instrs]
721 -- | If we've compute liveness info for this code already we have to reverse
722 -- the SCCs in each top to get them back to the right order so we can do it again.
723 reverseBlocksInTops :: LiveCmmTop instr -> LiveCmmTop instr
724 reverseBlocksInTops top
727 CmmProc info lbl sccs -> CmmProc info lbl (reverse sccs)
730 -- | Computing liveness
732 -- On entry, the SCCs must be in "reverse" order: later blocks may transfer
733 -- control to earlier ones only, else `panic`.
735 -- The SCCs returned are in the *opposite* order, which is exactly what we
736 -- want for the next pass.
739 :: (Outputable instr, Instruction instr)
740 => [SCC (LiveBasicBlock instr)]
741 -> ([SCC (LiveBasicBlock instr)], -- instructions annotated with list of registers
742 -- which are "dead after this instruction".
743 BlockMap RegSet) -- blocks annontated with set of live registers
744 -- on entry to the block.
747 = case checkIsReverseDependent sccs of
748 Nothing -> livenessSCCs emptyBlockMap [] sccs
749 Just bad -> pprPanic "RegAlloc.Liveness.computeLivenss"
750 (vcat [ text "SCCs aren't in reverse dependent order"
751 , text "bad blockId" <+> ppr bad
757 -> [SCC (LiveBasicBlock instr)] -- accum
758 -> [SCC (LiveBasicBlock instr)]
759 -> ( [SCC (LiveBasicBlock instr)]
762 livenessSCCs blockmap done []
765 livenessSCCs blockmap done (AcyclicSCC block : sccs)
766 = let (blockmap', block') = livenessBlock blockmap block
767 in livenessSCCs blockmap' (AcyclicSCC block' : done) sccs
769 livenessSCCs blockmap done
770 (CyclicSCC blocks : sccs) =
771 livenessSCCs blockmap' (CyclicSCC blocks':done) sccs
772 where (blockmap', blocks')
773 = iterateUntilUnchanged linearLiveness equalBlockMaps
776 iterateUntilUnchanged
777 :: (a -> b -> (a,c)) -> (a -> a -> Bool)
781 iterateUntilUnchanged f eq a b
784 groupBy (\(a1, _) (a2, _) -> eq a1 a2) $
785 iterate (\(a, _) -> f a b) $
786 (a, panic "RegLiveness.livenessSCCs")
791 => BlockMap RegSet -> [LiveBasicBlock instr]
792 -> (BlockMap RegSet, [LiveBasicBlock instr])
794 linearLiveness = mapAccumL livenessBlock
796 -- probably the least efficient way to compare two
797 -- BlockMaps for equality.
800 where a' = map f $ mapToList a
801 b' = map f $ mapToList b
802 f (key,elt) = (key, uniqSetToList elt)
806 -- | Annotate a basic block with register liveness information.
811 -> LiveBasicBlock instr
812 -> (BlockMap RegSet, LiveBasicBlock instr)
814 livenessBlock blockmap (BasicBlock block_id instrs)
816 (regsLiveOnEntry, instrs1)
817 = livenessBack emptyUniqSet blockmap [] (reverse instrs)
818 blockmap' = mapInsert block_id regsLiveOnEntry blockmap
820 instrs2 = livenessForward regsLiveOnEntry instrs1
822 output = BasicBlock block_id instrs2
824 in ( blockmap', output)
826 -- | Calculate liveness going forwards,
827 -- filling in when regs are born
831 => RegSet -- regs live on this instr
832 -> [LiveInstr instr] -> [LiveInstr instr]
834 livenessForward _ [] = []
835 livenessForward rsLiveEntry (li@(LiveInstr instr mLive) : lis)
837 = li : livenessForward rsLiveEntry lis
840 , RU _ written <- regUsageOfInstr instr
842 -- Regs that are written to but weren't live on entry to this instruction
843 -- are recorded as being born here.
845 $ filter (\r -> not $ elementOfUniqSet r rsLiveEntry) written
847 rsLiveNext = (rsLiveEntry `unionUniqSets` rsBorn)
848 `minusUniqSet` (liveDieRead live)
849 `minusUniqSet` (liveDieWrite live)
851 in LiveInstr instr (Just live { liveBorn = rsBorn })
852 : livenessForward rsLiveNext lis
854 livenessForward _ _ = panic "RegLiveness.livenessForward: no match"
857 -- | Calculate liveness going backwards,
858 -- filling in when regs die, and what regs are live across each instruction
862 => RegSet -- regs live on this instr
863 -> BlockMap RegSet -- regs live on entry to other BBs
864 -> [LiveInstr instr] -- instructions (accum)
865 -> [LiveInstr instr] -- instructions
866 -> (RegSet, [LiveInstr instr])
868 livenessBack liveregs _ done [] = (liveregs, done)
870 livenessBack liveregs blockmap acc (instr : instrs)
871 = let (liveregs', instr') = liveness1 liveregs blockmap instr
872 in livenessBack liveregs' blockmap (instr' : acc) instrs
875 -- don't bother tagging comments or deltas with liveness
881 -> (RegSet, LiveInstr instr)
883 liveness1 liveregs _ (LiveInstr instr _)
885 = (liveregs, LiveInstr instr Nothing)
887 liveness1 liveregs blockmap (LiveInstr instr _)
890 = (liveregs1, LiveInstr instr
892 { liveBorn = emptyUniqSet
893 , liveDieRead = mkUniqSet r_dying
894 , liveDieWrite = mkUniqSet w_dying }))
897 = (liveregs_br, LiveInstr instr
899 { liveBorn = emptyUniqSet
900 , liveDieRead = mkUniqSet r_dying_br
901 , liveDieWrite = mkUniqSet w_dying }))
904 RU read written = regUsageOfInstr instr
906 -- registers that were written here are dead going backwards.
907 -- registers that were read here are live going backwards.
908 liveregs1 = (liveregs `delListFromUniqSet` written)
909 `addListToUniqSet` read
911 -- registers that are not live beyond this point, are recorded
913 r_dying = [ reg | reg <- read, reg `notElem` written,
914 not (elementOfUniqSet reg liveregs) ]
916 w_dying = [ reg | reg <- written,
917 not (elementOfUniqSet reg liveregs) ]
919 -- union in the live regs from all the jump destinations of this
921 targets = jumpDestsOfInstr instr -- where we go from here
922 not_a_branch = null targets
924 targetLiveRegs target
925 = case mapLookup target blockmap of
927 Nothing -> emptyRegMap
929 live_from_branch = unionManyUniqSets (map targetLiveRegs targets)
931 liveregs_br = liveregs1 `unionUniqSets` live_from_branch
933 -- registers that are live only in the branch targets should
934 -- be listed as dying here.
935 live_branch_only = live_from_branch `minusUniqSet` liveregs
936 r_dying_br = uniqSetToList (mkUniqSet r_dying `unionUniqSets`