Try and rewrite reloads to reg-reg moves in the spill cleaner

parent 9173913b
......@@ -254,8 +254,6 @@ slurpConflicts live
-- 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.
--
-- TODO: This only works intra-block at the momement. It's be nice to join up the mappings
-- across blocks also.
--
slurpReloadCoalesce :: LiveCmmTop -> Bag (Reg, Reg)
slurpReloadCoalesce live
......@@ -265,32 +263,80 @@ slurpReloadCoalesce live
slurpCmm cs (CmmProc _ _ _ (ListGraph blocks))
= foldl' slurpComp cs blocks
slurpComp cs (BasicBlock _ blocks)
= foldl' slurpBlock cs blocks
slurpComp cs comp
= let (moveBags, _) = runState (slurpCompM comp) emptyUFM
in unionManyBags (cs : moveBags)
slurpBlock cs (BasicBlock _ instrs)
= let (_, mMoves) = mapAccumL slurpLI emptyUFM instrs
in unionBags cs (listToBag $ catMaybes mMoves)
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 :: UniqFM Reg -> LiveInstr -> (UniqFM Reg, Maybe (Reg, Reg))
slurpLI slotMap (Instr instr _)
-- remember what reg was stored into the slot
| SPILL reg slot <- instr
, slotMap' <- addToUFM slotMap slot reg
= (slotMap', Nothing)
= 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 -> (slotMap, Just (reg, reg2))
| otherwise -> (slotMap, Nothing)
| reg /= reg2 -> return (slotMap, Just (reg, reg2))
| otherwise -> return (slotMap, Nothing)
Nothing -> return (slotMap, Nothing)
Nothing -> (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
= (slotMap, Nothing)
= 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
......
......@@ -101,7 +101,7 @@ cleanBlock (BasicBlock id instrs)
Just assoc -> assoc
Nothing -> emptyAssoc
instrs_reload <- cleanReload assoc [] instrs
instrs_reload <- cleanFwd assoc [] instrs
instrs_spill <- cleanSpill emptyUniqSet [] instrs_reload
return $ BasicBlock id instrs_spill
......@@ -111,36 +111,36 @@ cleanBlock (BasicBlock id instrs)
-- On a reload, if we know a reg already has the same value as a slot
-- then we don't need to do the reload.
--
cleanReload
cleanFwd
:: 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)
cleanReload _ acc []
cleanFwd _ 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)
cleanFwd 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
cleanFwd assoc acc
(Instr i1 live1 : Instr (mkRegRegMoveInstr reg1 reg2) Nothing : instrs)
cleanReload assoc acc (li@(Instr i1 _) : instrs)
cleanFwd 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
then cleanFwd 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
......@@ -148,43 +148,69 @@ cleanReload assoc acc (li@(Instr i1 _) : instrs)
$ delAssoc (SReg r2)
$ assoc
cleanReload assoc' (li : acc) instrs
cleanFwd assoc' (li : acc) instrs
cleanReload assoc acc (li@(Instr instr _) : instrs)
cleanFwd assoc acc (li@(Instr instr _) : instrs)
| SPILL reg slot <- instr
= 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
in cleanFwd assoc' (li : acc) instrs
| RELOAD slot reg <- instr
= if elemAssoc (SSlot slot) (SReg reg) assoc
-- 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 (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
-- clean a reload instr
| RELOAD{} <- instr
= do (assoc', mli) <- cleanReload assoc li
case mli of
Nothing -> cleanFwd assoc' acc instrs
Just li' -> cleanFwd assoc' (li' : acc) instrs
-- remember the association over a jump
| targets <- jumpDests instr []
, not $ null targets
= do mapM_ (accJumpValid assoc) targets
cleanReload assoc (li : acc) instrs
cleanFwd assoc (li : acc) instrs
-- writing to a reg changes its value.
| RU _ written <- regUsage instr
= let assoc' = foldr delAssoc assoc (map SReg $ nub written)
in cleanReload assoc' (li : acc) instrs
in cleanFwd assoc' (li : acc) instrs
-- | Try and rewrite a reload instruction to something more pleasing
--
cleanReload :: Assoc Store -> LiveInstr -> CleanM (Assoc Store, Maybe LiveInstr)
cleanReload assoc li@(Instr (RELOAD slot reg) _)
-- if the reg we're reloading already has the same value as the slot
-- then we can erase the instruction outright
| elemAssoc (SSlot slot) (SReg reg) assoc
= do modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
return (assoc, Nothing)
-- if we can find another reg with the same value as this slot then
-- do a move instead of a reload.
| Just reg2 <- findRegOfSlot assoc slot
= do modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
let assoc' = addAssoc (SReg reg) (SReg reg2)
$ delAssoc (SReg reg)
$ assoc
return (assoc', Just $ Instr (mkRegRegMoveInstr reg2 reg) Nothing)
-- gotta keep this instr
-- update the association
| otherwise
= do 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
return (assoc', Just li)
cleanReload _ _
= panic "RegSpillClean.cleanReload: unhandled instr"
-- | Clean out unneeded spill instructions.
......@@ -240,6 +266,16 @@ intersects [] = emptyAssoc
intersects assocs = foldl1' intersectAssoc assocs
-- | See if we have a reg with the same value as this slot in the association table.
findRegOfSlot :: Assoc Store -> Int -> Maybe Reg
findRegOfSlot assoc slot
| close <- closeAssoc (SSlot slot) assoc
, Just (SReg reg) <- find isStoreReg $ uniqSetToList close
= Just reg
| otherwise
= Nothing
---------------
type CleanM = State CleanS
......@@ -288,6 +324,13 @@ data Store
= SSlot Int
| SReg Reg
-- | Check if this is a reg store
isStoreReg :: Store -> Bool
isStoreReg ss
= case ss of
SSlot _ -> False
SReg _ -> True
-- spill cleaning is only done once all virtuals have been allocated to realRegs
--
instance Uniquable Store where
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment