X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FRegSpill.hs;h=0fdb8ce857e7c05c3443f63c352f8335b91ebd56;hb=97169c5dd31537b28f5f8ad08cd6cdf82c1ecefd;hp=d4268762620e5289abe189f508d979e8971ca43e;hpb=f0d0e9d63ee27a12e80b6f069be5e9d4b55ca545;p=ghc-hetmet.git diff --git a/compiler/nativeGen/RegSpill.hs b/compiler/nativeGen/RegSpill.hs index d426876..0fdb8ce 100644 --- a/compiler/nativeGen/RegSpill.hs +++ b/compiler/nativeGen/RegSpill.hs @@ -1,13 +1,14 @@ +{-# OPTIONS -fno-warn-missing-signatures #-} + module RegSpill ( regSpill, - SpillStats(..) + SpillStats(..), + accSpillSL ) where -#include "HsVersions.h" - import RegLiveness import RegAllocInfo import MachRegs @@ -74,18 +75,11 @@ regSpill_block regSlotMap (BasicBlock i instrs) = do instrss' <- mapM (regSpill_instr regSlotMap) instrs return $ BasicBlock i (concat instrss') - -regSpill_instr _ li@(Instr (DELTA delta) _) - = do - setDelta delta - return [li] - regSpill_instr _ li@(Instr _ Nothing) = do return [li] - regSpill_instr regSlotMap - (Instr instr (Just live)) + (Instr instr (Just _)) = do -- work out which regs are read and written in this instr let RU rlRead rlWritten = regUsage instr @@ -134,49 +128,40 @@ regSpill_instr regSlotMap spillRead regSlotMap instr reg | Just slot <- lookupUFM regSlotMap reg - = do delta <- getDelta - (instr', nReg) <- patchInstr reg instr - - let pre = [ COMMENT FSLIT("spill load") - , mkLoadInstr nReg delta slot ] + = do (instr', nReg) <- patchInstr reg instr modify $ \s -> s - { stateSpillLS = addToUFM_C accSpillLS (stateSpillLS s) reg (reg, 1, 0) } + { stateSpillSL = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 0, 1) } - return ( instr', (pre, [])) + return ( instr' + , ( [RELOAD slot nReg] + , []) ) | otherwise = panic "RegSpill.spillRead: no slot defined for spilled reg" spillWrite regSlotMap instr reg | Just slot <- lookupUFM regSlotMap reg - = do delta <- getDelta - (instr', nReg) <- patchInstr reg instr - - let post = [ COMMENT FSLIT("spill store") - , mkSpillInstr nReg delta slot ] + = do (instr', nReg) <- patchInstr reg instr modify $ \s -> s - { stateSpillLS = addToUFM_C accSpillLS (stateSpillLS s) reg (reg, 0, 1) } + { stateSpillSL = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 0) } - return ( instr', ([], post)) + return ( instr' + , ( [] + , [SPILL nReg slot])) | otherwise = panic "RegSpill.spillWrite: no slot defined for spilled reg" spillModify regSlotMap instr reg | Just slot <- lookupUFM regSlotMap reg - = do delta <- getDelta - (instr', nReg) <- patchInstr reg instr - - let pre = [ COMMENT FSLIT("spill mod load") - , mkLoadInstr nReg delta slot ] - - let post = [ COMMENT FSLIT("spill mod store") - , mkSpillInstr nReg delta slot ] + = do (instr', nReg) <- patchInstr reg instr modify $ \s -> s - { stateSpillLS = addToUFM_C accSpillLS (stateSpillLS s) reg (reg, 1, 1) } + { stateSpillSL = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 1) } - return ( instr', (pre, post)) + return ( instr' + , ( [RELOAD slot nReg] + , [SPILL nReg slot])) | otherwise = panic "RegSpill.spillModify: no slot defined for spilled reg" @@ -203,25 +188,16 @@ patchReg1 old new instr data SpillS = SpillS - { stateDelta :: Int - , stateUS :: UniqSupply - , stateSpillLS :: UniqFM (Reg, Int, Int) } -- ^ spilled reg vs number of times vreg was loaded, stored + { stateUS :: UniqSupply + , stateSpillSL :: UniqFM (Reg, Int, Int) } -- ^ spilled reg vs number of times vreg was loaded, stored initSpillS uniqueSupply = SpillS - { stateDelta = 0 - , stateUS = uniqueSupply - , stateSpillLS = emptyUFM } + { stateUS = uniqueSupply + , stateSpillSL = emptyUFM } type SpillM a = State SpillS a -setDelta :: Int -> SpillM () -setDelta delta - = modify $ \s -> s { stateDelta = delta } - -getDelta :: SpillM Int -getDelta = gets stateDelta - newUnique :: SpillM Unique newUnique = do us <- gets stateUS @@ -231,9 +207,8 @@ newUnique modify $ \s -> s { stateUS = us2 } return uniq -accSpillLS (r1, l1, s1) (r2, l2, s2) - = (r1, l1 + l2, s1 + s2) - +accSpillSL (r1, s1, l1) (_, s2, l2) + = (r1, s1 + s2, l1 + l2) ---------------------------------------------------- @@ -241,15 +216,15 @@ accSpillLS (r1, l1, s1) (r2, l2, s2) data SpillStats = SpillStats - { spillLoadStore :: UniqFM (Reg, Int, Int) } + { spillStoreLoad :: UniqFM (Reg, Int, Int) } makeSpillStats :: SpillS -> SpillStats makeSpillStats s = SpillStats - { spillLoadStore = stateSpillLS s } + { spillStoreLoad = stateSpillSL s } instance Outputable SpillStats where - ppr s - = (vcat $ map (\(r, l, s) -> ppr r <+> int l <+> int s) - $ eltsUFM (spillLoadStore s)) + ppr stats + = (vcat $ map (\(r, s, l) -> ppr r <+> int s <+> int l) + $ eltsUFM (spillStoreLoad stats))