projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Cure space leak in coloring register allocator
[ghc-hetmet.git]
/
compiler
/
nativeGen
/
RegSpill.hs
diff --git
a/compiler/nativeGen/RegSpill.hs
b/compiler/nativeGen/RegSpill.hs
index
a349a56
..
0fdb8ce
100644
(file)
--- a/
compiler/nativeGen/RegSpill.hs
+++ b/
compiler/nativeGen/RegSpill.hs
@@
-1,4
+1,6
@@
+{-# OPTIONS -fno-warn-missing-signatures #-}
+
module RegSpill (
regSpill,
SpillStats(..),
module RegSpill (
regSpill,
SpillStats(..),
@@
-7,8
+9,6
@@
module RegSpill (
where
where
-#include "HsVersions.h"
-
import RegLiveness
import RegAllocInfo
import MachRegs
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')
= 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 _ li@(Instr _ Nothing)
= do return [li]
-
regSpill_instr regSlotMap
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
= 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
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) }
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
| 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) }
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
| 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) }
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"
| otherwise = panic "RegSpill.spillModify: no slot defined for spilled reg"
@@
-204,25
+188,16
@@
patchReg1 old new instr
data SpillS
= SpillS
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
, 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
, 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
newUnique :: SpillM Unique
newUnique
= do us <- gets stateUS
@@
-232,11
+207,10
@@
newUnique
modify $ \s -> s { stateUS = us2 }
return uniq
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)
= (r1, s1 + s2, l1 + l2)
-
----------------------------------------------------
-- Spiller stats
----------------------------------------------------
-- Spiller stats