X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FRegSpill.hs;h=0fdb8ce857e7c05c3443f63c352f8335b91ebd56;hb=97169c5dd31537b28f5f8ad08cd6cdf82c1ecefd;hp=a349a568a63cece32dbb3f8cabd1310d792df05a;hpb=f2cd56cf9fc310c9b587ecb5dfaee4ad6b580355;p=ghc-hetmet.git diff --git a/compiler/nativeGen/RegSpill.hs b/compiler/nativeGen/RegSpill.hs index a349a56..0fdb8ce 100644 --- a/compiler/nativeGen/RegSpill.hs +++ b/compiler/nativeGen/RegSpill.hs @@ -1,4 +1,6 @@ +{-# OPTIONS -fno-warn-missing-signatures #-} + module RegSpill ( regSpill, SpillStats(..), @@ -7,8 +9,6 @@ module RegSpill ( where -#include "HsVersions.h" - import RegLiveness import RegAllocInfo import MachRegs @@ -75,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 @@ -135,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 { 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 { 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 { 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" @@ -204,25 +188,16 @@ patchReg1 old new instr data SpillS = SpillS - { stateDelta :: Int - , stateUS :: UniqSupply + { stateUS :: UniqSupply , stateSpillSL :: UniqFM (Reg, Int, Int) } -- ^ spilled reg vs number of times vreg was loaded, stored initSpillS uniqueSupply = SpillS - { stateDelta = 0 - , stateUS = uniqueSupply + { 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 @@ -232,11 +207,10 @@ newUnique modify $ \s -> s { stateUS = us2 } return uniq -accSpillSL (r1, s1, l1) (r2, s2, l2) +accSpillSL (r1, s1, l1) (_, s2, l2) = (r1, s1 + s2, l1 + l2) - ---------------------------------------------------- -- Spiller stats