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
45 instance Monad RegM where
46 m >>= k = RegM $ \s -> case unReg m s of { (# s, a #) -> unReg (k a) s }
47 return a = RegM $ \s -> (# s, a #)
50 -- | Run a computation in the RegM register allocator monad.
51 runR :: BlockAssignment
57 -> (BlockAssignment, StackMap, RegAllocStats, a)
59 runR block_assig freeregs assig stack us thing =
62 { ra_blockassig = block_assig
63 , ra_freeregs = freeregs
71 { ra_blockassig = block_assig
75 -> (block_assig, stack', makeRAStats state', returned_thing)
78 -- | Make register allocator stats from its final state.
79 makeRAStats :: RA_State -> RegAllocStats
82 { ra_spillInstrs = binSpillReasons (ra_spills state) }
85 spillR :: Instruction instr
86 => Reg -> Unique -> RegM (instr, Int)
88 spillR reg temp = RegM $ \ s@RA_State{ra_delta=delta, ra_stack=stack} ->
89 let (stack',slot) = getStackSlotFor stack temp
90 instr = mkSpillInstr reg delta slot
92 (# s{ra_stack=stack'}, (instr,slot) #)
95 loadR :: Instruction instr
96 => Reg -> Int -> RegM instr
98 loadR reg slot = RegM $ \ s@RA_State{ra_delta=delta} ->
99 (# s, mkLoadInstr reg delta slot #)
101 getFreeRegsR :: RegM FreeRegs
102 getFreeRegsR = RegM $ \ s@RA_State{ra_freeregs = freeregs} ->
105 setFreeRegsR :: FreeRegs -> RegM ()
106 setFreeRegsR regs = RegM $ \ s ->
107 (# s{ra_freeregs = regs}, () #)
109 getAssigR :: RegM (RegMap Loc)
110 getAssigR = RegM $ \ s@RA_State{ra_assig = assig} ->
113 setAssigR :: RegMap Loc -> RegM ()
114 setAssigR assig = RegM $ \ s ->
115 (# s{ra_assig=assig}, () #)
117 getBlockAssigR :: RegM BlockAssignment
118 getBlockAssigR = RegM $ \ s@RA_State{ra_blockassig = assig} ->
121 setBlockAssigR :: BlockAssignment -> RegM ()
122 setBlockAssigR assig = RegM $ \ s ->
123 (# s{ra_blockassig = assig}, () #)
125 setDeltaR :: Int -> RegM ()
126 setDeltaR n = RegM $ \ s ->
127 (# s{ra_delta = n}, () #)
129 getDeltaR :: RegM Int
130 getDeltaR = RegM $ \s -> (# s, ra_delta s #)
132 getUniqueR :: RegM Unique
133 getUniqueR = RegM $ \s ->
134 case takeUniqFromSupply (ra_us s) of
135 (uniq, us) -> (# s{ra_us = us}, uniq #)
138 -- | Record that a spill instruction was inserted, for profiling.
139 recordSpill :: SpillReason -> RegM ()
141 = RegM $ \s -> (# s { ra_spills = spill : ra_spills s}, () #)