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