compiler/nativeGen/RegAlloc/Linear/Main.hs

   1 {-# OPTIONS -fno-warn-missing-signatures #-}
   2 -----------------------------------------------------------------------------
   3 --
   4 -- The register allocator
   5 --
   6 -- (c) The University of Glasgow 2004
   7 --
   8 -----------------------------------------------------------------------------
   9
  10 {-
  11 The algorithm is roughly:
  12
  13   1) Compute strongly connected components of the basic block list.
  14
  15   2) Compute liveness (mapping from pseudo register to
  16      point(s) of death?).
  17
  18   3) Walk instructions in each basic block.  We keep track of
  19         (a) Free real registers (a bitmap?)
  20         (b) Current assignment of temporaries to machine registers and/or
  21             spill slots (call this the "assignment").
  22         (c) Partial mapping from basic block ids to a virt-to-loc mapping.
  23             When we first encounter a branch to a basic block,
  24             we fill in its entry in this table with the current mapping.
  25
  26      For each instruction:
  27         (a) For each real register clobbered by this instruction:
  28             If a temporary resides in it,
  29                 If the temporary is live after this instruction,
  30                     Move the temporary to another (non-clobbered & free) reg,
  31                     or spill it to memory.  Mark the temporary as residing
  32                     in both memory and a register if it was spilled (it might
  33                     need to be read by this instruction).
  34             (ToDo: this is wrong for jump instructions?)
  35
  36         (b) For each temporary *read* by the instruction:
  37             If the temporary does not have a real register allocation:
  38                 - Allocate a real register from the free list.  If
  39                   the list is empty:
  40                   - Find a temporary to spill.  Pick one that is
  41                     not used in this instruction (ToDo: not
  42                     used for a while...)
  43                   - generate a spill instruction
  44                 - If the temporary was previously spilled,
  45                   generate an instruction to read the temp from its spill loc.
  46             (optimisation: if we can see that a real register is going to
  47             be used soon, then don't use it for allocation).
  48
  49         (c) Update the current assignment
  50
  51         (d) If the intstruction is a branch:
  52               if the destination block already has a register assignment,
  53                 Generate a new block with fixup code and redirect the
  54                 jump to the new block.
  55               else,
  56                 Update the block id->assignment mapping with the current
  57                 assignment.
  58
  59         (e) Delete all register assignments for temps which are read
  60             (only) and die here.  Update the free register list.
  61
  62         (f) Mark all registers clobbered by this instruction as not free,
  63             and mark temporaries which have been spilled due to clobbering
  64             as in memory (step (a) marks then as in both mem & reg).
  65
  66         (g) For each temporary *written* by this instruction:
  67             Allocate a real register as for (b), spilling something
  68             else if necessary.
  69                 - except when updating the assignment, drop any memory
  70                   locations that the temporary was previously in, since
  71                   they will be no longer valid after this instruction.
  72
  73         (h) Delete all register assignments for temps which are
  74             written and die here (there should rarely be any).  Update
  75             the free register list.
  76
  77         (i) Rewrite the instruction with the new mapping.
  78
  79         (j) For each spilled reg known to be now dead, re-add its stack slot
  80             to the free list.
  81
  82 -}
  83
  84 module RegAlloc.Linear.Main (
  85         regAlloc,
  86         module  RegAlloc.Linear.Base,
  87         module  RegAlloc.Linear.Stats
  88   ) where
  89
  90 #include "HsVersions.h"
  91
  92
  93 import RegAlloc.Linear.State
  94 import RegAlloc.Linear.Base
  95 import RegAlloc.Linear.StackMap
  96 import RegAlloc.Linear.FreeRegs
  97 import RegAlloc.Linear.Stats
  98 import RegAlloc.Linear.JoinToTargets
  99 import TargetReg
 100 import RegAlloc.Liveness
 101 import Instruction
 102 import Reg
 103
 104 import BlockId
 105 import Cmm hiding (RegSet)
 106
 107 import Digraph
 108 import Unique
 109 import UniqSet
 110 import UniqFM
 111 import UniqSupply
 112 import Outputable
 113
 114 import Data.Maybe
 115 import Data.List
 116 import Control.Monad
 117
 118 #include "../includes/stg/MachRegs.h"
 119
 120
 121 -- -----------------------------------------------------------------------------
 122 -- Top level of the register allocator
 123
 124 -- Allocate registers
 125 regAlloc
 126         :: (Outputable instr, Instruction instr)
 127         => LiveCmmTop instr
 128         -> UniqSM (NatCmmTop instr, Maybe RegAllocStats)
 129
 130 regAlloc (CmmData sec d)
 131         = return
 132                 ( CmmData sec d
 133                 , Nothing )
 134
 135 regAlloc (CmmProc (LiveInfo info _ _) lbl params [])
 136         = return ( CmmProc info lbl params (ListGraph [])
 137                  , Nothing )
 138
 139 regAlloc (CmmProc static lbl params sccs)
 140         | LiveInfo info (Just first_id) (Just block_live)       <- static
 141         = do
 142                 -- do register allocation on each component.
 143                 (final_blocks, stats)
 144                         <- linearRegAlloc first_id block_live sccs
 145
 146                 -- make sure the block that was first in the input list
 147                 --      stays at the front of the output
 148                 let ((first':_), rest')
 149                                 = partition ((== first_id) . blockId) final_blocks
 150
 151                 return  ( CmmProc info lbl params (ListGraph (first' : rest'))
 152                         , Just stats)
 153
 154 -- bogus. to make non-exhaustive match warning go away.
 155 regAlloc (CmmProc _ _ _ _)
 156         = panic "RegAllocLinear.regAlloc: no match"
 157
 158
 159 -- -----------------------------------------------------------------------------
 160 -- Linear sweep to allocate registers
 161
 162
 163 -- | Do register allocation on some basic blocks.
 164 --   But be careful to allocate a block in an SCC only if it has
 165 --   an entry in the block map or it is the first block.
 166 --
 167 linearRegAlloc
 168         :: (Outputable instr, Instruction instr)
 169         => BlockId                      -- ^ the first block
 170         -> BlockMap RegSet              -- ^ live regs on entry to each basic block
 171         -> [SCC (LiveBasicBlock instr)] -- ^ instructions annotated with "deaths"
 172         -> UniqSM ([NatBasicBlock instr], RegAllocStats)
 173
 174 linearRegAlloc first_id block_live sccs
 175  = do   us      <- getUs
 176         let (_, _, stats, blocks) =
 177                 runR emptyBlockMap initFreeRegs emptyRegMap emptyStackMap us
 178                         $ linearRA_SCCs first_id block_live [] sccs
 179
 180         return  (blocks, stats)
 181
 182 linearRA_SCCs _ _ blocksAcc []
 183         = return $ reverse blocksAcc
 184
 185 linearRA_SCCs first_id block_live blocksAcc (AcyclicSCC block : sccs)
 186  = do   blocks' <- processBlock block_live block
 187         linearRA_SCCs first_id block_live
 188                 ((reverse blocks') ++ blocksAcc)
 189                 sccs
 190
 191 linearRA_SCCs first_id block_live blocksAcc (CyclicSCC blocks : sccs)
 192  = do
 193         blockss' <- process first_id block_live blocks [] (return []) False
 194         linearRA_SCCs first_id block_live
 195                 (reverse (concat blockss') ++ blocksAcc)
 196                 sccs
 197
 198 {- from John Dias's patch 2008/10/16:
 199    The linear-scan allocator sometimes allocates a block
 200    before allocating one of its predecessors, which could lead to
 201    inconsistent allocations. Make it so a block is only allocated
 202    if a predecessor has set the "incoming" assignments for the block, or
 203    if it's the procedure's entry block.
 204
 205    BL 2009/02: Careful. If the assignment for a block doesn't get set for
 206    some reason then this function will loop. We should probably do some
 207    more sanity checking to guard against this eventuality.
 208 -}
 209
 210 process _ _ [] []         accum _
 211         = return $ reverse accum
 212
 213 process first_id block_live [] next_round accum madeProgress
 214         | not madeProgress
 215         = pprPanic "RegAlloc.Linear.Main.process: no progress made, bailing out"
 216                 (  text "stalled blocks:"
 217                 $$ vcat (map ppr next_round))
 218
 219         | otherwise
 220         = process first_id block_live
 221                   next_round [] accum False
 222
 223 process first_id block_live (b@(BasicBlock id _) : blocks)
 224         next_round accum madeProgress
 225  = do
 226         block_assig <- getBlockAssigR
 227
 228         if isJust (lookupBlockEnv block_assig id)
 229              || id == first_id
 230          then do
 231                 b'  <- processBlock block_live b
 232                 process first_id block_live blocks
 233                         next_round (b' : accum) True
 234
 235          else   process first_id block_live blocks
 236                         (b : next_round) accum madeProgress
 237
 238
 239 -- | Do register allocation on this basic block
 240 --
 241 processBlock
 242         :: (Outputable instr, Instruction instr)
 243         => BlockMap RegSet              -- ^ live regs on entry to each basic block
 244         -> LiveBasicBlock instr         -- ^ block to do register allocation on
 245         -> RegM [NatBasicBlock instr]   -- ^ block with registers allocated
 246
 247 processBlock block_live (BasicBlock id instrs)
 248  = do   initBlock id
 249         (instrs', fixups)
 250                 <- linearRA block_live [] [] id instrs
 251         return  $ BasicBlock id instrs' : fixups
 252
 253
 254 -- | Load the freeregs and current reg assignment into the RegM state
 255 --      for the basic block with this BlockId.
 256 initBlock :: BlockId -> RegM ()
 257 initBlock id
 258  = do   block_assig     <- getBlockAssigR
 259         case lookupBlockEnv block_assig id of
 260                 -- no prior info about this block: assume everything is
 261                 -- free and the assignment is empty.
 262                 Nothing
 263                  -> do  -- pprTrace "initFreeRegs" (text $ show initFreeRegs) (return ())
 264
 265                         setFreeRegsR    initFreeRegs
 266                         setAssigR       emptyRegMap
 267
 268                 -- load info about register assignments leading into this block.
 269                 Just (freeregs, assig)
 270                  -> do  setFreeRegsR    freeregs
 271                         setAssigR       assig
 272
 273
 274 -- | Do allocation for a sequence of instructions.
 275 linearRA
 276         :: (Outputable instr, Instruction instr)
 277         => BlockMap RegSet                      -- ^ map of what vregs are live on entry to each block.
 278         -> [instr]                              -- ^ accumulator for instructions already processed.
 279         -> [NatBasicBlock instr]                -- ^ accumulator for blocks of fixup code.
 280         -> BlockId                              -- ^ id of the current block, for debugging.
 281         -> [LiveInstr instr]                    -- ^ liveness annotated instructions in this block.
 282
 283         -> RegM ( [instr]                       --   instructions after register allocation
 284                 , [NatBasicBlock instr])        --   fresh blocks of fixup code.
 285
 286
 287 linearRA _          accInstr accFixup _ []
 288         = return
 289                 ( reverse accInstr              -- instrs need to be returned in the correct order.
 290                 , accFixup)                     -- it doesn't matter what order the fixup blocks are returned in.
 291
 292
 293 linearRA block_live accInstr accFixups id (instr:instrs)
 294  = do
 295         (accInstr', new_fixups)
 296                 <- raInsn block_live accInstr id instr
 297
 298         linearRA block_live accInstr' (new_fixups ++ accFixups) id instrs
 299
 300
 301 -- | Do allocation for a single instruction.
 302 raInsn
 303         :: (Outputable instr, Instruction instr)
 304         => BlockMap RegSet                      -- ^ map of what vregs are love on entry to each block.
 305         -> [instr]                              -- ^ accumulator for instructions already processed.
 306         -> BlockId                              -- ^ the id of the current block, for debugging
 307         -> LiveInstr instr                      -- ^ the instr to have its regs allocated, with liveness info.
 308         -> RegM
 309                 ( [instr]                       -- new instructions
 310                 , [NatBasicBlock instr])        -- extra fixup blocks
 311
 312 raInsn _     new_instrs _ (Instr ii Nothing)
 313         | Just n        <- takeDeltaInstr ii
 314         = do    setDeltaR n
 315                 return (new_instrs, [])
 316
 317 raInsn _     new_instrs _ (Instr ii Nothing)
 318         | isMetaInstr ii
 319         = return (new_instrs, [])
 320
 321
 322 raInsn block_live new_instrs id (Instr instr (Just live))
 323  = do
 324     assig    <- getAssigR
 325
 326     -- If we have a reg->reg move between virtual registers, where the
 327     -- src register is not live after this instruction, and the dst
 328     -- register does not already have an assignment,
 329     -- and the source register is assigned to a register, not to a spill slot,
 330     -- then we can eliminate the instruction.
 331     -- (we can't eliminitate it if the source register is on the stack, because
 332     --  we do not want to use one spill slot for different virtual registers)
 333     case takeRegRegMoveInstr instr of
 334         Just (src,dst)  | src `elementOfUniqSet` (liveDieRead live),
 335                           isVirtualReg dst,
 336                           not (dst `elemUFM` assig),
 337                           Just (InReg _) <- (lookupUFM assig src) -> do
 338            case src of
 339               (RegReal rr) -> setAssigR (addToUFM assig dst (InReg rr))
 340                 -- if src is a fixed reg, then we just map dest to this
 341                 -- reg in the assignment.  src must be an allocatable reg,
 342                 -- otherwise it wouldn't be in r_dying.
 343               _virt -> case lookupUFM assig src of
 344                          Nothing -> panic "raInsn"
 345                          Just loc ->
 346                            setAssigR (addToUFM (delFromUFM assig src) dst loc)
 347
 348            -- we have eliminated this instruction
 349           {-
 350           freeregs <- getFreeRegsR
 351           assig <- getAssigR
 352           pprTrace "raInsn" (text "ELIMINATED: " <> docToSDoc (pprInstr instr)
 353                         $$ ppr r_dying <+> ppr w_dying $$ text (show freeregs) $$ ppr assig) $ do
 354           -}
 355            return (new_instrs, [])
 356
 357         _ -> genRaInsn block_live new_instrs id instr
 358                         (uniqSetToList $ liveDieRead live)
 359                         (uniqSetToList $ liveDieWrite live)
 360
 361
 362 raInsn _ _ _ instr
 363         = pprPanic "raInsn" (text "no match for:" <> ppr instr)
 364
 365
 366
 367
 368 genRaInsn block_live new_instrs block_id instr r_dying w_dying =
 369     case regUsageOfInstr instr              of { RU read written ->
 370     do
 371     let real_written    = [ rr  | (RegReal     rr) <- written ]
 372     let virt_written    = [ vr  | (RegVirtual  vr) <- written ]
 373
 374     -- we don't need to do anything with real registers that are
 375     -- only read by this instr.  (the list is typically ~2 elements,
 376     -- so using nub isn't a problem).
 377     let virt_read       = nub [ vr      | (RegVirtual vr) <- read ]
 378
 379     -- (a) save any temporaries which will be clobbered by this instruction
 380     clobber_saves       <- saveClobberedTemps real_written r_dying
 381
 382     -- debugging
 383 {-  freeregs <- getFreeRegsR
 384     assig    <- getAssigR
 385     pprTrace "genRaInsn"
 386         (ppr instr
 387                 $$ text "r_dying      = " <+> ppr r_dying
 388                 $$ text "w_dying      = " <+> ppr w_dying
 389                 $$ text "virt_read    = " <+> ppr virt_read
 390                 $$ text "virt_written = " <+> ppr virt_written
 391                 $$ text "freeregs     = " <+> text (show freeregs)
 392                 $$ text "assig        = " <+> ppr assig)
 393         $ do
 394 -}
 395
 396     -- (b), (c) allocate real regs for all regs read by this instruction.
 397     (r_spills, r_allocd) <-
 398         allocateRegsAndSpill True{-reading-} virt_read [] [] virt_read
 399
 400     -- (d) Update block map for new destinations
 401     -- NB. do this before removing dead regs from the assignment, because
 402     -- these dead regs might in fact be live in the jump targets (they're
 403     -- only dead in the code that follows in the current basic block).
 404     (fixup_blocks, adjusted_instr)
 405         <- joinToTargets block_live block_id instr
 406
 407     -- (e) Delete all register assignments for temps which are read
 408     --     (only) and die here.  Update the free register list.
 409     releaseRegs r_dying
 410
 411     -- (f) Mark regs which are clobbered as unallocatable
 412     clobberRegs real_written
 413
 414     -- (g) Allocate registers for temporaries *written* (only)
 415     (w_spills, w_allocd) <-
 416         allocateRegsAndSpill False{-writing-} virt_written [] [] virt_written
 417
 418     -- (h) Release registers for temps which are written here and not
 419     -- used again.
 420     releaseRegs w_dying
 421
 422     let
 423         -- (i) Patch the instruction
 424         patch_map
 425                 = listToUFM
 426                         [ (t, RegReal r)
 427                                 | (t, r) <- zip virt_read    r_allocd
 428                                          ++ zip virt_written w_allocd ]
 429
 430         patched_instr
 431                 = patchRegsOfInstr adjusted_instr patchLookup
 432
 433         patchLookup x
 434                 = case lookupUFM patch_map x of
 435                         Nothing -> x
 436                         Just y  -> y
 437
 438
 439     -- (j) free up stack slots for dead spilled regs
 440     -- TODO (can't be bothered right now)
 441
 442     -- erase reg->reg moves where the source and destination are the same.
 443     --  If the src temp didn't die in this instr but happened to be allocated
 444     --  to the same real reg as the destination, then we can erase the move anyway.
 445     let squashed_instr  = case takeRegRegMoveInstr patched_instr of
 446                                 Just (src, dst)
 447                                  | src == dst   -> []
 448                                 _               -> [patched_instr]
 449
 450     let code = squashed_instr ++ w_spills ++ reverse r_spills
 451                 ++ clobber_saves ++ new_instrs
 452
 453 --    pprTrace "patched-code" ((vcat $ map (docToSDoc . pprInstr) code)) $ do
 454 --    pprTrace "pached-fixup" ((ppr fixup_blocks)) $ do
 455
 456     return (code, fixup_blocks)
 457
 458   }
 459
 460 -- -----------------------------------------------------------------------------
 461 -- releaseRegs
 462
 463 releaseRegs regs = do
 464   assig <- getAssigR
 465   free <- getFreeRegsR
 466   loop assig free regs
 467  where
 468   loop _     free _ | free `seq` False = undefined
 469   loop assig free [] = do setAssigR assig; setFreeRegsR free; return ()
 470   loop assig free (RegReal rr : rs) = loop assig (releaseReg rr free) rs
 471   loop assig free (r:rs) =
 472      case lookupUFM assig r of
 473         Just (InBoth real _) -> loop (delFromUFM assig r) (releaseReg real free) rs
 474         Just (InReg real) -> loop (delFromUFM assig r) (releaseReg real free) rs
 475         _other            -> loop (delFromUFM assig r) free rs
 476
 477
 478 -- -----------------------------------------------------------------------------
 479 -- Clobber real registers
 480
 481 -- For each temp in a register that is going to be clobbered:
 482 --      - if the temp dies after this instruction, do nothing
 483 --      - otherwise, put it somewhere safe (another reg if possible,
 484 --              otherwise spill and record InBoth in the assignment).
 485 --      - for allocateRegs on the temps *read*,
 486 --      - clobbered regs are allocatable.
 487 --
 488 --      for allocateRegs on the temps *written*,
 489 --        - clobbered regs are not allocatable.
 490 --
 491 --      TODO:   instead of spilling, try to copy clobbered
 492 --              temps to another register if possible.
 493 --
 494
 495
 496 saveClobberedTemps
 497         :: Instruction instr
 498         => [RealReg]            -- real registers clobbered by this instruction
 499         -> [Reg]                -- registers which are no longer live after this insn
 500         -> RegM [instr]         -- return: instructions to spill any temps that will
 501                                 -- be clobbered.
 502
 503 saveClobberedTemps [] _
 504         = return []
 505
 506 saveClobberedTemps clobbered dying
 507  = do
 508         assig   <- getAssigR
 509         let to_spill
 510                 = [ (temp,reg)
 511                         | (temp, InReg reg) <- ufmToList assig
 512                         , any (realRegsAlias reg) clobbered
 513                         , temp `notElem` map getUnique dying  ]
 514
 515         (instrs,assig') <- clobber assig [] to_spill
 516         setAssigR assig'
 517         return instrs
 518
 519    where
 520         clobber assig instrs []
 521                 = return (instrs, assig)
 522
 523         clobber assig instrs ((temp, reg) : rest)
 524          = do
 525                 (spill, slot)   <- spillR (RegReal reg) temp
 526
 527                 -- record why this reg was spilled for profiling
 528                 recordSpill (SpillClobber temp)
 529
 530                 let new_assign  = addToUFM assig temp (InBoth reg slot)
 531
 532                 clobber new_assign (spill : instrs) rest
 533
 534
 535
 536 -- | Mark all these regal regs as allocated,
 537 --      and kick out their vreg assignments.
 538 --
 539 clobberRegs :: [RealReg] -> RegM ()
 540 clobberRegs []
 541         = return ()
 542
 543 clobberRegs clobbered
 544  = do
 545         freeregs        <- getFreeRegsR
 546         setFreeRegsR $! foldr allocateReg freeregs clobbered
 547
 548         assig           <- getAssigR
 549         setAssigR $! clobber assig (ufmToList assig)
 550
 551    where
 552         -- if the temp was InReg and clobbered, then we will have
 553         -- saved it in saveClobberedTemps above.  So the only case
 554         -- we have to worry about here is InBoth.  Note that this
 555         -- also catches temps which were loaded up during allocation
 556         -- of read registers, not just those saved in saveClobberedTemps.
 557
 558         clobber assig []
 559                 = assig
 560
 561         clobber assig ((temp, InBoth reg slot) : rest)
 562                 | any (realRegsAlias reg) clobbered
 563                 = clobber (addToUFM assig temp (InMem slot)) rest
 564
 565         clobber assig (_:rest)
 566                 = clobber assig rest
 567
 568 -- -----------------------------------------------------------------------------
 569 -- allocateRegsAndSpill
 570
 571 -- This function does several things:
 572 --   For each temporary referred to by this instruction,
 573 --   we allocate a real register (spilling another temporary if necessary).
 574 --   We load the temporary up from memory if necessary.
 575 --   We also update the register assignment in the process, and
 576 --   the list of free registers and free stack slots.
 577
 578 allocateRegsAndSpill
 579         :: Instruction instr
 580         => Bool                 -- True <=> reading (load up spilled regs)
 581         -> [VirtualReg]         -- don't push these out
 582         -> [instr]              -- spill insns
 583         -> [RealReg]            -- real registers allocated (accum.)
 584         -> [VirtualReg]         -- temps to allocate
 585         -> RegM ( [instr]
 586                 , [RealReg])
 587
 588 allocateRegsAndSpill _       _    spills alloc []
 589         = return (spills, reverse alloc)
 590
 591 allocateRegsAndSpill reading keep spills alloc (r:rs)
 592  = do   assig <- getAssigR
 593         case lookupUFM assig r of
 594                 -- case (1a): already in a register
 595                 Just (InReg my_reg) ->
 596                         allocateRegsAndSpill reading keep spills (my_reg:alloc) rs
 597
 598                 -- case (1b): already in a register (and memory)
 599                 -- NB1. if we're writing this register, update its assignemnt to be
 600                 -- InReg, because the memory value is no longer valid.
 601                 -- NB2. This is why we must process written registers here, even if they
 602                 -- are also read by the same instruction.
 603                 Just (InBoth my_reg _)
 604                  -> do  when (not reading) (setAssigR (addToUFM assig r (InReg my_reg)))
 605                         allocateRegsAndSpill reading keep spills (my_reg:alloc) rs
 606
 607                 -- Not already in a register, so we need to find a free one...
 608                 loc -> allocRegsAndSpill_spill reading keep spills alloc r rs loc assig
 609
 610
 611 allocRegsAndSpill_spill reading keep spills alloc r rs loc assig
 612  = do
 613         freeRegs                <- getFreeRegsR
 614         let freeRegs_thisClass  = getFreeRegs (classOfVirtualReg r) freeRegs
 615
 616         case freeRegs_thisClass of
 617
 618          -- case (2): we have a free register
 619          (my_reg : _) ->
 620            do   spills'   <- loadTemp reading r loc my_reg spills
 621
 622                 let new_loc
 623                         -- if the tmp was in a slot, then now its in a reg as well
 624                         | Just (InMem slot) <- loc
 625                         , reading
 626                         = InBoth my_reg slot
 627
 628                         -- tmp has been loaded into a reg
 629                         | otherwise
 630                         = InReg my_reg
 631
 632                 setAssigR       (addToUFM assig r $! new_loc)
 633                 setFreeRegsR $  allocateReg my_reg freeRegs
 634
 635                 allocateRegsAndSpill reading keep spills' (my_reg : alloc) rs
 636
 637
 638           -- case (3): we need to push something out to free up a register
 639          [] ->
 640            do   let keep' = map getUnique keep
 641
 642                 -- the vregs we could kick out that are already in a slot
 643                 let candidates_inBoth
 644                         = [ (temp, reg, mem)
 645                                 | (temp, InBoth reg mem) <- ufmToList assig
 646                                 , temp `notElem` keep'
 647                                 , targetClassOfRealReg reg == classOfVirtualReg r ]
 648
 649                 -- the vregs we could kick out that are only in a reg
 650                 --      this would require writing the reg to a new slot before using it.
 651                 let candidates_inReg
 652                         = [ (temp, reg)
 653                                 | (temp, InReg reg)     <- ufmToList assig
 654                                 , temp `notElem` keep'
 655                                 , targetClassOfRealReg reg == classOfVirtualReg r ]
 656
 657                 let result
 658
 659                         -- we have a temporary that is in both register and mem,
 660                         -- just free up its register for use.
 661                         | (temp, my_reg, slot) : _      <- candidates_inBoth
 662                         = do    spills' <- loadTemp reading r loc my_reg spills
 663                                 let assig1  = addToUFM assig temp (InMem slot)
 664                                 let assig2  = addToUFM assig1 r   (InReg my_reg)
 665
 666                                 setAssigR assig2
 667                                 allocateRegsAndSpill reading keep spills' (my_reg:alloc) rs
 668
 669                         -- otherwise, we need to spill a temporary that currently
 670                         -- resides in a register.
 671                         | (temp_to_push_out, (my_reg :: RealReg)) : _
 672                                         <- candidates_inReg
 673                         = do
 674                                 (spill_insn, slot) <- spillR (RegReal my_reg) temp_to_push_out
 675                                 let spill_store  = (if reading then id else reverse)
 676                                                         [ -- COMMENT (fsLit "spill alloc")
 677                                                            spill_insn ]
 678
 679                                 -- record that this temp was spilled
 680                                 recordSpill (SpillAlloc temp_to_push_out)
 681
 682                                 -- update the register assignment
 683                                 let assig1  = addToUFM assig temp_to_push_out   (InMem slot)
 684                                 let assig2  = addToUFM assig1 r                 (InReg my_reg)
 685                                 setAssigR assig2
 686
 687                                 -- if need be, load up a spilled temp into the reg we've just freed up.
 688                                 spills' <- loadTemp reading r loc my_reg spills
 689
 690                                 allocateRegsAndSpill reading keep
 691                                         (spill_store ++ spills')
 692                                         (my_reg:alloc) rs
 693
 694
 695                         -- there wasn't anything to spill, so we're screwed.
 696                         | otherwise
 697                         = pprPanic ("RegAllocLinear.allocRegsAndSpill: no spill candidates\n")
 698                         $ vcat
 699                                 [ text "allocating vreg:  " <> text (show r)
 700                                 , text "assignment:       " <> text (show $ ufmToList assig)
 701                                 , text "freeRegs:         " <> text (show freeRegs)
 702                                 , text "initFreeRegs:     " <> text (show initFreeRegs) ]
 703
 704                 result
 705
 706
 707 -- | Load up a spilled temporary if we need to.
 708 loadTemp
 709         :: Instruction instr
 710         => Bool
 711         -> VirtualReg   -- the temp being loaded
 712         -> Maybe Loc    -- the current location of this temp
 713         -> RealReg      -- the hreg to load the temp into
 714         -> [instr]
 715         -> RegM [instr]
 716
 717 loadTemp True vreg (Just (InMem slot)) hreg spills
 718  = do
 719         insn <- loadR (RegReal hreg) slot
 720         recordSpill (SpillLoad $ getUnique vreg)
 721         return  $  {- COMMENT (fsLit "spill load") : -} insn : spills
 722
 723 loadTemp _ _ _ _ spills =
 724    return spills
 725