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