compiler/nativeGen/RegAlloc/Graph/Coalesce.hs

   1 -- | Register coalescing.
   2 --
   3
   4 module RegAlloc.Graph.Coalesce (
   5         regCoalesce,
   6         slurpJoinMovs
   7 )
   8
   9 where
  10
  11 import RegAlloc.Liveness
  12 import Instruction
  13 import Reg
  14
  15 import Cmm
  16 import Bag
  17 import UniqFM
  18 import UniqSet
  19 import UniqSupply
  20
  21 import Data.List
  22
  23 -- | Do register coalescing on this top level thing
  24 --      For Reg -> Reg moves, if the first reg dies at the same time the second reg is born
  25 --      then the mov only serves to join live ranges. The two regs can be renamed to be
  26 --      the same and the move instruction safely erased.
  27
  28 regCoalesce
  29         :: Instruction instr
  30         => [LiveCmmTop instr]
  31         -> UniqSM [LiveCmmTop instr]
  32
  33 regCoalesce code
  34  = do
  35         let joins       = foldl' unionBags emptyBag
  36                         $ map slurpJoinMovs code
  37
  38         let alloc       = foldl' buildAlloc emptyUFM
  39                         $ bagToList joins
  40
  41         let patched     = map (patchEraseLive (sinkReg alloc)) code
  42
  43         return patched
  44
  45
  46 buildAlloc :: UniqFM Reg -> (Reg, Reg) -> UniqFM Reg
  47 buildAlloc fm (r1, r2)
  48  = let  rmin    = min r1 r2
  49         rmax    = max r1 r2
  50    in   addToUFM fm rmax rmin
  51
  52 sinkReg :: UniqFM Reg -> Reg -> Reg
  53 sinkReg fm r
  54  = case lookupUFM fm r of
  55         Nothing -> r
  56         Just r' -> sinkReg fm r'
  57
  58
  59 -- | Slurp out mov instructions that only serve to join live ranges.
  60 --      During a mov, if the source reg dies and the destiation reg is born
  61 --      then we can rename the two regs to the same thing and eliminate the move.
  62 --
  63 slurpJoinMovs
  64         :: Instruction instr
  65         => LiveCmmTop instr
  66         -> Bag (Reg, Reg)
  67
  68 slurpJoinMovs live
  69         = slurpCmm emptyBag live
  70  where
  71         slurpCmm   rs  CmmData{}                         = rs
  72         slurpCmm   rs (CmmProc _ _ _ (ListGraph blocks)) = foldl' slurpComp  rs blocks
  73         slurpComp  rs (BasicBlock _ blocks)              = foldl' slurpBlock rs blocks
  74         slurpBlock rs (BasicBlock _ instrs)              = foldl' slurpLI    rs instrs
  75
  76         slurpLI    rs (Instr _  Nothing)                 = rs
  77         slurpLI    rs (Instr instr (Just live))
  78                 | Just (r1, r2) <- takeRegRegMoveInstr instr
  79                 , elementOfUniqSet r1 $ liveDieRead live
  80                 , elementOfUniqSet r2 $ liveBorn live
  81
  82                 -- only coalesce movs between two virtuals for now, else we end up with
  83                 --      allocatable regs in the live regs list..
  84                 , isVirtualReg r1 && isVirtualReg r2
  85                 = consBag (r1, r2) rs
  86
  87                 | otherwise
  88                 = rs
  89
  90         slurpLI    rs SPILL{}   = rs
  91         slurpLI    rs RELOAD{}  = rs
  92
  93