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 RegAlloc.Liveness
 100
 101 -- import PprMach
 102
 103 import BlockId
 104 import Regs
 105 import Instrs
 106 import RegAllocInfo
 107 import Cmm hiding (RegSet)
 108
 109 import Digraph
 110 import Unique
 111 import UniqSet
 112 import UniqFM
 113 import UniqSupply
 114 import Outputable
 115 import FastString
 116
 117 import Data.Maybe
 118 import Data.List
 119 import Control.Monad
 120
 121 #include "../includes/MachRegs.h"
 122
 123
 124 -- -----------------------------------------------------------------------------
 125 -- Top level of the register allocator
 126
 127 -- Allocate registers
 128 regAlloc
 129         :: LiveCmmTop
 130         -> UniqSM (NatCmmTop, Maybe RegAllocStats)
 131
 132 regAlloc (CmmData sec d)
 133         = return
 134                 ( CmmData sec d
 135                 , Nothing )
 136
 137 regAlloc (CmmProc (LiveInfo info _ _) lbl params (ListGraph []))
 138         = return ( CmmProc info lbl params (ListGraph [])
 139                  , Nothing )
 140
 141 regAlloc (CmmProc static lbl params (ListGraph comps))
 142         | LiveInfo info (Just first_id) block_live      <- static
 143         = do
 144                 -- do register allocation on each component.
 145                 (final_blocks, stats)
 146                         <- linearRegAlloc first_id block_live
 147                         $ map (\b -> case b of
 148                                         BasicBlock _ [b]        -> AcyclicSCC b
 149                                         BasicBlock _ bs         -> CyclicSCC  bs)
 150                         $ comps
 151
 152                 -- make sure the block that was first in the input list
 153                 --      stays at the front of the output
 154                 let ((first':_), rest')
 155                                 = partition ((== first_id) . blockId) final_blocks
 156
 157                 return  ( CmmProc info lbl params (ListGraph (first' : rest'))
 158                         , Just stats)
 159
 160 -- bogus. to make non-exhaustive match warning go away.
 161 regAlloc (CmmProc _ _ _ _)
 162         = panic "RegAllocLinear.regAlloc: no match"
 163
 164
 165 -- -----------------------------------------------------------------------------
 166 -- Linear sweep to allocate registers
 167
 168
 169 -- | Do register allocation on some basic blocks.
 170 --   But be careful to allocate a block in an SCC only if it has
 171 --   an entry in the block map or it is the first block.
 172 --
 173 linearRegAlloc
 174         :: BlockId                      -- ^ the first block
 175         -> BlockMap RegSet              -- ^ live regs on entry to each basic block
 176         -> [SCC LiveBasicBlock]         -- ^ instructions annotated with "deaths"
 177         -> UniqSM ([NatBasicBlock], RegAllocStats)
 178
 179 linearRegAlloc first_id block_live sccs
 180  = do   us      <- getUs
 181         let (_, _, stats, blocks) =
 182                 runR emptyBlockMap initFreeRegs emptyRegMap emptyStackMap us
 183                         $ linearRA_SCCs first_id block_live [] sccs
 184
 185         return  (blocks, stats)
 186
 187 linearRA_SCCs _ _ blocksAcc []
 188         = return $ reverse blocksAcc
 189
 190 linearRA_SCCs first_id block_live blocksAcc (AcyclicSCC block : sccs)
 191  = do   blocks' <- processBlock block_live block
 192         linearRA_SCCs first_id block_live
 193                 ((reverse blocks') ++ blocksAcc)
 194                 sccs
 195
 196 linearRA_SCCs first_id block_live blocksAcc (CyclicSCC blocks : sccs)
 197  = do
 198         blockss' <- process first_id block_live blocks [] (return [])
 199         linearRA_SCCs first_id block_live
 200                 (reverse (concat blockss') ++ blocksAcc)
 201                 sccs
 202
 203 {- from John Dias's patch 2008/10/16:
 204    The linear-scan allocator sometimes allocates a block
 205    before allocating one of its predecessors, which could lead to
 206    inconsistent allocations. Make it so a block is only allocated
 207    if a predecessor has set the "incoming" assignments for the block, or
 208    if it's the procedure's entry block.
 209
 210    BL 2009/02: Careful. If the assignment for a block doesn't get set for
 211    some reason then this function will loop. We should probably do some
 212    more sanity checking to guard against this eventuality.
 213 -}
 214
 215 process _ _ [] []         accum
 216         = return $ reverse accum
 217
 218 process first_id block_live [] next_round accum
 219         = process first_id block_live next_round [] accum
 220
 221 process first_id block_live (b@(BasicBlock id _) : blocks) next_round accum
 222  = do
 223         block_assig <- getBlockAssigR
 224
 225         if isJust (lookupBlockEnv block_assig id)
 226              || id == first_id
 227          then do
 228                 b'  <- processBlock block_live b
 229                 process first_id block_live blocks next_round (b' : accum)
 230
 231          else   process first_id block_live blocks (b : next_round) accum
 232
 233
 234 -- | Do register allocation on this basic block
 235 --
 236 processBlock
 237         :: BlockMap RegSet              -- ^ live regs on entry to each basic block
 238         -> LiveBasicBlock               -- ^ block to do register allocation on
 239         -> RegM [NatBasicBlock]         -- ^ block with registers allocated
 240
 241 processBlock block_live (BasicBlock id instrs)
 242  = do   initBlock id
 243         (instrs', fixups)
 244                 <- linearRA block_live [] [] id instrs
 245         return  $ BasicBlock id instrs' : fixups
 246
 247
 248 -- | Load the freeregs and current reg assignment into the RegM state
 249 --      for the basic block with this BlockId.
 250 initBlock :: BlockId -> RegM ()
 251 initBlock id
 252  = do   block_assig     <- getBlockAssigR
 253         case lookupBlockEnv block_assig id of
 254                 -- no prior info about this block: assume everything is
 255                 -- free and the assignment is empty.
 256                 Nothing
 257                  -> do  setFreeRegsR    initFreeRegs
 258                         setAssigR       emptyRegMap
 259
 260                 -- load info about register assignments leading into this block.
 261                 Just (freeregs, assig)
 262                  -> do  setFreeRegsR    freeregs
 263                         setAssigR       assig
 264
 265
 266 -- | Do allocation for a sequence of instructions.
 267 linearRA
 268         :: BlockMap RegSet              -- ^ map of what vregs are live on entry to each block.
 269         -> [Instr]                      -- ^ accumulator for instructions already processed.
 270         -> [NatBasicBlock]              -- ^ accumulator for blocks of fixup code.
 271         -> BlockId                      -- ^ id of the current block, for debugging.
 272         -> [LiveInstr]                  -- ^ liveness annotated instructions in this block.
 273
 274         -> RegM ( [Instr]               --   instructions after register allocation
 275                 , [NatBasicBlock])      --   fresh blocks of fixup code.
 276
 277
 278 linearRA _          accInstr accFixup _ []
 279         = return
 280                 ( reverse accInstr      -- instrs need to be returned in the correct order.
 281                 , accFixup)             -- it doesn't matter what order the fixup blocks are returned in.
 282
 283
 284 linearRA block_live accInstr accFixups id (instr:instrs)
 285  = do
 286         (accInstr', new_fixups)
 287                 <- raInsn block_live accInstr id instr
 288
 289         linearRA block_live accInstr' (new_fixups ++ accFixups) id instrs
 290
 291
 292 -- | Do allocation for a single instruction.
 293 raInsn
 294         :: BlockMap RegSet              -- ^ map of what vregs are love on entry to each block.
 295         -> [Instr]                      -- ^ accumulator for instructions already processed.
 296         -> BlockId                      -- ^ the id of the current block, for debugging
 297         -> LiveInstr                    -- ^ the instr to have its regs allocated, with liveness info.
 298         -> RegM
 299                 ( [Instr]               -- new instructions
 300                 , [NatBasicBlock])      -- extra fixup blocks
 301
 302 raInsn _     new_instrs _ (Instr (COMMENT _) Nothing)
 303  = return (new_instrs, [])
 304
 305 raInsn _     new_instrs _ (Instr (DELTA n) Nothing)
 306  = do
 307     setDeltaR n
 308     return (new_instrs, [])
 309
 310 raInsn block_live new_instrs id (Instr instr (Just live))
 311  = do
 312     assig    <- getAssigR
 313
 314     -- If we have a reg->reg move between virtual registers, where the
 315     -- src register is not live after this instruction, and the dst
 316     -- register does not already have an assignment,
 317     -- and the source register is assigned to a register, not to a spill slot,
 318     -- then we can eliminate the instruction.
 319     -- (we can't eliminitate it if the source register is on the stack, because
 320     --  we do not want to use one spill slot for different virtual registers)
 321     case isRegRegMove instr of
 322         Just (src,dst)  | src `elementOfUniqSet` (liveDieRead live),
 323                           isVirtualReg dst,
 324                           not (dst `elemUFM` assig),
 325                           Just (InReg _) <- (lookupUFM assig src) -> do
 326            case src of
 327               RealReg i -> setAssigR (addToUFM assig dst (InReg i))
 328                 -- if src is a fixed reg, then we just map dest to this
 329                 -- reg in the assignment.  src must be an allocatable reg,
 330                 -- otherwise it wouldn't be in r_dying.
 331               _virt -> case lookupUFM assig src of
 332                          Nothing -> panic "raInsn"
 333                          Just loc ->
 334                            setAssigR (addToUFM (delFromUFM assig src) dst loc)
 335
 336            -- we have eliminated this instruction
 337           {-
 338           freeregs <- getFreeRegsR
 339           assig <- getAssigR
 340           pprTrace "raInsn" (text "ELIMINATED: " <> docToSDoc (pprInstr instr)
 341                         $$ ppr r_dying <+> ppr w_dying $$ text (show freeregs) $$ ppr assig) $ do
 342           -}
 343            return (new_instrs, [])
 344
 345         _ -> genRaInsn block_live new_instrs id instr
 346                         (uniqSetToList $ liveDieRead live)
 347                         (uniqSetToList $ liveDieWrite live)
 348
 349
 350 raInsn _ _ _ instr
 351         = pprPanic "raInsn" (text "no match for:" <> ppr instr)
 352
 353
 354
 355
 356 genRaInsn block_live new_instrs block_id instr r_dying w_dying =
 357     case regUsage instr              of { RU read written ->
 358     case partition isRealReg written of { (real_written1,virt_written) ->
 359     do
 360     let
 361         real_written = [ r | RealReg r <- real_written1 ]
 362
 363         -- we don't need to do anything with real registers that are
 364         -- only read by this instr.  (the list is typically ~2 elements,
 365         -- so using nub isn't a problem).
 366         virt_read = nub (filter isVirtualReg read)
 367     -- in
 368
 369     -- (a) save any temporaries which will be clobbered by this instruction
 370     clobber_saves <- saveClobberedTemps real_written r_dying
 371
 372
 373 {-    freeregs <- getFreeRegsR
 374     assig    <- getAssigR
 375     pprTrace "genRaInsn"
 376         (docToSDoc (pprInstr instr) $$ ppr r_dying <+> ppr w_dying $$ ppr virt_read <+> ppr virt_written
 377                 $$ text (show freeregs) $$ ppr assig)
 378                 $ do
 379 -}
 380
 381     -- (b), (c) allocate real regs for all regs read by this instruction.
 382     (r_spills, r_allocd) <-
 383         allocateRegsAndSpill True{-reading-} virt_read [] [] virt_read
 384
 385     -- (d) Update block map for new destinations
 386     -- NB. do this before removing dead regs from the assignment, because
 387     -- these dead regs might in fact be live in the jump targets (they're
 388     -- only dead in the code that follows in the current basic block).
 389     (fixup_blocks, adjusted_instr)
 390         <- joinToTargets block_live block_id instr
 391
 392     -- (e) Delete all register assignments for temps which are read
 393     --     (only) and die here.  Update the free register list.
 394     releaseRegs r_dying
 395
 396     -- (f) Mark regs which are clobbered as unallocatable
 397     clobberRegs real_written
 398
 399     -- (g) Allocate registers for temporaries *written* (only)
 400     (w_spills, w_allocd) <-
 401         allocateRegsAndSpill False{-writing-} virt_written [] [] virt_written
 402
 403     -- (h) Release registers for temps which are written here and not
 404     -- used again.
 405     releaseRegs w_dying
 406
 407     let
 408         -- (i) Patch the instruction
 409         patch_map = listToUFM   [ (t,RealReg r) |
 410                                   (t,r) <- zip virt_read r_allocd
 411                                           ++ zip virt_written w_allocd ]
 412
 413         patched_instr = patchRegs adjusted_instr patchLookup
 414         patchLookup x = case lookupUFM patch_map x of
 415                                 Nothing -> x
 416                                 Just y  -> y
 417     -- in
 418
 419 --    pprTrace "patched" (docToSDoc (pprInstr patched_instr)) $ do
 420
 421     -- (j) free up stack slots for dead spilled regs
 422     -- TODO (can't be bothered right now)
 423
 424     -- erase reg->reg moves where the source and destination are the same.
 425     --  If the src temp didn't die in this instr but happened to be allocated
 426     --  to the same real reg as the destination, then we can erase the move anyway.
 427     let squashed_instr  = case isRegRegMove patched_instr of
 428                                 Just (src, dst)
 429                                  | src == dst   -> []
 430                                 _               -> [patched_instr]
 431
 432     let code = squashed_instr ++ w_spills ++ reverse r_spills
 433                 ++ clobber_saves ++ new_instrs
 434
 435 --    pprTrace "patched-code" ((vcat $ map (docToSDoc . pprInstr) code)) $ do
 436 --    pprTrace "pached-fixup" ((ppr fixup_blocks)) $ do
 437
 438     return (code, fixup_blocks)
 439
 440   }}
 441
 442 -- -----------------------------------------------------------------------------
 443 -- releaseRegs
 444
 445 releaseRegs regs = do
 446   assig <- getAssigR
 447   free <- getFreeRegsR
 448   loop assig free regs
 449  where
 450   loop _     free _ | free `seq` False = undefined
 451   loop assig free [] = do setAssigR assig; setFreeRegsR free; return ()
 452   loop assig free (RealReg r : rs) = loop assig (releaseReg r free) rs
 453   loop assig free (r:rs) =
 454      case lookupUFM assig r of
 455         Just (InBoth real _) -> loop (delFromUFM assig r) (releaseReg real free) rs
 456         Just (InReg real) -> loop (delFromUFM assig r) (releaseReg real free) rs
 457         _other            -> loop (delFromUFM assig r) free rs
 458
 459 -- -----------------------------------------------------------------------------
 460 -- Clobber real registers
 461
 462 {-
 463 For each temp in a register that is going to be clobbered:
 464   - if the temp dies after this instruction, do nothing
 465   - otherwise, put it somewhere safe (another reg if possible,
 466     otherwise spill and record InBoth in the assignment).
 467
 468 for allocateRegs on the temps *read*,
 469   - clobbered regs are allocatable.
 470
 471 for allocateRegs on the temps *written*,
 472   - clobbered regs are not allocatable.
 473 -}
 474
 475 saveClobberedTemps
 476    :: [RegNo]              -- real registers clobbered by this instruction
 477    -> [Reg]                -- registers which are no longer live after this insn
 478    -> RegM [Instr]         -- return: instructions to spill any temps that will
 479                            -- be clobbered.
 480
 481 saveClobberedTemps [] _ = return [] -- common case
 482 saveClobberedTemps clobbered dying =  do
 483   assig <- getAssigR
 484   let
 485         to_spill  = [ (temp,reg) | (temp, InReg reg) <- ufmToList assig,
 486                                    reg `elem` clobbered,
 487                                    temp `notElem` map getUnique dying  ]
 488   -- in
 489   (instrs,assig') <- clobber assig [] to_spill
 490   setAssigR assig'
 491   return instrs
 492  where
 493   clobber assig instrs [] = return (instrs,assig)
 494   clobber assig instrs ((temp,reg):rest)
 495     = do
 496         --ToDo: copy it to another register if possible
 497         (spill,slot) <- spillR (RealReg reg) temp
 498         recordSpill (SpillClobber temp)
 499
 500         let new_assign  = addToUFM assig temp (InBoth reg slot)
 501         clobber new_assign (spill : COMMENT (fsLit "spill clobber") : instrs) rest
 502
 503 clobberRegs :: [RegNo] -> RegM ()
 504 clobberRegs [] = return () -- common case
 505 clobberRegs clobbered = do
 506   freeregs <- getFreeRegsR
 507 --  setFreeRegsR $! foldr grabReg freeregs clobbered
 508   setFreeRegsR $! foldr allocateReg freeregs clobbered
 509
 510   assig <- getAssigR
 511   setAssigR $! clobber assig (ufmToList assig)
 512  where
 513     -- if the temp was InReg and clobbered, then we will have
 514     -- saved it in saveClobberedTemps above.  So the only case
 515     -- we have to worry about here is InBoth.  Note that this
 516     -- also catches temps which were loaded up during allocation
 517     -- of read registers, not just those saved in saveClobberedTemps.
 518   clobber assig [] = assig
 519   clobber assig ((temp, InBoth reg slot) : rest)
 520         | reg `elem` clobbered
 521         = clobber (addToUFM assig temp (InMem slot)) rest
 522   clobber assig (_:rest)
 523         = clobber assig rest
 524
 525 -- -----------------------------------------------------------------------------
 526 -- allocateRegsAndSpill
 527
 528 -- This function does several things:
 529 --   For each temporary referred to by this instruction,
 530 --   we allocate a real register (spilling another temporary if necessary).
 531 --   We load the temporary up from memory if necessary.
 532 --   We also update the register assignment in the process, and
 533 --   the list of free registers and free stack slots.
 534
 535 allocateRegsAndSpill
 536         :: Bool                 -- True <=> reading (load up spilled regs)
 537         -> [Reg]                -- don't push these out
 538         -> [Instr]              -- spill insns
 539         -> [RegNo]              -- real registers allocated (accum.)
 540         -> [Reg]                -- temps to allocate
 541         -> RegM ([Instr], [RegNo])
 542
 543 allocateRegsAndSpill _       _    spills alloc []
 544   = return (spills,reverse alloc)
 545
 546 allocateRegsAndSpill reading keep spills alloc (r:rs) = do
 547   assig <- getAssigR
 548   case lookupUFM assig r of
 549   -- case (1a): already in a register
 550      Just (InReg my_reg) ->
 551         allocateRegsAndSpill reading keep spills (my_reg:alloc) rs
 552
 553   -- case (1b): already in a register (and memory)
 554   -- NB1. if we're writing this register, update its assignemnt to be
 555   -- InReg, because the memory value is no longer valid.
 556   -- NB2. This is why we must process written registers here, even if they
 557   -- are also read by the same instruction.
 558      Just (InBoth my_reg _) -> do
 559         when (not reading) (setAssigR (addToUFM assig r (InReg my_reg)))
 560         allocateRegsAndSpill reading keep spills (my_reg:alloc) rs
 561
 562   -- Not already in a register, so we need to find a free one...
 563      loc -> do
 564         freeregs <- getFreeRegsR
 565
 566         case getFreeRegs (regClass r) freeregs of
 567
 568         -- case (2): we have a free register
 569           my_reg:_ -> {- pprTrace "alloc" (ppr r <+> ppr my_reg <+> ppr freeClass) $ -}
 570             do
 571             spills'   <- loadTemp reading r loc my_reg spills
 572             let new_loc
 573                  | Just (InMem slot) <- loc, reading = InBoth my_reg slot
 574                  | otherwise                         = InReg my_reg
 575             setAssigR (addToUFM assig r $! new_loc)
 576             setFreeRegsR $ allocateReg my_reg freeregs
 577             allocateRegsAndSpill reading keep spills' (my_reg:alloc) rs
 578
 579         -- case (3): we need to push something out to free up a register
 580           [] -> do
 581             let
 582               keep' = map getUnique keep
 583               candidates1 = [ (temp,reg,mem)
 584                             | (temp, InBoth reg mem) <- ufmToList assig,
 585                               temp `notElem` keep', regClass (RealReg reg) == regClass r ]
 586               candidates2 = [ (temp,reg)
 587                             | (temp, InReg reg) <- ufmToList assig,
 588                               temp `notElem` keep', regClass (RealReg reg) == regClass r  ]
 589             -- in
 590             ASSERT2(not (null candidates1 && null candidates2),
 591                     text (show freeregs) <+> ppr r <+> ppr assig) do
 592
 593             case candidates1 of
 594
 595              -- we have a temporary that is in both register and mem,
 596              -- just free up its register for use.
 597              --
 598              (temp,my_reg,slot):_ -> do
 599                 spills' <- loadTemp reading r loc my_reg spills
 600                 let
 601                   assig1  = addToUFM assig temp (InMem slot)
 602                   assig2  = addToUFM assig1 r (InReg my_reg)
 603                 -- in
 604                 setAssigR assig2
 605                 allocateRegsAndSpill reading keep spills' (my_reg:alloc) rs
 606
 607              -- otherwise, we need to spill a temporary that currently
 608              -- resides in a register.
 609
 610
 611              [] -> do
 612
 613                 -- TODO: plenty of room for optimisation in choosing which temp
 614                 -- to spill.  We just pick the first one that isn't used in
 615                 -- the current instruction for now.
 616
 617                 let (temp_to_push_out, my_reg)
 618                         = case candidates2 of
 619                                 []      -> panic $ "RegAllocLinear.allocRegsAndSpill: no spill candidates"
 620                                         ++ "assignment: " ++ show (ufmToList assig) ++ "\n"
 621                                 (x:_)   -> x
 622
 623                 (spill_insn, slot) <- spillR (RealReg my_reg) temp_to_push_out
 624                 let spill_store  = (if reading then id else reverse)
 625                                         [ COMMENT (fsLit "spill alloc")
 626                                         , spill_insn ]
 627
 628                 -- record that this temp was spilled
 629                 recordSpill (SpillAlloc temp_to_push_out)
 630
 631                 -- update the register assignment
 632                 let assig1  = addToUFM assig temp_to_push_out   (InMem slot)
 633                 let assig2  = addToUFM assig1 r                 (InReg my_reg)
 634                 setAssigR assig2
 635
 636                 -- if need be, load up a spilled temp into the reg we've just freed up.
 637                 spills' <- loadTemp reading r loc my_reg spills
 638
 639                 allocateRegsAndSpill reading keep
 640                         (spill_store ++ spills')
 641                         (my_reg:alloc) rs
 642
 643
 644 -- | Load up a spilled temporary if we need to.
 645 loadTemp
 646         :: Bool
 647         -> Reg          -- the temp being loaded
 648         -> Maybe Loc    -- the current location of this temp
 649         -> RegNo        -- the hreg to load the temp into
 650         -> [Instr]
 651         -> RegM [Instr]
 652
 653 loadTemp True vreg (Just (InMem slot)) hreg spills
 654  = do
 655         insn <- loadR (RealReg hreg) slot
 656         recordSpill (SpillLoad $ getUnique vreg)
 657         return  $  COMMENT (fsLit "spill load") : insn : spills
 658
 659 loadTemp _ _ _ _ spills =
 660    return spills
 661