compiler/nativeGen/RegSpillClean.hs

   1 -- | Clean out unneeded spill/reload instrs
   2 --
   3 -- * Handling of join points
   4 --
   5 --   B1:                          B2:
   6 --    ...                          ...
   7 --       RELOAD SLOT(0), %r1          RELOAD SLOT(0), %r1
   8 --       ... A ...                    ... B ...
   9 --       jump B3                      jump B3
  10 --
  11 --                B3: ... C ...
  12 --                    RELOAD SLOT(0), %r1
  13 --                    ...
  14 --
  15 -- the plan:
  16 --      So long as %r1 hasn't been written to in A, B or C then we don't need the
  17 --      reload in B3.
  18 --
  19 --      What we really care about here is that on the entry to B3, %r1 will always
  20 --      have the same value that is in SLOT(0) (ie, %r1 is _valid_)
  21 --
  22 --      This also works if the reloads in B1/B2 were spills instead, because
  23 --      spilling %r1 to a slot makes that slot have the same value as %r1.
  24 --
  25 --
  26 module RegSpillClean (
  27         cleanSpills
  28 )
  29 where
  30
  31 import RegLiveness
  32 import RegAllocInfo
  33 import MachRegs
  34 import MachInstrs
  35 import Cmm
  36
  37 import UniqSet
  38 import UniqFM
  39 import State
  40 import Outputable
  41
  42 import Data.Maybe
  43 import Data.List
  44
  45 type Slot       = Int
  46
  47 -- | Clean out unneeded spill/reloads from this top level thing.
  48 cleanSpills :: LiveCmmTop -> LiveCmmTop
  49 cleanSpills cmm
  50         = evalState (cleanSpin 0 cmm) initCleanS
  51
  52 -- | do one pass of cleaning
  53 cleanSpin :: Int -> LiveCmmTop -> CleanM LiveCmmTop
  54
  55 {-
  56 cleanSpin spinCount code
  57  = do   jumpValid       <- gets sJumpValid
  58         pprTrace "cleanSpin"
  59                 (  int spinCount
  60                 $$ text "--- code"
  61                 $$ ppr code
  62                 $$ text "--- joins"
  63                 $$ ppr jumpValid)
  64          $ cleanSpin' spinCount code
  65 -}
  66
  67 cleanSpin spinCount code
  68  = do
  69         -- init count of cleaned spills/reloads
  70         modify $ \s -> s
  71                 { sCleanedSpillsAcc     = 0
  72                 , sCleanedReloadsAcc    = 0 }
  73
  74         code'   <- mapBlockTopM cleanBlock code
  75
  76         -- During the cleaning of each block we collected information about what regs
  77         --      were valid across each jump. Based on this, work out whether it will be
  78         --      safe to erase reloads after join points for the next pass.
  79         collateJoinPoints
  80
  81         -- remember how many spills/reloads we cleaned in this pass
  82         spills          <- gets sCleanedSpillsAcc
  83         reloads         <- gets sCleanedReloadsAcc
  84         modify $ \s -> s
  85                 { sCleanedCount = (spills, reloads) : sCleanedCount s }
  86
  87         -- if nothing was cleaned in this pass or the last one
  88         --      then we're done and it's time to bail out
  89         cleanedCount    <- gets sCleanedCount
  90         if take 2 cleanedCount == [(0, 0), (0, 0)]
  91            then return code
  92
  93         -- otherwise go around again
  94            else cleanSpin (spinCount + 1) code'
  95
  96
  97 -- | Clean one basic block
  98 cleanBlock :: LiveBasicBlock -> CleanM LiveBasicBlock
  99 cleanBlock (BasicBlock id instrs)
 100  = do   jumpValid       <- gets sJumpValid
 101         let assoc       = case lookupUFM jumpValid id of
 102                                 Just assoc      -> assoc
 103                                 Nothing         -> emptyAssoc
 104
 105         instrs_reload   <- cleanReload assoc        [] instrs
 106         instrs_spill    <- cleanSpill  emptyUniqSet [] instrs_reload
 107         return  $ BasicBlock id instrs_spill
 108
 109
 110 -- | Clean out unneeded reload instructions.
 111 --      Walking forwards across the code
 112 --        On a reload, if we know a reg already has the same value as a slot
 113 --        then we don't need to do the reload.
 114 --
 115 cleanReload
 116         :: Assoc Reg Slot       -- ^ a reg and slot are associated when they have the same value.
 117         -> [LiveInstr]          -- ^ acc
 118         -> [LiveInstr]          -- ^ instrs to clean (in backwards order)
 119         -> CleanM [LiveInstr]   -- ^ cleaned instrs  (in forward   order)
 120
 121 cleanReload assoc acc []
 122         = return acc
 123
 124 cleanReload assoc acc (li@(Instr instr live) : instrs)
 125
 126         | SPILL reg slot        <- instr
 127         = let   assoc'  = addAssoc reg slot     -- doing the spill makes reg and slot the same value
 128                         $ deleteBAssoc slot     -- slot value changes on spill
 129                         $ assoc
 130           in    cleanReload assoc' (li : acc) instrs
 131
 132         | RELOAD slot reg       <- instr
 133         = if elemAssoc reg slot assoc
 134
 135            -- reg and slot had the same value before reload
 136            --   we don't need the reload.
 137            then do
 138                 modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
 139                 cleanReload assoc acc instrs
 140
 141            -- reg and slot had different values before reload
 142            else
 143             let assoc'  = addAssoc reg slot     -- doing the reload makes reg and slot the same value
 144                         $ deleteAAssoc reg      -- reg value changes on reload
 145                         $ assoc
 146             in  cleanReload assoc' (li : acc) instrs
 147
 148         -- on a jump, remember the reg/slot association.
 149         | targets               <- jumpDests instr []
 150         , not $ null targets
 151         = do    mapM_ (accJumpValid assoc) targets
 152                 cleanReload assoc (li : acc) instrs
 153
 154         -- writing to a reg changes its value.
 155         | RU read written       <- regUsage instr
 156         = let assoc'    = foldr deleteAAssoc assoc written
 157           in  cleanReload assoc' (li : acc) instrs
 158
 159
 160 -- | Clean out unneeded spill instructions.
 161 --      Walking backwards across the code.
 162 --       If there were no reloads from a slot between a spill and the last one
 163 --       then the slot was never read and we don't need the spill.
 164
 165 cleanSpill
 166         :: UniqSet Int          -- ^ slots that have been spilled, but not reload from
 167         -> [LiveInstr]          -- ^ acc
 168         -> [LiveInstr]          -- ^ instrs to clean (in forwards order)
 169         -> CleanM [LiveInstr]   -- ^ cleaned instrs  (in backwards order)
 170
 171 cleanSpill unused acc []
 172         = return  acc
 173
 174 cleanSpill unused acc (li@(Instr instr live) : instrs)
 175         | SPILL reg slot        <- instr
 176         = if elementOfUniqSet slot unused
 177
 178            -- we can erase this spill because the slot won't be read until after the next one
 179            then do
 180                 modify $ \s -> s { sCleanedSpillsAcc = sCleanedSpillsAcc s + 1 }
 181                 cleanSpill unused acc instrs
 182
 183            else do
 184                 -- slots start off unused
 185                 let unused'     = addOneToUniqSet unused slot
 186                 cleanSpill unused' (li : acc) instrs
 187
 188         -- if we reload from a slot then it's no longer unused
 189         | RELOAD slot reg       <- instr
 190         , unused'               <- delOneFromUniqSet unused slot
 191         = cleanSpill unused' (li : acc) instrs
 192
 193         -- some other instruction
 194         | otherwise
 195         = cleanSpill unused (li : acc) instrs
 196
 197
 198 -- collateJoinPoints:
 199 --
 200 -- | Look at information about what regs were valid across jumps and work out
 201 --      whether it's safe to avoid reloads after join points.
 202 --
 203 collateJoinPoints :: CleanM ()
 204 collateJoinPoints
 205  = modify $ \s -> s
 206         { sJumpValid    = mapUFM intersects (sJumpValidAcc s)
 207         , sJumpValidAcc = emptyUFM }
 208
 209 intersects :: [Assoc Reg Slot]  -> Assoc Reg Slot
 210 intersects []           = emptyAssoc
 211 intersects assocs       = foldl1' intersectAssoc assocs
 212
 213
 214
 215 ---------------
 216 type CleanM = State CleanS
 217 data CleanS
 218         = CleanS
 219         { -- regs which are valid at the start of each block.
 220           sJumpValid            :: UniqFM (Assoc Reg Slot)
 221
 222           -- collecting up what regs were valid across each jump.
 223           --    in the next pass we can collate these and write the results
 224           --    to sJumpValid.
 225         , sJumpValidAcc         :: UniqFM [Assoc Reg Slot]
 226
 227           -- spills/reloads cleaned each pass (latest at front)
 228         , sCleanedCount         :: [(Int, Int)]
 229
 230           -- spills/reloads that have been cleaned in this pass so far.
 231         , sCleanedSpillsAcc     :: Int
 232         , sCleanedReloadsAcc    :: Int }
 233
 234 initCleanS
 235         = CleanS
 236         { sJumpValid            = emptyUFM
 237         , sJumpValidAcc         = emptyUFM
 238
 239         , sCleanedCount         = []
 240
 241         , sCleanedSpillsAcc     = 0
 242         , sCleanedReloadsAcc    = 0 }
 243
 244
 245 -- | Remember that these regs were valid before a jump to this block
 246 accJumpValid :: Assoc Reg Slot -> BlockId -> CleanM ()
 247 accJumpValid regs target
 248         = modify $ \s -> s {
 249                 sJumpValidAcc = addToUFM_C (++)
 250                                         (sJumpValidAcc s)
 251                                         target
 252                                         [regs] }
 253
 254
 255 --------------
 256 -- An association table / many to many mapping.
 257 --      TODO:   implement this better than a simple association list.
 258 --              two maps of sets, one for each direction would be better
 259 --
 260 data Assoc a b
 261         = Assoc
 262         { aList :: [(a, b)] }
 263
 264 -- | an empty association
 265 emptyAssoc :: Assoc a b
 266 emptyAssoc = Assoc { aList = [] }
 267
 268
 269 -- | add an association to the table.
 270 addAssoc
 271         :: (Eq a, Eq b)
 272         => a -> b -> Assoc a b -> Assoc a b
 273
 274 addAssoc a b m  = m { aList = (a, b) : aList m }
 275
 276
 277 -- | check if these two things are associated
 278 elemAssoc
 279         :: (Eq a, Eq b)
 280         => a -> b -> Assoc a b -> Bool
 281 elemAssoc a b m = elem (a, b) $ aList m
 282
 283
 284 -- | delete all associations with this A element
 285 deleteAAssoc
 286         :: Eq a
 287         => a -> Assoc a b -> Assoc a b
 288
 289 deleteAAssoc x m
 290         = m { aList = [ (a, b)  | (a, b) <- aList m
 291                                 , a /= x ] }
 292
 293
 294 -- | delete all associations with this B element
 295 deleteBAssoc
 296         :: Eq b
 297         => b -> Assoc a b -> Assoc a b
 298
 299 deleteBAssoc x m
 300         = m { aList = [ (a, b)  | (a, b) <- aList m
 301                                 , b /= x ] }
 302
 303
 304 -- | intersect two associations
 305 intersectAssoc
 306         :: (Eq a, Eq b)
 307         => Assoc a b -> Assoc a b -> Assoc a b
 308
 309 intersectAssoc a1 a2
 310         = emptyAssoc
 311         { aList = intersect (aList a1) (aList a2) }
 312