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 import Instruction
  38 import Reg
  39
  40 import Unique
  41 import UniqSupply
  42
  43
  44 -- | The RegM Monad
  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 #)
  48
  49
  50 -- | Run a computation in the RegM register allocator monad.
  51 runR    :: BlockAssignment
  52         -> FreeRegs
  53         -> RegMap Loc
  54         -> StackMap
  55         -> UniqSupply
  56         -> RegM a
  57         -> (BlockAssignment, StackMap, RegAllocStats, a)
  58
  59 runR block_assig freeregs assig stack us thing =
  60   case unReg thing
  61         (RA_State
  62                 { ra_blockassig = block_assig
  63                 , ra_freeregs   = freeregs
  64                 , ra_assig      = assig
  65                 , ra_delta      = 0{-???-}
  66                 , ra_stack      = stack
  67                 , ra_us         = us
  68                 , ra_spills     = [] })
  69    of
  70         (# state'@RA_State
  71                 { ra_blockassig = block_assig
  72                 , ra_stack      = stack' }
  73                 , returned_thing #)
  74
  75          ->     (block_assig, stack', makeRAStats state', returned_thing)
  76
  77
  78 -- | Make register allocator stats from its final state.
  79 makeRAStats :: RA_State -> RegAllocStats
  80 makeRAStats state
  81         = RegAllocStats
  82         { ra_spillInstrs        = binSpillReasons (ra_spills state) }
  83
  84
  85 spillR  :: Instruction instr
  86         => Reg -> Unique -> RegM (instr, Int)
  87
  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
  91   in
  92   (# s{ra_stack=stack'}, (instr,slot) #)
  93
  94
  95 loadR   :: Instruction instr
  96         => Reg -> Int -> RegM instr
  97
  98 loadR reg slot = RegM $ \ s@RA_State{ra_delta=delta} ->
  99   (# s, mkLoadInstr reg delta slot #)
 100
 101 getFreeRegsR :: RegM FreeRegs
 102 getFreeRegsR = RegM $ \ s@RA_State{ra_freeregs = freeregs} ->
 103   (# s, freeregs #)
 104
 105 setFreeRegsR :: FreeRegs -> RegM ()
 106 setFreeRegsR regs = RegM $ \ s ->
 107   (# s{ra_freeregs = regs}, () #)
 108
 109 getAssigR :: RegM (RegMap Loc)
 110 getAssigR = RegM $ \ s@RA_State{ra_assig = assig} ->
 111   (# s, assig #)
 112
 113 setAssigR :: RegMap Loc -> RegM ()
 114 setAssigR assig = RegM $ \ s ->
 115   (# s{ra_assig=assig}, () #)
 116
 117 getBlockAssigR :: RegM BlockAssignment
 118 getBlockAssigR = RegM $ \ s@RA_State{ra_blockassig = assig} ->
 119   (# s, assig #)
 120
 121 setBlockAssigR :: BlockAssignment -> RegM ()
 122 setBlockAssigR assig = RegM $ \ s ->
 123   (# s{ra_blockassig = assig}, () #)
 124
 125 setDeltaR :: Int -> RegM ()
 126 setDeltaR n = RegM $ \ s ->
 127   (# s{ra_delta = n}, () #)
 128
 129 getDeltaR :: RegM Int
 130 getDeltaR = RegM $ \s -> (# s, ra_delta s #)
 131
 132 getUniqueR :: RegM Unique
 133 getUniqueR = RegM $ \s ->
 134   case takeUniqFromSupply (ra_us s) of
 135     (uniq, us) -> (# s{ra_us = us}, uniq #)
 136
 137
 138 -- | Record that a spill instruction was inserted, for profiling.
 139 recordSpill :: SpillReason -> RegM ()
 140 recordSpill spill
 141         = RegM $ \s -> (# s { ra_spills = spill : ra_spills s}, () #)