--- /dev/null
+-----------------------------------------------------------------------------
+--
+-- The register liveness determinator
+--
+-- (c) The University of Glasgow 2004
+--
+-----------------------------------------------------------------------------
+{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
+
+module RegAlloc.Liveness (
+ RegSet,
+ RegMap, emptyRegMap,
+ BlockMap, emptyBlockMap,
+ LiveCmmTop,
+ LiveInstr (..),
+ Liveness (..),
+ LiveInfo (..),
+ LiveBasicBlock,
+
+ mapBlockTop, mapBlockTopM,
+ mapGenBlockTop, mapGenBlockTopM,
+ stripLive,
+ spillNatBlock,
+ slurpConflicts,
+ slurpReloadCoalesce,
+ eraseDeltasLive,
+ patchEraseLive,
+ patchRegsLiveInstr,
+ regLiveness
+
+ ) where
+
+import BlockId
+import Regs
+import Instrs
+import PprMach
+import RegAllocInfo
+import Cmm hiding (RegSet)
+
+import Digraph
+import Outputable
+import Unique
+import UniqSet
+import UniqFM
+import UniqSupply
+import Bag
+import State
+import FastString
+
+import Data.List
+import Data.Maybe
+
+-----------------------------------------------------------------------------
+type RegSet = UniqSet Reg
+
+type RegMap a = UniqFM a
+
+emptyRegMap :: UniqFM a
+emptyRegMap = emptyUFM
+
+type BlockMap a = BlockEnv a
+
+emptyBlockMap :: BlockEnv a
+emptyBlockMap = emptyBlockEnv
+
+
+-- | A top level thing which carries liveness information.
+type LiveCmmTop
+ = GenCmmTop
+ CmmStatic
+ LiveInfo
+ (ListGraph (GenBasicBlock LiveInstr))
+ -- the "instructions" here are actually more blocks,
+ -- single blocks are acyclic
+ -- multiple blocks are taken to be cyclic.
+
+-- | An instruction with liveness information.
+data LiveInstr
+ = Instr Instr (Maybe Liveness)
+
+-- | Liveness information.
+-- The regs which die are ones which are no longer live in the *next* instruction
+-- in this sequence.
+-- (NB. if the instruction is a jump, these registers might still be live
+-- at the jump target(s) - you have to check the liveness at the destination
+-- block to find out).
+
+data Liveness
+ = Liveness
+ { liveBorn :: RegSet -- ^ registers born in this instruction (written to for first time).
+ , liveDieRead :: RegSet -- ^ registers that died because they were read for the last time.
+ , liveDieWrite :: RegSet } -- ^ registers that died because they were clobbered by something.
+
+
+-- | Stash regs live on entry to each basic block in the info part of the cmm code.
+data LiveInfo
+ = LiveInfo
+ [CmmStatic] -- cmm static stuff
+ (Maybe BlockId) -- id of the first block
+ (BlockMap RegSet) -- argument locals live on entry to this block
+
+-- | A basic block with liveness information.
+type LiveBasicBlock
+ = GenBasicBlock LiveInstr
+
+
+instance Outputable LiveInstr where
+ ppr (Instr instr Nothing)
+ = ppr instr
+
+ ppr (Instr instr (Just live))
+ = ppr instr
+ $$ (nest 8
+ $ vcat
+ [ pprRegs (ptext (sLit "# born: ")) (liveBorn live)
+ , pprRegs (ptext (sLit "# r_dying: ")) (liveDieRead live)
+ , pprRegs (ptext (sLit "# w_dying: ")) (liveDieWrite live) ]
+ $+$ space)
+
+ where pprRegs :: SDoc -> RegSet -> SDoc
+ pprRegs name regs
+ | isEmptyUniqSet regs = empty
+ | otherwise = name <> (hcat $ punctuate space $ map (docToSDoc . pprUserReg) $ uniqSetToList regs)
+
+
+instance Outputable LiveInfo where
+ ppr (LiveInfo static firstId liveOnEntry)
+ = (vcat $ map ppr static)
+ $$ text "# firstId = " <> ppr firstId
+ $$ text "# liveOnEntry = " <> ppr liveOnEntry
+
+
+-- | map a function across all the basic blocks in this code
+--
+mapBlockTop
+ :: (LiveBasicBlock -> LiveBasicBlock)
+ -> LiveCmmTop -> LiveCmmTop
+
+mapBlockTop f cmm
+ = evalState (mapBlockTopM (\x -> return $ f x) cmm) ()
+
+
+-- | map a function across all the basic blocks in this code (monadic version)
+--
+mapBlockTopM
+ :: Monad m
+ => (LiveBasicBlock -> m LiveBasicBlock)
+ -> LiveCmmTop -> m LiveCmmTop
+
+mapBlockTopM _ cmm@(CmmData{})
+ = return cmm
+
+mapBlockTopM f (CmmProc header label params (ListGraph comps))
+ = do comps' <- mapM (mapBlockCompM f) comps
+ return $ CmmProc header label params (ListGraph comps')
+
+mapBlockCompM :: Monad m => (a -> m a') -> (GenBasicBlock a) -> m (GenBasicBlock a')
+mapBlockCompM f (BasicBlock i blocks)
+ = do blocks' <- mapM f blocks
+ return $ BasicBlock i blocks'
+
+
+-- map a function across all the basic blocks in this code
+mapGenBlockTop
+ :: (GenBasicBlock i -> GenBasicBlock i)
+ -> (GenCmmTop d h (ListGraph i) -> GenCmmTop d h (ListGraph i))
+
+mapGenBlockTop f cmm
+ = evalState (mapGenBlockTopM (\x -> return $ f x) cmm) ()
+
+
+-- | map a function across all the basic blocks in this code (monadic version)
+mapGenBlockTopM
+ :: Monad m
+ => (GenBasicBlock i -> m (GenBasicBlock i))
+ -> (GenCmmTop d h (ListGraph i) -> m (GenCmmTop d h (ListGraph i)))
+
+mapGenBlockTopM _ cmm@(CmmData{})
+ = return cmm
+
+mapGenBlockTopM f (CmmProc header label params (ListGraph blocks))
+ = do blocks' <- mapM f blocks
+ return $ CmmProc header label params (ListGraph blocks')
+
+
+-- | Slurp out the list of register conflicts and reg-reg moves from this top level thing.
+-- Slurping of conflicts and moves is wrapped up together so we don't have
+-- to make two passes over the same code when we want to build the graph.
+--
+slurpConflicts :: LiveCmmTop -> (Bag (UniqSet Reg), Bag (Reg, Reg))
+slurpConflicts live
+ = slurpCmm (emptyBag, emptyBag) live
+
+ where slurpCmm rs CmmData{} = rs
+ slurpCmm rs (CmmProc info _ _ (ListGraph blocks))
+ = foldl' (slurpComp info) rs blocks
+
+ slurpComp info rs (BasicBlock _ blocks)
+ = foldl' (slurpBlock info) rs blocks
+
+ slurpBlock info rs (BasicBlock blockId instrs)
+ | LiveInfo _ _ blockLive <- info
+ , Just rsLiveEntry <- lookupBlockEnv blockLive blockId
+ , (conflicts, moves) <- slurpLIs rsLiveEntry rs instrs
+ = (consBag rsLiveEntry conflicts, moves)
+
+ | otherwise
+ = panic "RegLiveness.slurpBlock: bad block"
+
+ slurpLIs rsLive (conflicts, moves) []
+ = (consBag rsLive conflicts, moves)
+
+ slurpLIs rsLive rs (Instr _ Nothing : lis) = slurpLIs rsLive rs lis
+
+ slurpLIs rsLiveEntry (conflicts, moves) (Instr instr (Just live) : lis)
+ = let
+ -- regs that die because they are read for the last time at the start of an instruction
+ -- are not live across it.
+ rsLiveAcross = rsLiveEntry `minusUniqSet` (liveDieRead live)
+
+ -- regs live on entry to the next instruction.
+ -- be careful of orphans, make sure to delete dying regs _after_ unioning
+ -- in the ones that are born here.
+ rsLiveNext = (rsLiveAcross `unionUniqSets` (liveBorn live))
+ `minusUniqSet` (liveDieWrite live)
+
+ -- orphan vregs are the ones that die in the same instruction they are born in.
+ -- these are likely to be results that are never used, but we still
+ -- need to assign a hreg to them..
+ rsOrphans = intersectUniqSets
+ (liveBorn live)
+ (unionUniqSets (liveDieWrite live) (liveDieRead live))
+
+ --
+ rsConflicts = unionUniqSets rsLiveNext rsOrphans
+
+ in case isRegRegMove instr of
+ Just rr -> slurpLIs rsLiveNext
+ ( consBag rsConflicts conflicts
+ , consBag rr moves) lis
+
+ Nothing -> slurpLIs rsLiveNext
+ ( consBag rsConflicts conflicts
+ , moves) lis
+
+
+-- | For spill\/reloads
+--
+-- SPILL v1, slot1
+-- ...
+-- RELOAD slot1, v2
+--
+-- If we can arrange that v1 and v2 are allocated to the same hreg it's more likely
+-- the spill\/reload instrs can be cleaned and replaced by a nop reg-reg move.
+--
+--
+slurpReloadCoalesce :: LiveCmmTop -> Bag (Reg, Reg)
+slurpReloadCoalesce live
+ = slurpCmm emptyBag live
+
+ where slurpCmm cs CmmData{} = cs
+ slurpCmm cs (CmmProc _ _ _ (ListGraph blocks))
+ = foldl' slurpComp cs blocks
+
+ slurpComp cs comp
+ = let (moveBags, _) = runState (slurpCompM comp) emptyUFM
+ in unionManyBags (cs : moveBags)
+
+ slurpCompM (BasicBlock _ blocks)
+ = do -- run the analysis once to record the mapping across jumps.
+ mapM_ (slurpBlock False) blocks
+
+ -- run it a second time while using the information from the last pass.
+ -- We /could/ run this many more times to deal with graphical control
+ -- flow and propagating info across multiple jumps, but it's probably
+ -- not worth the trouble.
+ mapM (slurpBlock True) blocks
+
+ slurpBlock propagate (BasicBlock blockId instrs)
+ = do -- grab the slot map for entry to this block
+ slotMap <- if propagate
+ then getSlotMap blockId
+ else return emptyUFM
+
+ (_, mMoves) <- mapAccumLM slurpLI slotMap instrs
+ return $ listToBag $ catMaybes mMoves
+
+ slurpLI :: UniqFM Reg -- current slotMap
+ -> LiveInstr
+ -> State (UniqFM [UniqFM Reg]) -- blockId -> [slot -> reg]
+ -- for tracking slotMaps across jumps
+
+ ( UniqFM Reg -- new slotMap
+ , Maybe (Reg, Reg)) -- maybe a new coalesce edge
+
+ slurpLI slotMap (Instr instr _)
+
+ -- remember what reg was stored into the slot
+ | SPILL reg slot <- instr
+ , slotMap' <- addToUFM slotMap slot reg
+ = return (slotMap', Nothing)
+
+ -- add an edge betwen the this reg and the last one stored into the slot
+ | RELOAD slot reg <- instr
+ = case lookupUFM slotMap slot of
+ Just reg2
+ | reg /= reg2 -> return (slotMap, Just (reg, reg2))
+ | otherwise -> return (slotMap, Nothing)
+
+ Nothing -> return (slotMap, Nothing)
+
+ -- if we hit a jump, remember the current slotMap
+ | targets <- jumpDests instr []
+ , not $ null targets
+ = do mapM_ (accSlotMap slotMap) targets
+ return (slotMap, Nothing)
+
+ | otherwise
+ = return (slotMap, Nothing)
+
+ -- record a slotmap for an in edge to this block
+ accSlotMap slotMap blockId
+ = modify (\s -> addToUFM_C (++) s blockId [slotMap])
+
+ -- work out the slot map on entry to this block
+ -- if we have slot maps for multiple in-edges then we need to merge them.
+ getSlotMap blockId
+ = do map <- get
+ let slotMaps = fromMaybe [] (lookupUFM map blockId)
+ return $ foldr mergeSlotMaps emptyUFM slotMaps
+
+ mergeSlotMaps :: UniqFM Reg -> UniqFM Reg -> UniqFM Reg
+ mergeSlotMaps map1 map2
+ = listToUFM
+ $ [ (k, r1) | (k, r1) <- ufmToList map1
+ , case lookupUFM map2 k of
+ Nothing -> False
+ Just r2 -> r1 == r2 ]
+
+
+-- | Strip away liveness information, yielding NatCmmTop
+
+stripLive :: LiveCmmTop -> NatCmmTop
+stripLive live
+ = stripCmm live
+
+ where stripCmm (CmmData sec ds) = CmmData sec ds
+ stripCmm (CmmProc (LiveInfo info _ _) label params (ListGraph comps))
+ = CmmProc info label params
+ (ListGraph $ concatMap stripComp comps)
+
+ stripComp (BasicBlock _ blocks) = map stripBlock blocks
+ stripBlock (BasicBlock i instrs) = BasicBlock i (map stripLI instrs)
+ stripLI (Instr instr _) = instr
+
+
+-- | Make real spill instructions out of SPILL, RELOAD pseudos
+
+spillNatBlock :: NatBasicBlock -> NatBasicBlock
+spillNatBlock (BasicBlock i is)
+ = BasicBlock i instrs'
+ where (instrs', _)
+ = runState (spillNat [] is) 0
+
+ spillNat acc []
+ = return (reverse acc)
+
+ spillNat acc (DELTA i : instrs)
+ = do put i
+ spillNat acc instrs
+
+ spillNat acc (SPILL reg slot : instrs)
+ = do delta <- get
+ spillNat (mkSpillInstr reg delta slot : acc) instrs
+
+ spillNat acc (RELOAD slot reg : instrs)
+ = do delta <- get
+ spillNat (mkLoadInstr reg delta slot : acc) instrs
+
+ spillNat acc (instr : instrs)
+ = spillNat (instr : acc) instrs
+
+
+-- | Erase Delta instructions.
+
+eraseDeltasLive :: LiveCmmTop -> LiveCmmTop
+eraseDeltasLive cmm
+ = mapBlockTop eraseBlock cmm
+ where
+ isDelta (DELTA _) = True
+ isDelta _ = False
+
+ eraseBlock (BasicBlock id lis)
+ = BasicBlock id
+ $ filter (\(Instr i _) -> not $ isDelta i)
+ $ lis
+
+
+-- | Patch the registers in this code according to this register mapping.
+-- also erase reg -> reg moves when the reg is the same.
+-- also erase reg -> reg moves when the destination dies in this instr.
+
+patchEraseLive
+ :: (Reg -> Reg)
+ -> LiveCmmTop -> LiveCmmTop
+
+patchEraseLive patchF cmm
+ = patchCmm cmm
+ where
+ patchCmm cmm@CmmData{} = cmm
+
+ patchCmm (CmmProc info label params (ListGraph comps))
+ | LiveInfo static id blockMap <- info
+ = let patchRegSet set = mkUniqSet $ map patchF $ uniqSetToList set
+ blockMap' = mapBlockEnv patchRegSet blockMap
+
+ info' = LiveInfo static id blockMap'
+ in CmmProc info' label params $ ListGraph $ map patchComp comps
+
+ patchComp (BasicBlock id blocks)
+ = BasicBlock id $ map patchBlock blocks
+
+ patchBlock (BasicBlock id lis)
+ = BasicBlock id $ patchInstrs lis
+
+ patchInstrs [] = []
+ patchInstrs (li : lis)
+
+ | Instr i (Just live) <- li'
+ , Just (r1, r2) <- isRegRegMove i
+ , eatMe r1 r2 live
+ = patchInstrs lis
+
+ | otherwise
+ = li' : patchInstrs lis
+
+ where li' = patchRegsLiveInstr patchF li
+
+ eatMe r1 r2 live
+ -- source and destination regs are the same
+ | r1 == r2 = True
+
+ -- desination reg is never used
+ | elementOfUniqSet r2 (liveBorn live)
+ , elementOfUniqSet r2 (liveDieRead live) || elementOfUniqSet r2 (liveDieWrite live)
+ = True
+
+ | otherwise = False
+
+
+-- | Patch registers in this LiveInstr, including the liveness information.
+--
+patchRegsLiveInstr
+ :: (Reg -> Reg)
+ -> LiveInstr -> LiveInstr
+
+patchRegsLiveInstr patchF li
+ = case li of
+ Instr instr Nothing
+ -> Instr (patchRegs instr patchF) Nothing
+
+ Instr instr (Just live)
+ -> Instr
+ (patchRegs instr patchF)
+ (Just live
+ { -- WARNING: have to go via lists here because patchF changes the uniq in the Reg
+ liveBorn = mkUniqSet $ map patchF $ uniqSetToList $ liveBorn live
+ , liveDieRead = mkUniqSet $ map patchF $ uniqSetToList $ liveDieRead live
+ , liveDieWrite = mkUniqSet $ map patchF $ uniqSetToList $ liveDieWrite live })
+
+
+---------------------------------------------------------------------------------
+-- Annotate code with register liveness information
+--
+regLiveness
+ :: NatCmmTop
+ -> UniqSM LiveCmmTop
+
+regLiveness (CmmData i d)
+ = returnUs $ CmmData i d
+
+regLiveness (CmmProc info lbl params (ListGraph []))
+ = returnUs $ CmmProc
+ (LiveInfo info Nothing emptyBlockEnv)
+ lbl params (ListGraph [])
+
+regLiveness (CmmProc info lbl params (ListGraph blocks@(first : _)))
+ = let first_id = blockId first
+ sccs = sccBlocks blocks
+ (ann_sccs, block_live) = computeLiveness sccs
+
+ liveBlocks
+ = map (\scc -> case scc of
+ AcyclicSCC b@(BasicBlock l _) -> BasicBlock l [b]
+ CyclicSCC bs@(BasicBlock l _ : _) -> BasicBlock l bs
+ CyclicSCC []
+ -> panic "RegLiveness.regLiveness: no blocks in scc list")
+ $ ann_sccs
+
+ in returnUs $ CmmProc (LiveInfo info (Just first_id) block_live)
+ lbl params (ListGraph liveBlocks)
+
+
+sccBlocks :: [NatBasicBlock] -> [SCC NatBasicBlock]
+sccBlocks blocks = stronglyConnCompFromEdgedVertices graph
+ where
+ getOutEdges :: [Instr] -> [BlockId]
+ getOutEdges instrs = foldl' (\a x -> jumpDests x a) [] instrs
+
+ graph = [ (block, getUnique id, map getUnique (getOutEdges instrs))
+ | block@(BasicBlock id instrs) <- blocks ]
+
+
+-- -----------------------------------------------------------------------------
+-- Computing liveness
+
+computeLiveness
+ :: [SCC NatBasicBlock]
+ -> ([SCC LiveBasicBlock], -- instructions annotated with list of registers
+ -- which are "dead after this instruction".
+ BlockMap RegSet) -- blocks annontated with set of live registers
+ -- on entry to the block.
+
+ -- NOTE: on entry, the SCCs are in "reverse" order: later blocks may transfer
+ -- control to earlier ones only. The SCCs returned are in the *opposite*
+ -- order, which is exactly what we want for the next pass.
+
+computeLiveness sccs
+ = livenessSCCs emptyBlockMap [] sccs
+
+
+livenessSCCs
+ :: BlockMap RegSet
+ -> [SCC LiveBasicBlock] -- accum
+ -> [SCC NatBasicBlock]
+ -> ([SCC LiveBasicBlock], BlockMap RegSet)
+
+livenessSCCs blockmap done [] = (done, blockmap)
+
+livenessSCCs blockmap done (AcyclicSCC block : sccs)
+ = let (blockmap', block') = livenessBlock blockmap block
+ in livenessSCCs blockmap' (AcyclicSCC block' : done) sccs
+
+livenessSCCs blockmap done
+ (CyclicSCC blocks : sccs) =
+ livenessSCCs blockmap' (CyclicSCC blocks':done) sccs
+ where (blockmap', blocks')
+ = iterateUntilUnchanged linearLiveness equalBlockMaps
+ blockmap blocks
+
+ iterateUntilUnchanged
+ :: (a -> b -> (a,c)) -> (a -> a -> Bool)
+ -> a -> b
+ -> (a,c)
+
+ iterateUntilUnchanged f eq a b
+ = head $
+ concatMap tail $
+ groupBy (\(a1, _) (a2, _) -> eq a1 a2) $
+ iterate (\(a, _) -> f a b) $
+ (a, panic "RegLiveness.livenessSCCs")
+
+
+ linearLiveness :: BlockMap RegSet -> [NatBasicBlock]
+ -> (BlockMap RegSet, [LiveBasicBlock])
+ linearLiveness = mapAccumL livenessBlock
+
+ -- probably the least efficient way to compare two
+ -- BlockMaps for equality.
+ equalBlockMaps a b
+ = a' == b'
+ where a' = map f $ blockEnvToList a
+ b' = map f $ blockEnvToList b
+ f (key,elt) = (key, uniqSetToList elt)
+
+
+
+-- | Annotate a basic block with register liveness information.
+--
+livenessBlock
+ :: BlockMap RegSet
+ -> NatBasicBlock
+ -> (BlockMap RegSet, LiveBasicBlock)
+
+livenessBlock blockmap (BasicBlock block_id instrs)
+ = let
+ (regsLiveOnEntry, instrs1)
+ = livenessBack emptyUniqSet blockmap [] (reverse instrs)
+ blockmap' = extendBlockEnv blockmap block_id regsLiveOnEntry
+
+ instrs2 = livenessForward regsLiveOnEntry instrs1
+
+ output = BasicBlock block_id instrs2
+
+ in ( blockmap', output)
+
+-- | Calculate liveness going forwards,
+-- filling in when regs are born
+
+livenessForward
+ :: RegSet -- regs live on this instr
+ -> [LiveInstr] -> [LiveInstr]
+
+livenessForward _ [] = []
+livenessForward rsLiveEntry (li@(Instr instr mLive) : lis)
+ | Nothing <- mLive
+ = li : livenessForward rsLiveEntry lis
+
+ | Just live <- mLive
+ , RU _ written <- regUsage instr
+ = let
+ -- Regs that are written to but weren't live on entry to this instruction
+ -- are recorded as being born here.
+ rsBorn = mkUniqSet
+ $ filter (\r -> not $ elementOfUniqSet r rsLiveEntry) written
+
+ rsLiveNext = (rsLiveEntry `unionUniqSets` rsBorn)
+ `minusUniqSet` (liveDieRead live)
+ `minusUniqSet` (liveDieWrite live)
+
+ in Instr instr (Just live { liveBorn = rsBorn })
+ : livenessForward rsLiveNext lis
+
+livenessForward _ _ = panic "RegLiveness.livenessForward: no match"
+
+
+-- | Calculate liveness going backwards,
+-- filling in when regs die, and what regs are live across each instruction
+
+livenessBack
+ :: RegSet -- regs live on this instr
+ -> BlockMap RegSet -- regs live on entry to other BBs
+ -> [LiveInstr] -- instructions (accum)
+ -> [Instr] -- instructions
+ -> (RegSet, [LiveInstr])
+
+livenessBack liveregs _ done [] = (liveregs, done)
+
+livenessBack liveregs blockmap acc (instr : instrs)
+ = let (liveregs', instr') = liveness1 liveregs blockmap instr
+ in livenessBack liveregs' blockmap (instr' : acc) instrs
+
+-- don't bother tagging comments or deltas with liveness
+liveness1 :: RegSet -> BlockMap RegSet -> Instr -> (RegSet, LiveInstr)
+liveness1 liveregs _ (instr@COMMENT{})
+ = (liveregs, Instr instr Nothing)
+
+liveness1 liveregs _ (instr@DELTA{})
+ = (liveregs, Instr instr Nothing)
+
+liveness1 liveregs blockmap instr
+
+ | not_a_branch
+ = (liveregs1, Instr instr
+ (Just $ Liveness
+ { liveBorn = emptyUniqSet
+ , liveDieRead = mkUniqSet r_dying
+ , liveDieWrite = mkUniqSet w_dying }))
+
+ | otherwise
+ = (liveregs_br, Instr instr
+ (Just $ Liveness
+ { liveBorn = emptyUniqSet
+ , liveDieRead = mkUniqSet r_dying_br
+ , liveDieWrite = mkUniqSet w_dying }))
+
+ where
+ RU read written = regUsage instr
+
+ -- registers that were written here are dead going backwards.
+ -- registers that were read here are live going backwards.
+ liveregs1 = (liveregs `delListFromUniqSet` written)
+ `addListToUniqSet` read
+
+ -- registers that are not live beyond this point, are recorded
+ -- as dying here.
+ r_dying = [ reg | reg <- read, reg `notElem` written,
+ not (elementOfUniqSet reg liveregs) ]
+
+ w_dying = [ reg | reg <- written,
+ not (elementOfUniqSet reg liveregs) ]
+
+ -- union in the live regs from all the jump destinations of this
+ -- instruction.
+ targets = jumpDests instr [] -- where we go from here
+ not_a_branch = null targets
+
+ targetLiveRegs target
+ = case lookupBlockEnv blockmap target of
+ Just ra -> ra
+ Nothing -> emptyRegMap
+
+ live_from_branch = unionManyUniqSets (map targetLiveRegs targets)
+
+ liveregs_br = liveregs1 `unionUniqSets` live_from_branch
+
+ -- registers that are live only in the branch targets should
+ -- be listed as dying here.
+ live_branch_only = live_from_branch `minusUniqSet` liveregs
+ r_dying_br = uniqSetToList (mkUniqSet r_dying `unionUniqSets`
+ live_branch_only)
+
+
+
+
projects / ghc-hetmet.git / blobdiff