From a12bf21a5e9c2b7888cd0ed0c60b9ec1e7295df1 Mon Sep 17 00:00:00 2001 From: "Ben.Lippmeier@anu.edu.au" Date: Tue, 11 Sep 2007 13:02:47 +0000 Subject: [PATCH] Better handling of live range joins via spill slots in spill cleaner --- compiler/nativeGen/RegAllocColor.hs | 2 +- compiler/nativeGen/RegSpillClean.hs | 204 +++++++++++++++++++++++++---------- 2 files changed, 146 insertions(+), 60 deletions(-) diff --git a/compiler/nativeGen/RegAllocColor.hs b/compiler/nativeGen/RegAllocColor.hs index c2cefc3..271c1a5 100644 --- a/compiler/nativeGen/RegAllocColor.hs +++ b/compiler/nativeGen/RegAllocColor.hs @@ -135,7 +135,7 @@ regAlloc_spin dflags (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs let code_spillclean = map cleanSpills code_patched -- strip off liveness information - let code_nat = map stripLive code_patched + let code_nat = map stripLive code_spillclean -- rewrite SPILL/RELOAD pseudos into real instructions let spillNatTop = mapGenBlockTop spillNatBlock diff --git a/compiler/nativeGen/RegSpillClean.hs b/compiler/nativeGen/RegSpillClean.hs index a4be8ed..2db4d74 100644 --- a/compiler/nativeGen/RegSpillClean.hs +++ b/compiler/nativeGen/RegSpillClean.hs @@ -36,13 +36,13 @@ import Cmm import UniqSet import UniqFM +import Unique import State +import Outputable import Data.Maybe import Data.List -type Slot = Int - -- | Clean out unneeded spill/reloads from this top level thing. cleanSpills :: LiveCmmTop -> LiveCmmTop cleanSpills cmm @@ -112,7 +112,7 @@ cleanBlock (BasicBlock id instrs) -- then we don't need to do the reload. -- cleanReload - :: Assoc Reg Slot -- ^ a reg and slot are associated when they have the same value. + :: Assoc Store -- ^ two store locations are associated if they have the same value -> [LiveInstr] -- ^ acc -> [LiveInstr] -- ^ instrs to clean (in backwards order) -> CleanM [LiveInstr] -- ^ cleaned instrs (in forward order) @@ -120,31 +120,62 @@ cleanReload cleanReload _ acc [] = return acc +-- write out live range joins via spill slots to just a spill and a reg-reg move +-- hopefully the spill will be also be cleaned in the next pass +-- +cleanReload assoc acc (Instr i1 live1 : Instr i2 _ : instrs) + + | SPILL reg1 slot1 <- i1 + , RELOAD slot2 reg2 <- i2 + , slot1 == slot2 + = do + modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 } + cleanReload assoc acc + (Instr i1 live1 : Instr (mkRegRegMoveInstr reg1 reg2) Nothing : instrs) + + +cleanReload assoc acc (li@(Instr i1 _) : instrs) + | Just (r1, r2) <- isRegRegMove i1 + = if r1 == r2 + -- erase any left over nop reg reg moves while we're here + -- this will also catch any nop moves that the "write out live range joins" case above + -- happens to add + then cleanReload assoc acc instrs + + -- if r1 has the same value as some slots and we copy r1 to r2, + -- then r2 is now associated with those slots instead + else do let assoc' = addAssoc (SReg r1) (SReg r2) + $ delAssoc (SReg r2) + $ assoc + + cleanReload assoc' (li : acc) instrs + + cleanReload assoc acc (li@(Instr instr _) : instrs) | SPILL reg slot <- instr - = let assoc' = addAssoc reg slot -- doing the spill makes reg and slot the same value - $ deleteBAssoc slot -- slot value changes on spill + = let assoc' = addAssoc (SReg reg) (SSlot slot) -- doing the spill makes reg and slot the same value + $ delAssoc (SSlot slot) -- slot value changes on spill $ assoc in cleanReload assoc' (li : acc) instrs | RELOAD slot reg <- instr - = if elemAssoc reg slot assoc + = if elemAssoc (SSlot slot) (SReg reg) assoc - -- reg and slot had the same value before reload - -- we don't need the reload. + -- if the reg and slot had the same value before reload + -- then we don't need the reload. then do modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 } cleanReload assoc acc instrs -- reg and slot had different values before reload else - let assoc' = addAssoc reg slot -- doing the reload makes reg and slot the same value - $ deleteAAssoc reg -- reg value changes on reload + let assoc' = addAssoc (SReg reg) (SSlot slot) -- doing the reload makes reg and slot the same value + $ delAssoc (SReg reg) -- reg value changes on reload $ assoc in cleanReload assoc' (li : acc) instrs - -- on a jump, remember the reg/slot association. + -- remember the association over a jump | targets <- jumpDests instr [] , not $ null targets = do mapM_ (accJumpValid assoc) targets @@ -152,7 +183,7 @@ cleanReload assoc acc (li@(Instr instr _) : instrs) -- writing to a reg changes its value. | RU _ written <- regUsage instr - = let assoc' = foldr deleteAAssoc assoc written + = let assoc' = foldr delAssoc assoc (map SReg $ nub written) in cleanReload assoc' (li : acc) instrs @@ -162,7 +193,7 @@ cleanReload assoc acc (li@(Instr instr _) : instrs) -- then the slot was never read and we don't need the spill. cleanSpill - :: UniqSet Int -- ^ slots that have been spilled, but not reload from + :: UniqSet Int -- ^ slots that have been spilled, but not reloaded from -> [LiveInstr] -- ^ acc -> [LiveInstr] -- ^ instrs to clean (in forwards order) -> CleanM [LiveInstr] -- ^ cleaned instrs (in backwards order) @@ -196,8 +227,7 @@ cleanSpill unused acc (li@(Instr instr _) : instrs) -- collateJoinPoints: -- --- | Look at information about what regs were valid across jumps and work out --- whether it's safe to avoid reloads after join points. +-- | combine the associations from all the inward control flow edges. -- collateJoinPoints :: CleanM () collateJoinPoints @@ -205,7 +235,7 @@ collateJoinPoints { sJumpValid = mapUFM intersects (sJumpValidAcc s) , sJumpValidAcc = emptyUFM } -intersects :: [Assoc Reg Slot] -> Assoc Reg Slot +intersects :: [Assoc Store] -> Assoc Store intersects [] = emptyAssoc intersects assocs = foldl1' intersectAssoc assocs @@ -216,12 +246,12 @@ type CleanM = State CleanS data CleanS = CleanS { -- regs which are valid at the start of each block. - sJumpValid :: UniqFM (Assoc Reg Slot) + sJumpValid :: UniqFM (Assoc Store) -- collecting up what regs were valid across each jump. -- in the next pass we can collate these and write the results -- to sJumpValid. - , sJumpValidAcc :: UniqFM [Assoc Reg Slot] + , sJumpValidAcc :: UniqFM [Assoc Store] -- spills/reloads cleaned each pass (latest at front) , sCleanedCount :: [(Int, Int)] @@ -242,71 +272,127 @@ initCleanS , sCleanedReloadsAcc = 0 } --- | Remember that these regs were valid before a jump to this block -accJumpValid :: Assoc Reg Slot -> BlockId -> CleanM () -accJumpValid regs target +-- | Remember the associations before a jump +accJumpValid :: Assoc Store -> BlockId -> CleanM () +accJumpValid assocs target = modify $ \s -> s { sJumpValidAcc = addToUFM_C (++) (sJumpValidAcc s) target - [regs] } + [assocs] } + +-------------- +-- A store location can be a stack slot or a register +-- +data Store + = SSlot Int + | SReg Reg + +-- spill cleaning is only done once all virtuals have been allocated to realRegs +-- +instance Uniquable Store where + getUnique (SReg r) + | RealReg i <- r + = mkUnique 'R' i + + | otherwise + = error "RegSpillClean.getUnique: found virtual reg during spill clean, only real regs expected." + + getUnique (SSlot i) = mkUnique 'S' i + +instance Outputable Store where + ppr (SSlot i) = text "slot" <> int i + ppr (SReg r) = ppr r -------------- --- An association table / many to many mapping. --- TODO: implement this better than a simple association list. --- two maps of sets, one for each direction would be better +-- Association graphs. +-- In the spill cleaner, two store locations are associated if they are known +-- to hold the same value. -- -data Assoc a b - = Assoc - { aList :: [(a, b)] } +type Assoc a = UniqFM (UniqSet a) -- | an empty association -emptyAssoc :: Assoc a b -emptyAssoc = Assoc { aList = [] } +emptyAssoc :: Assoc a +emptyAssoc = emptyUFM + + +-- | add an association between these two things +addAssoc :: Uniquable a + => a -> a -> Assoc a -> Assoc a +addAssoc a b m + = let m1 = addToUFM_C unionUniqSets m a (unitUniqSet b) + m2 = addToUFM_C unionUniqSets m1 b (unitUniqSet a) + in m2 --- | add an association to the table. -addAssoc - :: (Eq a, Eq b) - => a -> b -> Assoc a b -> Assoc a b -addAssoc a b m = m { aList = (a, b) : aList m } +-- | delete all associations to a node +delAssoc :: (Outputable a, Uniquable a) + => a -> Assoc a -> Assoc a + +delAssoc a m + | Just aSet <- lookupUFM m a + , m1 <- delFromUFM m a + = foldUniqSet (\x m -> delAssoc1 x a m) m1 aSet + + | otherwise = m + + +-- | delete a single association edge (a -> b) +delAssoc1 :: Uniquable a + => a -> a -> Assoc a -> Assoc a + +delAssoc1 a b m + | Just aSet <- lookupUFM m a + = addToUFM m a (delOneFromUniqSet aSet b) + + | otherwise = m -- | check if these two things are associated -elemAssoc - :: (Eq a, Eq b) - => a -> b -> Assoc a b -> Bool -elemAssoc a b m = elem (a, b) $ aList m +elemAssoc :: (Outputable a, Uniquable a) + => a -> a -> Assoc a -> Bool + +elemAssoc a b m + = elementOfUniqSet b (closeAssoc a m) +-- | find the refl. trans. closure of the association from this point +closeAssoc :: (Outputable a, Uniquable a) + => a -> Assoc a -> UniqSet a --- | delete all associations with this A element -deleteAAssoc - :: Eq a - => a -> Assoc a b -> Assoc a b +closeAssoc a assoc + = closeAssoc' assoc emptyUniqSet (unitUniqSet a) + where + closeAssoc' assoc visited toVisit + = case uniqSetToList toVisit of -deleteAAssoc x m - = m { aList = [ (a, b) | (a, b) <- aList m - , a /= x ] } + -- nothing else to visit, we're done + [] -> visited + (x:_) --- | delete all associations with this B element -deleteBAssoc - :: Eq b - => b -> Assoc a b -> Assoc a b + -- we've already seen this node + | elementOfUniqSet x visited + -> closeAssoc' assoc visited (delOneFromUniqSet toVisit x) -deleteBAssoc x m - = m { aList = [ (a, b) | (a, b) <- aList m - , b /= x ] } + -- haven't seen this node before, + -- remember to visit all its neighbors + | otherwise + -> let neighbors + = case lookupUFM assoc x of + Nothing -> emptyUniqSet + Just set -> set + in closeAssoc' assoc + (addOneToUniqSet visited x) + (unionUniqSets toVisit neighbors) --- | intersect two associations +-- | intersect intersectAssoc - :: (Eq a, Eq b) - => Assoc a b -> Assoc a b -> Assoc a b + :: Uniquable a + => Assoc a -> Assoc a -> Assoc a -intersectAssoc a1 a2 - = emptyAssoc - { aList = intersect (aList a1) (aList a2) } +intersectAssoc a b + = intersectUFM_C (intersectUniqSets) a b -- 1.7.10.4