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,
40 import Cmm hiding (RegSet)
56 -----------------------------------------------------------------------------
57 type RegSet = UniqSet Reg
59 type RegMap a = UniqFM a
61 emptyRegMap :: UniqFM a
62 emptyRegMap = emptyUFM
64 type BlockMap a = BlockEnv a
66 emptyBlockMap :: BlockEnv a
67 emptyBlockMap = emptyBlockEnv
70 -- | A top level thing which carries liveness information.
75 [SCC (LiveBasicBlock instr)]
78 -- | The register allocator also wants to use SPILL/RELOAD meta instructions,
79 -- so we'll keep those here.
81 -- | A real machine instruction
84 -- | spill this reg to a stack slot
87 -- | reload this reg from a stack slot
90 instance Instruction instr => Instruction (InstrSR instr) where
93 Instr instr -> regUsageOfInstr instr
94 SPILL reg _ -> RU [reg] []
95 RELOAD _ reg -> RU [] [reg]
99 Instr instr -> Instr (patchRegsOfInstr instr f)
100 SPILL reg slot -> SPILL (f reg) slot
101 RELOAD slot reg -> RELOAD slot (f reg)
105 Instr instr -> isJumpishInstr instr
110 Instr instr -> jumpDestsOfInstr instr
115 Instr instr -> Instr (patchJumpInstr instr f)
118 mkSpillInstr = error "mkSpillInstr[InstrSR]: Not making SPILL meta-instr"
119 mkLoadInstr = error "mkLoadInstr[InstrSR]: Not making LOAD meta-instr"
123 Instr instr -> takeDeltaInstr instr
128 Instr instr -> isMetaInstr instr
131 mkRegRegMoveInstr r1 r2 = Instr (mkRegRegMoveInstr r1 r2)
133 takeRegRegMoveInstr i
135 Instr instr -> takeRegRegMoveInstr instr
138 mkJumpInstr target = map Instr (mkJumpInstr target)
142 -- | An instruction with liveness information.
144 = LiveInstr (InstrSR instr) (Maybe Liveness)
146 -- | Liveness information.
147 -- The regs which die are ones which are no longer live in the *next* instruction
149 -- (NB. if the instruction is a jump, these registers might still be live
150 -- at the jump target(s) - you have to check the liveness at the destination
151 -- block to find out).
155 { liveBorn :: RegSet -- ^ registers born in this instruction (written to for first time).
156 , liveDieRead :: RegSet -- ^ registers that died because they were read for the last time.
157 , liveDieWrite :: RegSet } -- ^ registers that died because they were clobbered by something.
160 -- | Stash regs live on entry to each basic block in the info part of the cmm code.
163 [CmmStatic] -- cmm static stuff
164 (Maybe BlockId) -- id of the first block
165 (Maybe (BlockMap RegSet)) -- argument locals 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 liveOnEntry)
216 = (vcat $ map ppr static)
217 $$ text "# firstId = " <> ppr firstId
218 $$ text "# liveOnEntry = " <> ppr liveOnEntry
222 -- | map a function across all the basic blocks in this code
225 :: (LiveBasicBlock instr -> LiveBasicBlock instr)
226 -> LiveCmmTop instr -> LiveCmmTop instr
229 = evalState (mapBlockTopM (\x -> return $ f x) cmm) ()
232 -- | map a function across all the basic blocks in this code (monadic version)
236 => (LiveBasicBlock instr -> m (LiveBasicBlock instr))
237 -> LiveCmmTop instr -> m (LiveCmmTop instr)
239 mapBlockTopM _ cmm@(CmmData{})
242 mapBlockTopM f (CmmProc header label params sccs)
243 = do sccs' <- mapM (mapSCCM f) sccs
244 return $ CmmProc header label params sccs'
246 mapSCCM :: Monad m => (a -> m b) -> SCC a -> m (SCC b)
247 mapSCCM f (AcyclicSCC x)
249 return $ AcyclicSCC x'
251 mapSCCM f (CyclicSCC xs)
252 = do xs' <- mapM f xs
253 return $ CyclicSCC xs'
256 -- map a function across all the basic blocks in this code
258 :: (GenBasicBlock i -> GenBasicBlock i)
259 -> (GenCmmTop d h (ListGraph i) -> GenCmmTop d h (ListGraph i))
262 = evalState (mapGenBlockTopM (\x -> return $ f x) cmm) ()
265 -- | map a function across all the basic blocks in this code (monadic version)
268 => (GenBasicBlock i -> m (GenBasicBlock i))
269 -> (GenCmmTop d h (ListGraph i) -> m (GenCmmTop d h (ListGraph i)))
271 mapGenBlockTopM _ cmm@(CmmData{})
274 mapGenBlockTopM f (CmmProc header label params (ListGraph blocks))
275 = do blocks' <- mapM f blocks
276 return $ CmmProc header label params (ListGraph blocks')
279 -- | Slurp out the list of register conflicts and reg-reg moves from this top level thing.
280 -- Slurping of conflicts and moves is wrapped up together so we don't have
281 -- to make two passes over the same code when we want to build the graph.
286 -> (Bag (UniqSet Reg), Bag (Reg, Reg))
289 = slurpCmm (emptyBag, emptyBag) live
291 where slurpCmm rs CmmData{} = rs
292 slurpCmm rs (CmmProc info _ _ sccs)
293 = foldl' (slurpSCC info) rs sccs
295 slurpSCC info rs (AcyclicSCC b)
296 = slurpBlock info rs b
298 slurpSCC info rs (CyclicSCC bs)
299 = foldl' (slurpBlock info) rs bs
301 slurpBlock info rs (BasicBlock blockId instrs)
302 | LiveInfo _ _ (Just blockLive) <- info
303 , Just rsLiveEntry <- lookupBlockEnv blockLive blockId
304 , (conflicts, moves) <- slurpLIs rsLiveEntry rs instrs
305 = (consBag rsLiveEntry conflicts, moves)
308 = panic "Liveness.slurpConflicts: bad block"
310 slurpLIs rsLive (conflicts, moves) []
311 = (consBag rsLive conflicts, moves)
313 slurpLIs rsLive rs (LiveInstr _ Nothing : lis)
314 = slurpLIs rsLive rs lis
316 slurpLIs rsLiveEntry (conflicts, moves) (LiveInstr instr (Just live) : lis)
318 -- regs that die because they are read for the last time at the start of an instruction
319 -- are not live across it.
320 rsLiveAcross = rsLiveEntry `minusUniqSet` (liveDieRead live)
322 -- regs live on entry to the next instruction.
323 -- be careful of orphans, make sure to delete dying regs _after_ unioning
324 -- in the ones that are born here.
325 rsLiveNext = (rsLiveAcross `unionUniqSets` (liveBorn live))
326 `minusUniqSet` (liveDieWrite live)
328 -- orphan vregs are the ones that die in the same instruction they are born in.
329 -- these are likely to be results that are never used, but we still
330 -- need to assign a hreg to them..
331 rsOrphans = intersectUniqSets
333 (unionUniqSets (liveDieWrite live) (liveDieRead live))
336 rsConflicts = unionUniqSets rsLiveNext rsOrphans
338 in case takeRegRegMoveInstr instr of
339 Just rr -> slurpLIs rsLiveNext
340 ( consBag rsConflicts conflicts
341 , consBag rr moves) lis
343 Nothing -> slurpLIs rsLiveNext
344 ( consBag rsConflicts conflicts
348 -- | For spill\/reloads
354 -- If we can arrange that v1 and v2 are allocated to the same hreg it's more likely
355 -- the spill\/reload instrs can be cleaned and replaced by a nop reg-reg move.
359 :: forall instr. Instruction instr
363 slurpReloadCoalesce live
364 = slurpCmm emptyBag live
367 slurpCmm :: Bag (Reg, Reg)
368 -> GenCmmTop t t1 [SCC (LiveBasicBlock instr)]
370 slurpCmm cs CmmData{} = cs
371 slurpCmm cs (CmmProc _ _ _ sccs)
372 = slurpComp cs (flattenSCCs sccs)
374 slurpComp :: Bag (Reg, Reg)
375 -> [LiveBasicBlock instr]
378 = let (moveBags, _) = runState (slurpCompM blocks) emptyUFM
379 in unionManyBags (cs : moveBags)
381 slurpCompM :: [LiveBasicBlock instr]
382 -> State (UniqFM [UniqFM Reg]) [Bag (Reg, Reg)]
384 = do -- run the analysis once to record the mapping across jumps.
385 mapM_ (slurpBlock False) blocks
387 -- run it a second time while using the information from the last pass.
388 -- We /could/ run this many more times to deal with graphical control
389 -- flow and propagating info across multiple jumps, but it's probably
390 -- not worth the trouble.
391 mapM (slurpBlock True) blocks
393 slurpBlock :: Bool -> LiveBasicBlock instr
394 -> State (UniqFM [UniqFM Reg]) (Bag (Reg, Reg))
395 slurpBlock propagate (BasicBlock blockId instrs)
396 = do -- grab the slot map for entry to this block
397 slotMap <- if propagate
398 then getSlotMap blockId
401 (_, mMoves) <- mapAccumLM slurpLI slotMap instrs
402 return $ listToBag $ catMaybes mMoves
404 slurpLI :: UniqFM Reg -- current slotMap
406 -> State (UniqFM [UniqFM Reg]) -- blockId -> [slot -> reg]
407 -- for tracking slotMaps across jumps
409 ( UniqFM Reg -- new slotMap
410 , Maybe (Reg, Reg)) -- maybe a new coalesce edge
414 -- remember what reg was stored into the slot
415 | LiveInstr (SPILL reg slot) _ <- li
416 , slotMap' <- addToUFM slotMap slot reg
417 = return (slotMap', Nothing)
419 -- add an edge betwen the this reg and the last one stored into the slot
420 | LiveInstr (RELOAD slot reg) _ <- li
421 = case lookupUFM slotMap slot of
423 | reg /= reg2 -> return (slotMap, Just (reg, reg2))
424 | otherwise -> return (slotMap, Nothing)
426 Nothing -> return (slotMap, Nothing)
428 -- if we hit a jump, remember the current slotMap
429 | LiveInstr (Instr instr) _ <- li
430 , targets <- jumpDestsOfInstr instr
432 = do mapM_ (accSlotMap slotMap) targets
433 return (slotMap, Nothing)
436 = return (slotMap, Nothing)
438 -- record a slotmap for an in edge to this block
439 accSlotMap slotMap blockId
440 = modify (\s -> addToUFM_C (++) s blockId [slotMap])
442 -- work out the slot map on entry to this block
443 -- if we have slot maps for multiple in-edges then we need to merge them.
446 let slotMaps = fromMaybe [] (lookupUFM map blockId)
447 return $ foldr mergeSlotMaps emptyUFM slotMaps
449 mergeSlotMaps :: UniqFM Reg -> UniqFM Reg -> UniqFM Reg
450 mergeSlotMaps map1 map2
452 $ [ (k, r1) | (k, r1) <- ufmToList map1
453 , case lookupUFM map2 k of
455 Just r2 -> r1 == r2 ]
458 -- | Strip away liveness information, yielding NatCmmTop
460 :: (Outputable instr, Instruction instr)
467 where stripCmm (CmmData sec ds) = CmmData sec ds
469 stripCmm (CmmProc (LiveInfo info (Just first_id) _) label params 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 params
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 params [])
483 = CmmProc info label params (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.
547 -> LiveCmmTop instr -> LiveCmmTop instr
549 patchEraseLive patchF cmm
552 patchCmm cmm@CmmData{} = cmm
554 patchCmm (CmmProc info label params sccs)
555 | LiveInfo static id (Just blockMap) <- info
557 patchRegSet set = mkUniqSet $ map patchF $ uniqSetToList set
558 blockMap' = mapBlockEnv patchRegSet blockMap
560 info' = LiveInfo static id (Just blockMap')
561 in CmmProc info' label params $ map patchSCC sccs
564 = panic "RegAlloc.Liveness.patchEraseLive: no blockMap"
566 patchSCC (AcyclicSCC b) = AcyclicSCC (patchBlock b)
567 patchSCC (CyclicSCC bs) = CyclicSCC (map patchBlock bs)
569 patchBlock (BasicBlock id lis)
570 = BasicBlock id $ patchInstrs lis
573 patchInstrs (li : lis)
575 | LiveInstr i (Just live) <- li'
576 , Just (r1, r2) <- takeRegRegMoveInstr i
581 = li' : patchInstrs lis
583 where li' = patchRegsLiveInstr patchF li
586 -- source and destination regs are the same
589 -- desination reg is never used
590 | elementOfUniqSet r2 (liveBorn live)
591 , elementOfUniqSet r2 (liveDieRead live) || elementOfUniqSet r2 (liveDieWrite live)
597 -- | Patch registers in this LiveInstr, including the liveness information.
602 -> LiveInstr instr -> LiveInstr instr
604 patchRegsLiveInstr patchF li
606 LiveInstr instr Nothing
607 -> LiveInstr (patchRegsOfInstr instr patchF) Nothing
609 LiveInstr instr (Just live)
611 (patchRegsOfInstr instr patchF)
613 { -- WARNING: have to go via lists here because patchF changes the uniq in the Reg
614 liveBorn = mkUniqSet $ map patchF $ uniqSetToList $ liveBorn live
615 , liveDieRead = mkUniqSet $ map patchF $ uniqSetToList $ liveDieRead live
616 , liveDieWrite = mkUniqSet $ map patchF $ uniqSetToList $ liveDieWrite live })
619 --------------------------------------------------------------------------------
620 -- | Convert a NatCmmTop to a LiveCmmTop, with empty liveness information
627 natCmmTopToLive (CmmData i d)
630 natCmmTopToLive (CmmProc info lbl params (ListGraph []))
631 = CmmProc (LiveInfo info Nothing Nothing)
634 natCmmTopToLive (CmmProc info lbl params (ListGraph blocks@(first : _)))
635 = let first_id = blockId first
636 sccs = sccBlocks blocks
637 sccsLive = map (fmap (\(BasicBlock l instrs) ->
638 BasicBlock l (map (\i -> LiveInstr (Instr i) Nothing) instrs)))
641 in CmmProc (LiveInfo info (Just first_id) Nothing)
647 => [NatBasicBlock instr]
648 -> [SCC (NatBasicBlock instr)]
650 sccBlocks blocks = stronglyConnCompFromEdgedVertices graph
652 getOutEdges :: Instruction instr => [instr] -> [BlockId]
653 getOutEdges instrs = concat $ map jumpDestsOfInstr instrs
655 graph = [ (block, getUnique id, map getUnique (getOutEdges instrs))
656 | block@(BasicBlock id instrs) <- blocks ]
659 ---------------------------------------------------------------------------------
660 -- Annotate code with register liveness information
663 :: (Outputable instr, Instruction instr)
665 -> UniqSM (LiveCmmTop instr)
667 regLiveness (CmmData i d)
668 = returnUs $ CmmData i d
670 regLiveness (CmmProc info lbl params [])
671 | LiveInfo static mFirst _ <- info
673 (LiveInfo static mFirst (Just emptyBlockEnv))
676 regLiveness (CmmProc info lbl params sccs)
677 | LiveInfo static mFirst _ <- info
678 = let (ann_sccs, block_live) = computeLiveness sccs
680 in returnUs $ CmmProc (LiveInfo static mFirst (Just block_live))
684 -- -----------------------------------------------------------------------------
685 -- | Check ordering of Blocks
686 -- The computeLiveness function requires SCCs to be in reverse dependent order.
687 -- If they're not the liveness information will be wrong, and we'll get a bad allocation.
688 -- Better to check for this precondition explicitly or some other poor sucker will
689 -- waste a day staring at bad assembly code..
691 checkIsReverseDependent
693 => [SCC (LiveBasicBlock instr)] -- ^ SCCs of blocks that we're about to run the liveness determinator on.
694 -> Maybe BlockId -- ^ BlockIds that fail the test (if any)
696 checkIsReverseDependent sccs'
697 = go emptyUniqSet sccs'
702 go blocksSeen (AcyclicSCC block : sccs)
703 = let dests = slurpJumpDestsOfBlock block
704 blocksSeen' = unionUniqSets blocksSeen $ mkUniqSet [blockId block]
705 badDests = dests `minusUniqSet` blocksSeen'
706 in case uniqSetToList badDests of
707 [] -> go blocksSeen' sccs
710 go blocksSeen (CyclicSCC blocks : sccs)
711 = let dests = unionManyUniqSets $ map slurpJumpDestsOfBlock blocks
712 blocksSeen' = unionUniqSets blocksSeen $ mkUniqSet $ map blockId blocks
713 badDests = dests `minusUniqSet` blocksSeen'
714 in case uniqSetToList badDests of
715 [] -> go blocksSeen' sccs
718 slurpJumpDestsOfBlock (BasicBlock _ instrs)
720 $ map (mkUniqSet . jumpDestsOfInstr)
721 [ i | LiveInstr i _ <- instrs]
724 -- | If we've compute liveness info for this code already we have to reverse
725 -- the SCCs in each top to get them back to the right order so we can do it again.
726 reverseBlocksInTops :: LiveCmmTop instr -> LiveCmmTop instr
727 reverseBlocksInTops top
730 CmmProc info lbl params sccs -> CmmProc info lbl params (reverse sccs)
733 -- | Computing liveness
735 -- On entry, the SCCs must be in "reverse" order: later blocks may transfer
736 -- control to earlier ones only, else `panic`.
738 -- The SCCs returned are in the *opposite* order, which is exactly what we
739 -- want for the next pass.
742 :: (Outputable instr, Instruction instr)
743 => [SCC (LiveBasicBlock instr)]
744 -> ([SCC (LiveBasicBlock instr)], -- instructions annotated with list of registers
745 -- which are "dead after this instruction".
746 BlockMap RegSet) -- blocks annontated with set of live registers
747 -- on entry to the block.
750 = case checkIsReverseDependent sccs of
751 Nothing -> livenessSCCs emptyBlockMap [] sccs
752 Just bad -> pprPanic "RegAlloc.Liveness.computeLivenss"
753 (vcat [ text "SCCs aren't in reverse dependent order"
754 , text "bad blockId" <+> ppr bad
760 -> [SCC (LiveBasicBlock instr)] -- accum
761 -> [SCC (LiveBasicBlock instr)]
762 -> ( [SCC (LiveBasicBlock instr)]
765 livenessSCCs blockmap done []
768 livenessSCCs blockmap done (AcyclicSCC block : sccs)
769 = let (blockmap', block') = livenessBlock blockmap block
770 in livenessSCCs blockmap' (AcyclicSCC block' : done) sccs
772 livenessSCCs blockmap done
773 (CyclicSCC blocks : sccs) =
774 livenessSCCs blockmap' (CyclicSCC blocks':done) sccs
775 where (blockmap', blocks')
776 = iterateUntilUnchanged linearLiveness equalBlockMaps
779 iterateUntilUnchanged
780 :: (a -> b -> (a,c)) -> (a -> a -> Bool)
784 iterateUntilUnchanged f eq a b
787 groupBy (\(a1, _) (a2, _) -> eq a1 a2) $
788 iterate (\(a, _) -> f a b) $
789 (a, panic "RegLiveness.livenessSCCs")
794 => BlockMap RegSet -> [LiveBasicBlock instr]
795 -> (BlockMap RegSet, [LiveBasicBlock instr])
797 linearLiveness = mapAccumL livenessBlock
799 -- probably the least efficient way to compare two
800 -- BlockMaps for equality.
803 where a' = map f $ blockEnvToList a
804 b' = map f $ blockEnvToList b
805 f (key,elt) = (key, uniqSetToList elt)
809 -- | Annotate a basic block with register liveness information.
814 -> LiveBasicBlock instr
815 -> (BlockMap RegSet, LiveBasicBlock instr)
817 livenessBlock blockmap (BasicBlock block_id instrs)
819 (regsLiveOnEntry, instrs1)
820 = livenessBack emptyUniqSet blockmap [] (reverse instrs)
821 blockmap' = extendBlockEnv blockmap block_id regsLiveOnEntry
823 instrs2 = livenessForward regsLiveOnEntry instrs1
825 output = BasicBlock block_id instrs2
827 in ( blockmap', output)
829 -- | Calculate liveness going forwards,
830 -- filling in when regs are born
834 => RegSet -- regs live on this instr
835 -> [LiveInstr instr] -> [LiveInstr instr]
837 livenessForward _ [] = []
838 livenessForward rsLiveEntry (li@(LiveInstr instr mLive) : lis)
840 = li : livenessForward rsLiveEntry lis
843 , RU _ written <- regUsageOfInstr instr
845 -- Regs that are written to but weren't live on entry to this instruction
846 -- are recorded as being born here.
848 $ filter (\r -> not $ elementOfUniqSet r rsLiveEntry) written
850 rsLiveNext = (rsLiveEntry `unionUniqSets` rsBorn)
851 `minusUniqSet` (liveDieRead live)
852 `minusUniqSet` (liveDieWrite live)
854 in LiveInstr instr (Just live { liveBorn = rsBorn })
855 : livenessForward rsLiveNext lis
857 livenessForward _ _ = panic "RegLiveness.livenessForward: no match"
860 -- | Calculate liveness going backwards,
861 -- filling in when regs die, and what regs are live across each instruction
865 => RegSet -- regs live on this instr
866 -> BlockMap RegSet -- regs live on entry to other BBs
867 -> [LiveInstr instr] -- instructions (accum)
868 -> [LiveInstr instr] -- instructions
869 -> (RegSet, [LiveInstr instr])
871 livenessBack liveregs _ done [] = (liveregs, done)
873 livenessBack liveregs blockmap acc (instr : instrs)
874 = let (liveregs', instr') = liveness1 liveregs blockmap instr
875 in livenessBack liveregs' blockmap (instr' : acc) instrs
878 -- don't bother tagging comments or deltas with liveness
884 -> (RegSet, LiveInstr instr)
886 liveness1 liveregs _ (LiveInstr instr _)
888 = (liveregs, LiveInstr instr Nothing)
890 liveness1 liveregs blockmap (LiveInstr instr _)
893 = (liveregs1, LiveInstr instr
895 { liveBorn = emptyUniqSet
896 , liveDieRead = mkUniqSet r_dying
897 , liveDieWrite = mkUniqSet w_dying }))
900 = (liveregs_br, LiveInstr instr
902 { liveBorn = emptyUniqSet
903 , liveDieRead = mkUniqSet r_dying_br
904 , liveDieWrite = mkUniqSet w_dying }))
907 RU read written = regUsageOfInstr instr
909 -- registers that were written here are dead going backwards.
910 -- registers that were read here are live going backwards.
911 liveregs1 = (liveregs `delListFromUniqSet` written)
912 `addListToUniqSet` read
914 -- registers that are not live beyond this point, are recorded
916 r_dying = [ reg | reg <- read, reg `notElem` written,
917 not (elementOfUniqSet reg liveregs) ]
919 w_dying = [ reg | reg <- written,
920 not (elementOfUniqSet reg liveregs) ]
922 -- union in the live regs from all the jump destinations of this
924 targets = jumpDestsOfInstr instr -- where we go from here
925 not_a_branch = null targets
927 targetLiveRegs target
928 = case lookupBlockEnv blockmap target of
930 Nothing -> emptyRegMap
932 live_from_branch = unionManyUniqSets (map targetLiveRegs targets)
934 liveregs_br = liveregs1 `unionUniqSets` live_from_branch
936 -- registers that are live only in the branch targets should
937 -- be listed as dying here.
938 live_branch_only = live_from_branch `minusUniqSet` liveregs
939 r_dying_br = uniqSetToList (mkUniqSet r_dying `unionUniqSets`