compiler/nativeGen/RegAlloc/Graph/SpillClean.hs

   1 {-# OPTIONS -fno-warn-missing-signatures #-}
   2 -- | Clean out unneeded spill\/reload instrs
   3 --
   4 -- * Handling of join points
   5 --
   6 --   B1:                          B2:
   7 --    ...                          ...
   8 --       RELOAD SLOT(0), %r1          RELOAD SLOT(0), %r1
   9 --       ... A ...                    ... B ...
  10 --       jump B3                      jump B3
  11 --
  12 --                B3: ... C ...
  13 --                    RELOAD SLOT(0), %r1
  14 --                    ...
  15 --
  16 -- the plan:
  17 --      So long as %r1 hasn't been written to in A, B or C then we don't need the
  18 --      reload in B3.
  19 --
  20 --      What we really care about here is that on the entry to B3, %r1 will always
  21 --      have the same value that is in SLOT(0) (ie, %r1 is _valid_)
  22 --
  23 --      This also works if the reloads in B1\/B2 were spills instead, because
  24 --      spilling %r1 to a slot makes that slot have the same value as %r1.
  25 --
  26
  27 module RegAlloc.Graph.SpillClean (
  28         cleanSpills
  29 )
  30 where
  31
  32 import RegAlloc.Liveness
  33 import Instruction
  34 import Reg
  35
  36 import BlockId
  37 import Cmm
  38 import UniqSet
  39 import UniqFM
  40 import Unique
  41 import State
  42 import Outputable
  43 import Util
  44
  45 import Data.Maybe
  46 import Data.List        ( find, nub )
  47
  48 --
  49 type Slot = Int
  50
  51
  52 -- | Clean out unneeded spill\/reloads from this top level thing.
  53 cleanSpills
  54         :: Instruction instr
  55         => LiveCmmTop instr -> LiveCmmTop instr
  56
  57 cleanSpills cmm
  58         = evalState (cleanSpin 0 cmm) initCleanS
  59
  60 -- | do one pass of cleaning
  61 cleanSpin
  62         :: Instruction instr
  63         => Int
  64         -> LiveCmmTop instr
  65         -> CleanM (LiveCmmTop instr)
  66
  67 {-
  68 cleanSpin spinCount code
  69  = do   jumpValid       <- gets sJumpValid
  70         pprTrace "cleanSpin"
  71                 (  int spinCount
  72                 $$ text "--- code"
  73                 $$ ppr code
  74                 $$ text "--- joins"
  75                 $$ ppr jumpValid)
  76          $ cleanSpin' spinCount code
  77 -}
  78
  79 cleanSpin spinCount code
  80  = do
  81         -- init count of cleaned spills\/reloads
  82         modify $ \s -> s
  83                 { sCleanedSpillsAcc     = 0
  84                 , sCleanedReloadsAcc    = 0
  85                 , sReloadedBy           = emptyUFM }
  86
  87         code_forward    <- mapBlockTopM cleanBlockForward  code
  88         code_backward   <- mapBlockTopM cleanBlockBackward code_forward
  89
  90         -- During the cleaning of each block we collected information about what regs
  91         --      were valid across each jump. Based on this, work out whether it will be
  92         --      safe to erase reloads after join points for the next pass.
  93         collateJoinPoints
  94
  95         -- remember how many spills\/reloads we cleaned in this pass
  96         spills          <- gets sCleanedSpillsAcc
  97         reloads         <- gets sCleanedReloadsAcc
  98         modify $ \s -> s
  99                 { sCleanedCount = (spills, reloads) : sCleanedCount s }
 100
 101         -- if nothing was cleaned in this pass or the last one
 102         --      then we're done and it's time to bail out
 103         cleanedCount    <- gets sCleanedCount
 104         if take 2 cleanedCount == [(0, 0), (0, 0)]
 105            then return code
 106
 107         -- otherwise go around again
 108            else cleanSpin (spinCount + 1) code_backward
 109
 110
 111 -- | Clean one basic block
 112 cleanBlockForward
 113         :: Instruction instr
 114         => LiveBasicBlock instr
 115         -> CleanM (LiveBasicBlock instr)
 116
 117 cleanBlockForward (BasicBlock blockId instrs)
 118  = do
 119         -- see if we have a valid association for the entry to this block
 120         jumpValid       <- gets sJumpValid
 121         let assoc       = case lookupUFM jumpValid blockId of
 122                                 Just assoc      -> assoc
 123                                 Nothing         -> emptyAssoc
 124
 125         instrs_reload   <- cleanForward    blockId assoc [] instrs
 126         return  $ BasicBlock blockId instrs_reload
 127
 128
 129 cleanBlockBackward
 130         :: Instruction instr
 131         => LiveBasicBlock instr
 132         -> CleanM (LiveBasicBlock instr)
 133
 134 cleanBlockBackward (BasicBlock blockId instrs)
 135  = do   instrs_spill    <- cleanBackward  emptyUniqSet  [] instrs
 136         return  $ BasicBlock blockId instrs_spill
 137
 138
 139
 140
 141 -- | Clean out unneeded reload instructions.
 142 --      Walking forwards across the code
 143 --        On a reload, if we know a reg already has the same value as a slot
 144 --        then we don't need to do the reload.
 145 --
 146 cleanForward
 147         :: Instruction instr
 148         => BlockId                      -- ^ the block that we're currently in
 149         -> Assoc Store                  -- ^ two store locations are associated if they have the same value
 150         -> [LiveInstr instr]            -- ^ acc
 151         -> [LiveInstr instr]            -- ^ instrs to clean (in backwards order)
 152         -> CleanM [LiveInstr instr]     -- ^ cleaned instrs  (in forward   order)
 153
 154 cleanForward _ _ acc []
 155         = return acc
 156
 157 -- write out live range joins via spill slots to just a spill and a reg-reg move
 158 --      hopefully the spill will be also be cleaned in the next pass
 159 --
 160 cleanForward blockId assoc acc (li1 : li2 : instrs)
 161
 162         | SPILL  reg1  slot1    <- li1
 163         , RELOAD slot2 reg2     <- li2
 164         , slot1 == slot2
 165         = do
 166                 modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
 167                 cleanForward blockId assoc acc
 168                         (li1 : Instr (mkRegRegMoveInstr reg1 reg2) Nothing : instrs)
 169
 170
 171 cleanForward blockId assoc acc (li@(Instr i1 _) : instrs)
 172         | Just (r1, r2) <- takeRegRegMoveInstr i1
 173         = if r1 == r2
 174                 -- erase any left over nop reg reg moves while we're here
 175                 --      this will also catch any nop moves that the "write out live range joins" case above
 176                 --      happens to add
 177                 then cleanForward blockId assoc acc instrs
 178
 179                 -- if r1 has the same value as some slots and we copy r1 to r2,
 180                 --      then r2 is now associated with those slots instead
 181                 else do let assoc'      = addAssoc (SReg r1) (SReg r2)
 182                                         $ delAssoc (SReg r2)
 183                                         $ assoc
 184
 185                         cleanForward blockId assoc' (li : acc) instrs
 186
 187
 188 cleanForward blockId assoc acc (li : instrs)
 189
 190         -- update association due to the spill
 191         | SPILL reg slot        <- li
 192         = let   assoc'  = addAssoc (SReg reg)  (SSlot slot)
 193                         $ delAssoc (SSlot slot)
 194                         $ assoc
 195           in    cleanForward blockId assoc' (li : acc) instrs
 196
 197         -- clean a reload instr
 198         | RELOAD{}              <- li
 199         = do    (assoc', mli)   <- cleanReload blockId assoc li
 200                 case mli of
 201                  Nothing        -> cleanForward blockId assoc' acc              instrs
 202                  Just li'       -> cleanForward blockId assoc' (li' : acc)      instrs
 203
 204         -- remember the association over a jump
 205         | Instr instr _         <- li
 206         , targets               <- jumpDestsOfInstr instr
 207         , not $ null targets
 208         = do    mapM_ (accJumpValid assoc) targets
 209                 cleanForward blockId assoc (li : acc) instrs
 210
 211         -- writing to a reg changes its value.
 212         | Instr instr _         <- li
 213         , RU _ written          <- regUsageOfInstr instr
 214         = let assoc'    = foldr delAssoc assoc (map SReg $ nub written)
 215           in  cleanForward blockId assoc' (li : acc) instrs
 216
 217 -- bogus, to stop pattern match warning
 218 cleanForward _ _ _ _
 219         = panic "RegAlloc.Graph.SpillClean.cleanForward: no match"
 220
 221
 222 -- | Try and rewrite a reload instruction to something more pleasing
 223 --
 224 cleanReload
 225         :: Instruction instr
 226         => BlockId
 227         -> Assoc Store
 228         -> LiveInstr instr
 229         -> CleanM (Assoc Store, Maybe (LiveInstr instr))
 230
 231 cleanReload blockId assoc li@(RELOAD slot reg)
 232
 233         -- if the reg we're reloading already has the same value as the slot
 234         --      then we can erase the instruction outright
 235         | elemAssoc (SSlot slot) (SReg reg) assoc
 236         = do    modify  $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
 237                 return  (assoc, Nothing)
 238
 239         -- if we can find another reg with the same value as this slot then
 240         --      do a move instead of a reload.
 241         | Just reg2     <- findRegOfSlot assoc slot
 242         = do    modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
 243
 244                 let assoc'      = addAssoc (SReg reg) (SReg reg2)
 245                                 $ delAssoc (SReg reg)
 246                                 $ assoc
 247
 248                 return  (assoc', Just $ Instr (mkRegRegMoveInstr reg2 reg) Nothing)
 249
 250         -- gotta keep this instr
 251         | otherwise
 252         = do    -- update the association
 253                 let assoc'      = addAssoc (SReg reg)  (SSlot slot)     -- doing the reload makes reg and slot the same value
 254                                 $ delAssoc (SReg reg)                   -- reg value changes on reload
 255                                 $ assoc
 256
 257                 -- remember that this block reloads from this slot
 258                 accBlockReloadsSlot blockId slot
 259
 260                 return  (assoc', Just li)
 261
 262 cleanReload _ _ _
 263         = panic "RegSpillClean.cleanReload: unhandled instr"
 264
 265
 266 -- | Clean out unneeded spill instructions.
 267 --
 268 --       If there were no reloads from a slot between a spill and the last one
 269 --       then the slot was never read and we don't need the spill.
 270 --
 271 --      SPILL   r0 -> s1
 272 --      RELOAD  s1 -> r2
 273 --      SPILL   r3 -> s1        <--- don't need this spill
 274 --      SPILL   r4 -> s1
 275 --      RELOAD  s1 -> r5
 276 --
 277 --      Maintain a set of
 278 --              "slots which were spilled to but not reloaded from yet"
 279 --
 280 --      Walking backwards across the code:
 281 --       a) On a reload from a slot, remove it from the set.
 282 --
 283 --       a) On a spill from a slot
 284 --              If the slot is in set then we can erase the spill,
 285 --                      because it won't be reloaded from until after the next spill.
 286 --
 287 --              otherwise
 288 --                      keep the spill and add the slot to the set
 289 --
 290 -- TODO: This is mostly inter-block
 291 --       we should really be updating the noReloads set as we cross jumps also.
 292 --
 293 cleanBackward
 294         :: UniqSet Int                  -- ^ slots that have been spilled, but not reloaded from
 295         -> [LiveInstr instr]            -- ^ acc
 296         -> [LiveInstr instr]            -- ^ instrs to clean (in forwards order)
 297         -> CleanM [LiveInstr instr]     -- ^ cleaned instrs  (in backwards order)
 298
 299
 300 cleanBackward noReloads acc lis
 301  = do   reloadedBy      <- gets sReloadedBy
 302         cleanBackward' reloadedBy noReloads acc lis
 303
 304 cleanBackward' _ _      acc []
 305         = return  acc
 306
 307 cleanBackward' reloadedBy noReloads acc (li : instrs)
 308
 309         -- if nothing ever reloads from this slot then we don't need the spill
 310         | SPILL _ slot  <- li
 311         , Nothing       <- lookupUFM reloadedBy (SSlot slot)
 312         = do    modify $ \s -> s { sCleanedSpillsAcc = sCleanedSpillsAcc s + 1 }
 313                 cleanBackward noReloads acc instrs
 314
 315         | SPILL _ slot  <- li
 316         = if elementOfUniqSet slot noReloads
 317
 318            -- we can erase this spill because the slot won't be read until after the next one
 319            then do
 320                 modify $ \s -> s { sCleanedSpillsAcc = sCleanedSpillsAcc s + 1 }
 321                 cleanBackward noReloads acc instrs
 322
 323            else do
 324                 -- this slot is being spilled to, but we haven't seen any reloads yet.
 325                 let noReloads'  = addOneToUniqSet noReloads slot
 326                 cleanBackward noReloads' (li : acc) instrs
 327
 328         -- if we reload from a slot then it's no longer unused
 329         | RELOAD slot _         <- li
 330         , noReloads'            <- delOneFromUniqSet noReloads slot
 331         = cleanBackward noReloads' (li : acc) instrs
 332
 333         -- some other instruction
 334         | otherwise
 335         = cleanBackward noReloads (li : acc) instrs
 336
 337
 338 -- collateJoinPoints:
 339 --
 340 -- | combine the associations from all the inward control flow edges.
 341 --
 342 collateJoinPoints :: CleanM ()
 343 collateJoinPoints
 344  = modify $ \s -> s
 345         { sJumpValid    = mapUFM intersects (sJumpValidAcc s)
 346         , sJumpValidAcc = emptyUFM }
 347
 348 intersects :: [Assoc Store]     -> Assoc Store
 349 intersects []           = emptyAssoc
 350 intersects assocs       = foldl1' intersectAssoc assocs
 351
 352
 353 -- | See if we have a reg with the same value as this slot in the association table.
 354 findRegOfSlot :: Assoc Store -> Int -> Maybe Reg
 355 findRegOfSlot assoc slot
 356         | close                 <- closeAssoc (SSlot slot) assoc
 357         , Just (SReg reg)       <- find isStoreReg $ uniqSetToList close
 358         = Just reg
 359
 360         | otherwise
 361         = Nothing
 362
 363
 364 ---------------
 365 type CleanM = State CleanS
 366 data CleanS
 367         = CleanS
 368         { -- regs which are valid at the start of each block.
 369           sJumpValid            :: UniqFM (Assoc Store)
 370
 371           -- collecting up what regs were valid across each jump.
 372           --    in the next pass we can collate these and write the results
 373           --    to sJumpValid.
 374         , sJumpValidAcc         :: UniqFM [Assoc Store]
 375
 376           -- map of (slot -> blocks which reload from this slot)
 377           --    used to decide if whether slot spilled to will ever be
 378           --    reloaded from on this path.
 379         , sReloadedBy           :: UniqFM [BlockId]
 380
 381           -- spills\/reloads cleaned each pass (latest at front)
 382         , sCleanedCount         :: [(Int, Int)]
 383
 384           -- spills\/reloads that have been cleaned in this pass so far.
 385         , sCleanedSpillsAcc     :: Int
 386         , sCleanedReloadsAcc    :: Int }
 387
 388 initCleanS :: CleanS
 389 initCleanS
 390         = CleanS
 391         { sJumpValid            = emptyUFM
 392         , sJumpValidAcc         = emptyUFM
 393
 394         , sReloadedBy           = emptyUFM
 395
 396         , sCleanedCount         = []
 397
 398         , sCleanedSpillsAcc     = 0
 399         , sCleanedReloadsAcc    = 0 }
 400
 401
 402 -- | Remember the associations before a jump
 403 accJumpValid :: Assoc Store -> BlockId -> CleanM ()
 404 accJumpValid assocs target
 405  = modify $ \s -> s {
 406         sJumpValidAcc = addToUFM_C (++)
 407                                 (sJumpValidAcc s)
 408                                 target
 409                                 [assocs] }
 410
 411
 412 accBlockReloadsSlot :: BlockId -> Slot -> CleanM ()
 413 accBlockReloadsSlot blockId slot
 414  = modify $ \s -> s {
 415         sReloadedBy = addToUFM_C (++)
 416                                 (sReloadedBy s)
 417                                 (SSlot slot)
 418                                 [blockId] }
 419
 420
 421 --------------
 422 -- A store location can be a stack slot or a register
 423 --
 424 data Store
 425         = SSlot Int
 426         | SReg  Reg
 427
 428 -- | Check if this is a reg store
 429 isStoreReg :: Store -> Bool
 430 isStoreReg ss
 431  = case ss of
 432         SSlot _ -> False
 433         SReg  _ -> True
 434
 435 -- spill cleaning is only done once all virtuals have been allocated to realRegs
 436 --
 437 instance Uniquable Store where
 438     getUnique (SReg  r)
 439         | RegReal (RealRegSingle i)     <- r
 440         = mkUnique 'R' i
 441
 442         | RegReal (RealRegPair r1 r2)   <- r
 443         = mkUnique 'P' (r1 * 65535 + r2)
 444
 445         | otherwise
 446         = error "RegSpillClean.getUnique: found virtual reg during spill clean, only real regs expected."
 447
 448     getUnique (SSlot i)                 = mkUnique 'S' i
 449
 450 instance Outputable Store where
 451         ppr (SSlot i)   = text "slot" <> int i
 452         ppr (SReg  r)   = ppr r
 453
 454
 455 --------------
 456 -- Association graphs.
 457 --      In the spill cleaner, two store locations are associated if they are known
 458 --      to hold the same value.
 459 --
 460 type Assoc a    = UniqFM (UniqSet a)
 461
 462 -- | an empty association
 463 emptyAssoc :: Assoc a
 464 emptyAssoc      = emptyUFM
 465
 466
 467 -- | add an association between these two things
 468 addAssoc :: Uniquable a
 469          => a -> a -> Assoc a -> Assoc a
 470
 471 addAssoc a b m
 472  = let  m1      = addToUFM_C unionUniqSets m  a (unitUniqSet b)
 473         m2      = addToUFM_C unionUniqSets m1 b (unitUniqSet a)
 474    in   m2
 475
 476
 477 -- | delete all associations to a node
 478 delAssoc :: (Outputable a, Uniquable a)
 479          => a -> Assoc a -> Assoc a
 480
 481 delAssoc a m
 482         | Just aSet     <- lookupUFM  m a
 483         , m1            <- delFromUFM m a
 484         = foldUniqSet (\x m -> delAssoc1 x a m) m1 aSet
 485
 486         | otherwise     = m
 487
 488
 489 -- | delete a single association edge (a -> b)
 490 delAssoc1 :: Uniquable a
 491         => a -> a -> Assoc a -> Assoc a
 492
 493 delAssoc1 a b m
 494         | Just aSet     <- lookupUFM m a
 495         = addToUFM m a (delOneFromUniqSet aSet b)
 496
 497         | otherwise     = m
 498
 499
 500 -- | check if these two things are associated
 501 elemAssoc :: (Outputable a, Uniquable a)
 502           => a -> a -> Assoc a -> Bool
 503
 504 elemAssoc a b m
 505         = elementOfUniqSet b (closeAssoc a m)
 506
 507 -- | find the refl. trans. closure of the association from this point
 508 closeAssoc :: (Outputable a, Uniquable a)
 509         => a -> Assoc a -> UniqSet a
 510
 511 closeAssoc a assoc
 512  =      closeAssoc' assoc emptyUniqSet (unitUniqSet a)
 513  where
 514         closeAssoc' assoc visited toVisit
 515          = case uniqSetToList toVisit of
 516
 517                 -- nothing else to visit, we're done
 518                 []      -> visited
 519
 520                 (x:_)
 521
 522                  -- we've already seen this node
 523                  |  elementOfUniqSet x visited
 524                  -> closeAssoc' assoc visited (delOneFromUniqSet toVisit x)
 525
 526                  -- haven't seen this node before,
 527                  --     remember to visit all its neighbors
 528                  |  otherwise
 529                  -> let neighbors
 530                          = case lookupUFM assoc x of
 531                                 Nothing         -> emptyUniqSet
 532                                 Just set        -> set
 533
 534                    in closeAssoc' assoc
 535                         (addOneToUniqSet visited x)
 536                         (unionUniqSets   toVisit neighbors)
 537
 538 -- | intersect
 539 intersectAssoc
 540         :: Uniquable a
 541         => Assoc a -> Assoc a -> Assoc a
 542
 543 intersectAssoc a b
 544         = intersectUFM_C (intersectUniqSets) a b
 545