X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FRegAlloc%2FGraph%2FSpill.hs;h=4eabb3b0b479e6a2bafe97d191855843626ca9a2;hb=f8f0e76ad302fda30196ebc9230e5fcbc97be537;hp=ce34b513a1283fb162d06705dab9d5102c004a1d;hpb=f9288086f935c97812b2d80defcff38baf7b6a6c;p=ghc-hetmet.git diff --git a/compiler/nativeGen/RegAlloc/Graph/Spill.hs b/compiler/nativeGen/RegAlloc/Graph/Spill.hs index ce34b51..4eabb3b 100644 --- a/compiler/nativeGen/RegAlloc/Graph/Spill.hs +++ b/compiler/nativeGen/RegAlloc/Graph/Spill.hs @@ -1,18 +1,19 @@ - {-# OPTIONS -fno-warn-missing-signatures #-} +-- | When there aren't enough registers to hold all the vregs we have to spill some of those +-- vregs to slots on the stack. This module is used modify the code to use those slots. +-- module RegAlloc.Graph.Spill ( regSpill, SpillStats(..), accSpillSL ) - where - import RegAlloc.Liveness import Instruction import Reg -import Cmm +import OldCmm hiding (RegSet) +import BlockId import State import Unique @@ -23,15 +24,20 @@ import Outputable import Data.List import Data.Maybe +import Data.Map (Map) +import Data.Set (Set) +import qualified Data.Map as Map +import qualified Data.Set as Set --- | Spill all these virtual regs to memory --- TODO: see if we can split some of the live ranges instead of just globally --- spilling the virtual reg. +-- | Spill all these virtual regs to stack slots. +-- +-- TODO: See if we can split some of the live ranges instead of just globally +-- spilling the virtual reg. This might make the spill cleaner's job easier. -- --- TODO: On ciscy x86 and x86_64 we don't nessesarally have to add a mov instruction --- when making spills. If an instr is using a spilled virtual we may be able to --- address the spill slot directly. +-- TODO: On CISCy x86 and x86_64 we don't nessesarally have to add a mov instruction +-- when making spills. If an instr is using a spilled virtual we may be able to +-- address the spill slot directly. -- regSpill :: Instruction instr @@ -39,7 +45,7 @@ regSpill -> UniqSet Int -- ^ available stack slots -> UniqSet VirtualReg -- ^ the regs to spill -> UniqSM - ([LiveCmmTop instr] -- code will spill instructions + ([LiveCmmTop instr] -- code with SPILL and RELOAD meta instructions added. , UniqSet Int -- left over slots , SpillStats ) -- stats about what happened during spilling @@ -63,7 +69,7 @@ regSpill code slotsFree regs -- run the spiller on all the blocks let (code', state') = - runState (mapM (mapBlockTopM (regSpill_block regSlotMap)) code) + runState (mapM (regSpill_top regSlotMap) code) (initSpillS us) return ( code' @@ -71,29 +77,90 @@ regSpill code slotsFree regs , makeSpillStats state') +-- | Spill some registers to stack slots in a top-level thing. +regSpill_top + :: Instruction instr + => RegMap Int -- ^ map of vregs to slots they're being spilled to. + -> LiveCmmTop instr -- ^ the top level thing. + -> SpillM (LiveCmmTop instr) + +regSpill_top regSlotMap cmm + = case cmm of + CmmData{} + -> return cmm + + CmmProc info label sccs + | LiveInfo static firstId mLiveVRegsOnEntry liveSlotsOnEntry <- info + -> do + -- We should only passed Cmms with the liveness maps filled in, but we'll + -- create empty ones if they're not there just in case. + let liveVRegsOnEntry = fromMaybe mapEmpty mLiveVRegsOnEntry + + -- The liveVRegsOnEntry contains the set of vregs that are live on entry to + -- each basic block. If we spill one of those vregs we remove it from that + -- set and add the corresponding slot number to the liveSlotsOnEntry set. + -- The spill cleaner needs this information to erase unneeded spill and + -- reload instructions after we've done a successful allocation. + let liveSlotsOnEntry' :: Map BlockId (Set Int) + liveSlotsOnEntry' + = mapFoldWithKey patchLiveSlot liveSlotsOnEntry liveVRegsOnEntry + + let info' + = LiveInfo static firstId + (Just liveVRegsOnEntry) + liveSlotsOnEntry' + + -- Apply the spiller to all the basic blocks in the CmmProc. + sccs' <- mapM (mapSCCM (regSpill_block regSlotMap)) sccs + + return $ CmmProc info' label sccs' + + where -- | Given a BlockId and the set of registers live in it, + -- if registers in this block are being spilled to stack slots, + -- then record the fact that these slots are now live in those blocks + -- in the given slotmap. + patchLiveSlot :: BlockId -> RegSet -> Map BlockId (Set Int) -> Map BlockId (Set Int) + patchLiveSlot blockId regsLive slotMap + = let curSlotsLive = fromMaybe Set.empty + $ Map.lookup blockId slotMap + + moreSlotsLive = Set.fromList + $ catMaybes + $ map (lookupUFM regSlotMap) + $ uniqSetToList regsLive + + slotMap' = Map.insert blockId (Set.union curSlotsLive moreSlotsLive) slotMap + + in slotMap' + + + +-- | Spill some registers to stack slots in a basic block. +regSpill_block + :: Instruction instr + => UniqFM Int -- ^ map of vregs to slots they're being spilled to. + -> LiveBasicBlock instr + -> SpillM (LiveBasicBlock instr) + regSpill_block regSlotMap (BasicBlock i instrs) = do instrss' <- mapM (regSpill_instr regSlotMap) instrs return $ BasicBlock i (concat instrss') +-- | Spill some registers to stack slots in a single instruction. If the instruction +-- uses registers that need to be spilled, then it is prefixed (or postfixed) with +-- the appropriate RELOAD or SPILL meta instructions. regSpill_instr :: Instruction instr - => UniqFM Int - -> LiveInstr instr -> SpillM [LiveInstr instr] + => UniqFM Int -- ^ map of vregs to slots they're being spilled to. + -> LiveInstr instr + -> SpillM [LiveInstr instr] --- | The thing we're spilling shouldn't already have spill or reloads in it -regSpill_instr _ SPILL{} - = panic "regSpill_instr: unexpected SPILL" - -regSpill_instr _ RELOAD{} - = panic "regSpill_instr: unexpected RELOAD" - - -regSpill_instr _ li@(Instr _ Nothing) +regSpill_instr _ li@(LiveInstr _ Nothing) = do return [li] regSpill_instr regSlotMap - (Instr instr (Just _)) + (LiveInstr instr (Just _)) = do -- work out which regs are read and written in this instr let RU rlRead rlWritten = regUsageOfInstr instr @@ -124,7 +191,7 @@ regSpill_instr regSlotMap -- final code let instrs' = prefixes - ++ [Instr instr3 Nothing] + ++ [LiveInstr instr3 Nothing] ++ postfixes return @@ -148,7 +215,7 @@ spillRead regSlotMap instr reg { stateSpillSL = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 0, 1) } return ( instr' - , ( [RELOAD slot nReg] + , ( [LiveInstr (RELOAD slot nReg) Nothing] , []) ) | otherwise = panic "RegSpill.spillRead: no slot defined for spilled reg" @@ -163,7 +230,7 @@ spillWrite regSlotMap instr reg return ( instr' , ( [] - , [SPILL nReg slot])) + , [LiveInstr (SPILL nReg slot) Nothing])) | otherwise = panic "RegSpill.spillWrite: no slot defined for spilled reg" @@ -176,14 +243,14 @@ spillModify regSlotMap instr reg { stateSpillSL = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 1) } return ( instr' - , ( [RELOAD slot nReg] - , [SPILL nReg slot])) + , ( [LiveInstr (RELOAD slot nReg) Nothing] + , [LiveInstr (SPILL nReg slot) Nothing])) | otherwise = panic "RegSpill.spillModify: no slot defined for spilled reg" --- | rewrite uses of this virtual reg in an instr to use a different virtual reg +-- | Rewrite uses of this virtual reg in an instr to use a different virtual reg patchInstr :: Instruction instr => Reg -> instr -> SpillM (instr, Reg) @@ -207,13 +274,14 @@ patchReg1 old new instr in patchRegsOfInstr instr patchF ------------------------------------------------------- --- Spiller monad - +-- Spiller monad -------------------------------------------------------------- data SpillS = SpillS - { stateUS :: UniqSupply - , stateSpillSL :: UniqFM (Reg, Int, Int) } -- ^ spilled reg vs number of times vreg was loaded, stored + { -- | unique supply for generating fresh vregs. + stateUS :: UniqSupply + + -- | spilled vreg vs the number of times it was loaded, stored + , stateSpillSL :: UniqFM (Reg, Int, Int) } initSpillS uniqueSupply = SpillS @@ -224,20 +292,17 @@ type SpillM a = State SpillS a newUnique :: SpillM Unique newUnique - = do us <- gets stateUS - case splitUniqSupply us of - (us1, us2) - -> do let uniq = uniqFromSupply us1 - modify $ \s -> s { stateUS = us2 } - return uniq + = do us <- gets stateUS + case takeUniqFromSupply us of + (uniq, us') + -> do modify $ \s -> s { stateUS = us' } + return uniq accSpillSL (r1, s1, l1) (_, s2, l2) = (r1, s1 + s2, l1 + l2) ----------------------------------------------------- --- Spiller stats - +-- Spiller stats -------------------------------------------------------------- data SpillStats = SpillStats { spillStoreLoad :: UniqFM (Reg, Int, Int) }