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.Linear.FreeRegs
36 import RegAlloc.Liveness
48 instance Monad RegM where
49 m >>= k = RegM $ \s -> case unReg m s of { (# s, a #) -> unReg (k a) s }
50 return a = RegM $ \s -> (# s, a #)
53 -- | Run a computation in the RegM register allocator monad.
54 runR :: BlockAssignment
60 -> (BlockAssignment, StackMap, RegAllocStats, a)
62 runR block_assig freeregs assig stack us thing =
65 { ra_blockassig = block_assig
66 , ra_freeregs = freeregs
74 { ra_blockassig = block_assig
78 -> (block_assig, stack', makeRAStats state', returned_thing)
81 -- | Make register allocator stats from its final state.
82 makeRAStats :: RA_State -> RegAllocStats
85 { ra_spillInstrs = binSpillReasons (ra_spills state) }
88 spillR :: Reg -> Unique -> RegM (Instr, Int)
89 spillR reg temp = RegM $ \ s@RA_State{ra_delta=delta, ra_stack=stack} ->
90 let (stack',slot) = getStackSlotFor stack temp
91 instr = mkSpillInstr reg delta slot
93 (# s{ra_stack=stack'}, (instr,slot) #)
95 loadR :: Reg -> Int -> RegM Instr
96 loadR reg slot = RegM $ \ s@RA_State{ra_delta=delta} ->
97 (# s, mkLoadInstr reg delta slot #)
99 getFreeRegsR :: RegM FreeRegs
100 getFreeRegsR = RegM $ \ s@RA_State{ra_freeregs = freeregs} ->
103 setFreeRegsR :: FreeRegs -> RegM ()
104 setFreeRegsR regs = RegM $ \ s ->
105 (# s{ra_freeregs = regs}, () #)
107 getAssigR :: RegM (RegMap Loc)
108 getAssigR = RegM $ \ s@RA_State{ra_assig = assig} ->
111 setAssigR :: RegMap Loc -> RegM ()
112 setAssigR assig = RegM $ \ s ->
113 (# s{ra_assig=assig}, () #)
115 getBlockAssigR :: RegM BlockAssignment
116 getBlockAssigR = RegM $ \ s@RA_State{ra_blockassig = assig} ->
119 setBlockAssigR :: BlockAssignment -> RegM ()
120 setBlockAssigR assig = RegM $ \ s ->
121 (# s{ra_blockassig = assig}, () #)
123 setDeltaR :: Int -> RegM ()
124 setDeltaR n = RegM $ \ s ->
125 (# s{ra_delta = n}, () #)
127 getDeltaR :: RegM Int
128 getDeltaR = RegM $ \s -> (# s, ra_delta s #)
130 getUniqueR :: RegM Unique
131 getUniqueR = RegM $ \s ->
132 case splitUniqSupply (ra_us s) of
133 (us1, us2) -> (# s{ra_us = us2}, uniqFromSupply us1 #)
136 -- | Record that a spill instruction was inserted, for profiling.
137 recordSpill :: SpillReason -> RegM ()
139 = RegM $ \s -> (# s { ra_spills = spill : ra_spills s}, () #)