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
  41 import Data.Maybe
  42 import Data.List
  43
  44 type Slot       = Int
  45
  46 -- | Clean out unneeded spill/reloads from this top level thing.
  47 cleanSpills :: LiveCmmTop -> LiveCmmTop
  48 cleanSpills cmm
  49         = evalState (cleanSpin 0 cmm) initCleanS
  50
  51 -- | do one pass of cleaning
  52 cleanSpin :: Int -> LiveCmmTop -> CleanM LiveCmmTop
  53
  54 {-
  55 cleanSpin spinCount code
  56  = do   jumpValid       <- gets sJumpValid
  57         pprTrace "cleanSpin"
  58                 (  int spinCount
  59                 $$ text "--- code"
  60                 $$ ppr code
  61                 $$ text "--- joins"
  62                 $$ ppr jumpValid)
  63          $ cleanSpin' spinCount code
  64 -}
  65
  66 cleanSpin spinCount code
  67  = do
  68         -- init count of cleaned spills/reloads
  69         modify $ \s -> s
  70                 { sCleanedSpillsAcc     = 0
  71                 , sCleanedReloadsAcc    = 0 }
  72
  73         code'   <- mapBlockTopM cleanBlock code
  74
  75         -- During the cleaning of each block we collected information about what regs
  76         --      were valid across each jump. Based on this, work out whether it will be
  77         --      safe to erase reloads after join points for the next pass.
  78         collateJoinPoints
  79
  80         -- remember how many spills/reloads we cleaned in this pass
  81         spills          <- gets sCleanedSpillsAcc
  82         reloads         <- gets sCleanedReloadsAcc
  83         modify $ \s -> s
  84                 { sCleanedCount = (spills, reloads) : sCleanedCount s }
  85
  86         -- if nothing was cleaned in this pass or the last one
  87         --      then we're done and it's time to bail out
  88         cleanedCount    <- gets sCleanedCount
  89         if take 2 cleanedCount == [(0, 0), (0, 0)]
  90            then return code
  91
  92         -- otherwise go around again
  93            else cleanSpin (spinCount + 1) code'
  94
  95
  96 -- | Clean one basic block
  97 cleanBlock :: LiveBasicBlock -> CleanM LiveBasicBlock
  98 cleanBlock (BasicBlock id instrs)
  99  = do   jumpValid       <- gets sJumpValid
 100         let assoc       = case lookupUFM jumpValid id of
 101                                 Just assoc      -> assoc
 102                                 Nothing         -> emptyAssoc
 103
 104         instrs_reload   <- cleanReload assoc        [] instrs
 105         instrs_spill    <- cleanSpill  emptyUniqSet [] instrs_reload
 106         return  $ BasicBlock id instrs_spill
 107
 108
 109 -- | Clean out unneeded reload instructions.
 110 --      Walking forwards across the code
 111 --        On a reload, if we know a reg already has the same value as a slot
 112 --        then we don't need to do the reload.
 113 --
 114 cleanReload
 115         :: Assoc Reg Slot       -- ^ a reg and slot are associated when they have the same value.
 116         -> [LiveInstr]          -- ^ acc
 117         -> [LiveInstr]          -- ^ instrs to clean (in backwards order)
 118         -> CleanM [LiveInstr]   -- ^ cleaned instrs  (in forward   order)
 119
 120 cleanReload _ acc []
 121         = return acc
 122
 123 cleanReload assoc acc (li@(Instr instr _) : instrs)
 124
 125         | SPILL reg slot        <- instr
 126         = let   assoc'  = addAssoc reg slot     -- doing the spill makes reg and slot the same value
 127                         $ deleteBAssoc slot     -- slot value changes on spill
 128                         $ assoc
 129           in    cleanReload assoc' (li : acc) instrs
 130
 131         | RELOAD slot reg       <- instr
 132         = if elemAssoc reg slot assoc
 133
 134            -- reg and slot had the same value before reload
 135            --   we don't need the reload.
 136            then do
 137                 modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
 138                 cleanReload assoc acc instrs
 139
 140            -- reg and slot had different values before reload
 141            else
 142             let assoc'  = addAssoc reg slot     -- doing the reload makes reg and slot the same value
 143                         $ deleteAAssoc reg      -- reg value changes on reload
 144                         $ assoc
 145             in  cleanReload assoc' (li : acc) instrs
 146
 147         -- on a jump, remember the reg/slot association.
 148         | targets       <- jumpDests instr []
 149         , not $ null targets
 150         = do    mapM_ (accJumpValid assoc) targets
 151                 cleanReload assoc (li : acc) instrs
 152
 153         -- writing to a reg changes its value.
 154         | RU _ written  <- regUsage instr
 155         = let assoc'    = foldr deleteAAssoc assoc written
 156           in  cleanReload assoc' (li : acc) instrs
 157
 158
 159 -- | Clean out unneeded spill instructions.
 160 --      Walking backwards across the code.
 161 --       If there were no reloads from a slot between a spill and the last one
 162 --       then the slot was never read and we don't need the spill.
 163
 164 cleanSpill
 165         :: UniqSet Int          -- ^ slots that have been spilled, but not reload from
 166         -> [LiveInstr]          -- ^ acc
 167         -> [LiveInstr]          -- ^ instrs to clean (in forwards order)
 168         -> CleanM [LiveInstr]   -- ^ cleaned instrs  (in backwards order)
 169
 170 cleanSpill _      acc []
 171         = return  acc
 172
 173 cleanSpill unused acc (li@(Instr instr _) : instrs)
 174         | SPILL _ slot  <- instr
 175         = if elementOfUniqSet slot unused
 176
 177            -- we can erase this spill because the slot won't be read until after the next one
 178            then do
 179                 modify $ \s -> s { sCleanedSpillsAcc = sCleanedSpillsAcc s + 1 }
 180                 cleanSpill unused acc instrs
 181
 182            else do
 183                 -- slots start off unused
 184                 let unused'     = addOneToUniqSet unused slot
 185                 cleanSpill unused' (li : acc) instrs
 186
 187         -- if we reload from a slot then it's no longer unused
 188         | RELOAD slot _         <- instr
 189         , unused'               <- delOneFromUniqSet unused slot
 190         = cleanSpill unused' (li : acc) instrs
 191
 192         -- some other instruction
 193         | otherwise
 194         = cleanSpill unused (li : acc) instrs
 195
 196
 197 -- collateJoinPoints:
 198 --
 199 -- | Look at information about what regs were valid across jumps and work out
 200 --      whether it's safe to avoid reloads after join points.
 201 --
 202 collateJoinPoints :: CleanM ()
 203 collateJoinPoints
 204  = modify $ \s -> s
 205         { sJumpValid    = mapUFM intersects (sJumpValidAcc s)
 206         , sJumpValidAcc = emptyUFM }
 207
 208 intersects :: [Assoc Reg Slot]  -> Assoc Reg Slot
 209 intersects []           = emptyAssoc
 210 intersects assocs       = foldl1' intersectAssoc assocs
 211
 212
 213
 214 ---------------
 215 type CleanM = State CleanS
 216 data CleanS
 217         = CleanS
 218         { -- regs which are valid at the start of each block.
 219           sJumpValid            :: UniqFM (Assoc Reg Slot)
 220
 221           -- collecting up what regs were valid across each jump.
 222           --    in the next pass we can collate these and write the results
 223           --    to sJumpValid.
 224         , sJumpValidAcc         :: UniqFM [Assoc Reg Slot]
 225
 226           -- spills/reloads cleaned each pass (latest at front)
 227         , sCleanedCount         :: [(Int, Int)]
 228
 229           -- spills/reloads that have been cleaned in this pass so far.
 230         , sCleanedSpillsAcc     :: Int
 231         , sCleanedReloadsAcc    :: Int }
 232
 233 initCleanS :: CleanS
 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