compiler/nativeGen/RegAlloc/Linear/State.hs

   1 -- | State monad for the linear register allocator.
   2
   3 --      Here we keep all the state that the register allocator keeps track
   4 --      of as it walks the instructions in a basic block.
   5
   6 module RegAlloc.Linear.State (
   7         RA_State(..),
   8         RegM,
   9         runR,
  10
  11         spillR,
  12         loadR,
  13
  14         getFreeRegsR,
  15         setFreeRegsR,
  16
  17         getAssigR,
  18         setAssigR,
  19
  20         getBlockAssigR,
  21         setBlockAssigR,
  22
  23         setDeltaR,
  24         getDeltaR,
  25
  26         getUniqueR,
  27
  28         recordSpill
  29 )
  30 where
  31
  32 import RegAlloc.Linear.Stats
  33 import RegAlloc.Linear.StackMap
  34 import RegAlloc.Linear.Base
  35 import RegAlloc.Linear.FreeRegs
  36 import RegAlloc.Liveness
  37
  38
  39 import Instrs
  40 import Regs
  41 import RegAllocInfo
  42
  43 import Unique
  44 import UniqSupply
  45
  46
  47 -- | The RegM Monad
  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 #)
  51
  52
  53 -- | Run a computation in the RegM register allocator monad.
  54 runR    :: BlockAssignment
  55         -> FreeRegs
  56         -> RegMap Loc
  57         -> StackMap
  58         -> UniqSupply
  59         -> RegM a
  60         -> (BlockAssignment, StackMap, RegAllocStats, a)
  61
  62 runR block_assig freeregs assig stack us thing =
  63   case unReg thing
  64         (RA_State
  65                 { ra_blockassig = block_assig
  66                 , ra_freeregs   = freeregs
  67                 , ra_assig      = assig
  68                 , ra_delta      = 0{-???-}
  69                 , ra_stack      = stack
  70                 , ra_us         = us
  71                 , ra_spills     = [] })
  72    of
  73         (# state'@RA_State
  74                 { ra_blockassig = block_assig
  75                 , ra_stack      = stack' }
  76                 , returned_thing #)
  77
  78          ->     (block_assig, stack', makeRAStats state', returned_thing)
  79
  80
  81 -- | Make register allocator stats from its final state.
  82 makeRAStats :: RA_State -> RegAllocStats
  83 makeRAStats state
  84         = RegAllocStats
  85         { ra_spillInstrs        = binSpillReasons (ra_spills state) }
  86
  87
  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
  92   in
  93   (# s{ra_stack=stack'}, (instr,slot) #)
  94
  95 loadR :: Reg -> Int -> RegM Instr
  96 loadR reg slot = RegM $ \ s@RA_State{ra_delta=delta} ->
  97   (# s, mkLoadInstr reg delta slot #)
  98
  99 getFreeRegsR :: RegM FreeRegs
 100 getFreeRegsR = RegM $ \ s@RA_State{ra_freeregs = freeregs} ->
 101   (# s, freeregs #)
 102
 103 setFreeRegsR :: FreeRegs -> RegM ()
 104 setFreeRegsR regs = RegM $ \ s ->
 105   (# s{ra_freeregs = regs}, () #)
 106
 107 getAssigR :: RegM (RegMap Loc)
 108 getAssigR = RegM $ \ s@RA_State{ra_assig = assig} ->
 109   (# s, assig #)
 110
 111 setAssigR :: RegMap Loc -> RegM ()
 112 setAssigR assig = RegM $ \ s ->
 113   (# s{ra_assig=assig}, () #)
 114
 115 getBlockAssigR :: RegM BlockAssignment
 116 getBlockAssigR = RegM $ \ s@RA_State{ra_blockassig = assig} ->
 117   (# s, assig #)
 118
 119 setBlockAssigR :: BlockAssignment -> RegM ()
 120 setBlockAssigR assig = RegM $ \ s ->
 121   (# s{ra_blockassig = assig}, () #)
 122
 123 setDeltaR :: Int -> RegM ()
 124 setDeltaR n = RegM $ \ s ->
 125   (# s{ra_delta = n}, () #)
 126
 127 getDeltaR :: RegM Int
 128 getDeltaR = RegM $ \s -> (# s, ra_delta s #)
 129
 130 getUniqueR :: RegM Unique
 131 getUniqueR = RegM $ \s ->
 132   case splitUniqSupply (ra_us s) of
 133     (us1, us2) -> (# s{ra_us = us2}, uniqFromSupply us1 #)
 134
 135
 136 -- | Record that a spill instruction was inserted, for profiling.
 137 recordSpill :: SpillReason -> RegM ()
 138 recordSpill spill
 139         = RegM $ \s -> (# s { ra_spills = spill : ra_spills s}, () #)