1 -- | State monad for the linear register allocator.
3 -- Here we keep all the state that the register allocator keeps track
4 -- of as it walks the instructions in a basic block.
6 module RegAlloc.Linear.State (
32 import RegAlloc.Linear.Stats
33 import RegAlloc.Linear.StackMap
34 import RegAlloc.Linear.Base
35 import RegAlloc.Liveness
44 instance Monad (RegM freeRegs) where
45 m >>= k = RegM $ \s -> case unReg m s of { (# s, a #) -> unReg (k a) s }
46 return a = RegM $ \s -> (# s, a #)
49 -- | Run a computation in the RegM register allocator monad.
50 runR :: BlockAssignment freeRegs
56 -> (BlockAssignment freeRegs, StackMap, RegAllocStats, a)
58 runR block_assig freeregs assig stack us thing =
61 { ra_blockassig = block_assig
62 , ra_freeregs = freeregs
70 { ra_blockassig = block_assig
74 -> (block_assig, stack', makeRAStats state', returned_thing)
77 -- | Make register allocator stats from its final state.
78 makeRAStats :: RA_State freeRegs -> RegAllocStats
81 { ra_spillInstrs = binSpillReasons (ra_spills state) }
84 spillR :: Instruction instr
85 => Reg -> Unique -> RegM freeRegs (instr, Int)
87 spillR reg temp = RegM $ \ s@RA_State{ra_delta=delta, ra_stack=stack} ->
88 let (stack',slot) = getStackSlotFor stack temp
89 instr = mkSpillInstr reg delta slot
91 (# s{ra_stack=stack'}, (instr,slot) #)
94 loadR :: Instruction instr
95 => Reg -> Int -> RegM freeRegs instr
97 loadR reg slot = RegM $ \ s@RA_State{ra_delta=delta} ->
98 (# s, mkLoadInstr reg delta slot #)
100 getFreeRegsR :: RegM freeRegs freeRegs
101 getFreeRegsR = RegM $ \ s@RA_State{ra_freeregs = freeregs} ->
104 setFreeRegsR :: freeRegs -> RegM freeRegs ()
105 setFreeRegsR regs = RegM $ \ s ->
106 (# s{ra_freeregs = regs}, () #)
108 getAssigR :: RegM freeRegs (RegMap Loc)
109 getAssigR = RegM $ \ s@RA_State{ra_assig = assig} ->
112 setAssigR :: RegMap Loc -> RegM freeRegs ()
113 setAssigR assig = RegM $ \ s ->
114 (# s{ra_assig=assig}, () #)
116 getBlockAssigR :: RegM freeRegs (BlockAssignment freeRegs)
117 getBlockAssigR = RegM $ \ s@RA_State{ra_blockassig = assig} ->
120 setBlockAssigR :: BlockAssignment freeRegs -> RegM freeRegs ()
121 setBlockAssigR assig = RegM $ \ s ->
122 (# s{ra_blockassig = assig}, () #)
124 setDeltaR :: Int -> RegM freeRegs ()
125 setDeltaR n = RegM $ \ s ->
126 (# s{ra_delta = n}, () #)
128 getDeltaR :: RegM freeRegs Int
129 getDeltaR = RegM $ \s -> (# s, ra_delta s #)
131 getUniqueR :: RegM freeRegs Unique
132 getUniqueR = RegM $ \s ->
133 case takeUniqFromSupply (ra_us s) of
134 (uniq, us) -> (# s{ra_us = us}, uniq #)
137 -- | Record that a spill instruction was inserted, for profiling.
138 recordSpill :: SpillReason -> RegM freeRegs ()
140 = RegM $ \s -> (# s { ra_spills = spill : ra_spills s}, () #)