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   let process [] []         accum = return $ reverse accum
 198             process [] next_round accum = process next_round [] accum
 199             process (b@(BasicBlock id _) : blocks) next_round accum =
 200               do block_assig <- getBlockAssigR
 201                  if isJust (lookupBlockEnv block_assig id) || id == first_id
 202                   then do b'  <- processBlock block_live b
 203                           process blocks next_round (b' : accum)
 204                   else process blocks (b : next_round) accum
 205         blockss' <- process blocks [] (return [])
 206         linearRA_SCCs first_id block_live
 207                 (reverse (concat blockss') ++ blocksAcc)
 208                 sccs
 209
 210
 211 -- | Do register allocation on this basic block
 212 --
 213 processBlock
 214         :: BlockMap RegSet              -- ^ live regs on entry to each basic block
 215         -> LiveBasicBlock               -- ^ block to do register allocation on
 216         -> RegM [NatBasicBlock]         -- ^ block with registers allocated
 217
 218 processBlock block_live (BasicBlock id instrs)
 219  = do   initBlock id
 220         (instrs', fixups)
 221                 <- linearRA block_live [] [] id instrs
 222
 223         return  $ BasicBlock id instrs' : fixups
 224
 225
 226 -- | Load the freeregs and current reg assignment into the RegM state
 227 --      for the basic block with this BlockId.
 228 initBlock :: BlockId -> RegM ()
 229 initBlock id
 230  = do   block_assig     <- getBlockAssigR
 231         case lookupBlockEnv block_assig id of
 232                 -- no prior info about this block: assume everything is
 233                 -- free and the assignment is empty.
 234                 Nothing
 235                  -> do  setFreeRegsR    initFreeRegs
 236                         setAssigR       emptyRegMap
 237
 238                 -- load info about register assignments leading into this block.
 239                 Just (freeregs, assig)
 240                  -> do  setFreeRegsR    freeregs
 241                         setAssigR       assig
 242
 243
 244 -- | Do allocation for a sequence of instructions.
 245 linearRA
 246         :: BlockMap RegSet              -- ^ map of what vregs are live on entry to each block.
 247         -> [Instr]                      -- ^ accumulator for instructions already processed.
 248         -> [NatBasicBlock]              -- ^ accumulator for blocks of fixup code.
 249         -> BlockId                      -- ^ id of the current block, for debugging.
 250         -> [LiveInstr]                  -- ^ liveness annotated instructions in this block.
 251
 252         -> RegM ( [Instr]               --   instructions after register allocation
 253                 , [NatBasicBlock])      --   fresh blocks of fixup code.
 254
 255
 256 linearRA _          accInstr accFixup _ []
 257         = return
 258                 ( reverse accInstr      -- instrs need to be returned in the correct order.
 259                 , accFixup)             -- it doesn't matter what order the fixup blocks are returned in.
 260
 261
 262 linearRA block_live accInstr accFixups id (instr:instrs)
 263  = do
 264         (accInstr', new_fixups)
 265                 <- raInsn block_live accInstr id instr
 266
 267         linearRA block_live accInstr' (new_fixups ++ accFixups) id instrs
 268
 269
 270 -- | Do allocation for a single instruction.
 271 raInsn
 272         :: BlockMap RegSet              -- ^ map of what vregs are love on entry to each block.
 273         -> [Instr]                      -- ^ accumulator for instructions already processed.
 274         -> BlockId                      -- ^ the id of the current block, for debugging
 275         -> LiveInstr                    -- ^ the instr to have its regs allocated, with liveness info.
 276         -> RegM
 277                 ( [Instr]               -- new instructions
 278                 , [NatBasicBlock])      -- extra fixup blocks
 279
 280 raInsn _     new_instrs _ (Instr (COMMENT _) Nothing)
 281  = return (new_instrs, [])
 282
 283 raInsn _     new_instrs _ (Instr (DELTA n) Nothing)
 284  = do
 285     setDeltaR n
 286     return (new_instrs, [])
 287
 288 raInsn block_live new_instrs id (Instr instr (Just live))
 289  = do
 290     assig    <- getAssigR
 291
 292     -- If we have a reg->reg move between virtual registers, where the
 293     -- src register is not live after this instruction, and the dst
 294     -- register does not already have an assignment,
 295     -- and the source register is assigned to a register, not to a spill slot,
 296     -- then we can eliminate the instruction.
 297     -- (we can't eliminitate it if the source register is on the stack, because
 298     --  we do not want to use one spill slot for different virtual registers)
 299     case isRegRegMove instr of
 300         Just (src,dst)  | src `elementOfUniqSet` (liveDieRead live),
 301                           isVirtualReg dst,
 302                           not (dst `elemUFM` assig),
 303                           Just (InReg _) <- (lookupUFM assig src) -> do
 304            case src of
 305               RealReg i -> setAssigR (addToUFM assig dst (InReg i))
 306                 -- if src is a fixed reg, then we just map dest to this
 307                 -- reg in the assignment.  src must be an allocatable reg,
 308                 -- otherwise it wouldn't be in r_dying.
 309               _virt -> case lookupUFM assig src of
 310                          Nothing -> panic "raInsn"
 311                          Just loc ->
 312                            setAssigR (addToUFM (delFromUFM assig src) dst loc)
 313
 314            -- we have eliminated this instruction
 315           {-
 316           freeregs <- getFreeRegsR
 317           assig <- getAssigR
 318           pprTrace "raInsn" (text "ELIMINATED: " <> docToSDoc (pprInstr instr)
 319                         $$ ppr r_dying <+> ppr w_dying $$ text (show freeregs) $$ ppr assig) $ do
 320           -}
 321            return (new_instrs, [])
 322
 323         _ -> genRaInsn block_live new_instrs id instr
 324                         (uniqSetToList $ liveDieRead live)
 325                         (uniqSetToList $ liveDieWrite live)
 326
 327
 328 raInsn _ _ _ instr
 329         = pprPanic "raInsn" (text "no match for:" <> ppr instr)
 330
 331
 332
 333
 334 genRaInsn block_live new_instrs block_id instr r_dying w_dying =
 335     case regUsage instr              of { RU read written ->
 336     case partition isRealReg written of { (real_written1,virt_written) ->
 337     do
 338     let
 339         real_written = [ r | RealReg r <- real_written1 ]
 340
 341         -- we don't need to do anything with real registers that are
 342         -- only read by this instr.  (the list is typically ~2 elements,
 343         -- so using nub isn't a problem).
 344         virt_read = nub (filter isVirtualReg read)
 345     -- in
 346
 347     -- (a) save any temporaries which will be clobbered by this instruction
 348     clobber_saves <- saveClobberedTemps real_written r_dying
 349
 350
 351 {-  freeregs <- getFreeRegsR
 352     assig <- getAssigR
 353     pprTrace "raInsn"
 354         (docToSDoc (pprInstr instr) $$ ppr r_dying <+> ppr w_dying $$ ppr virt_read <+> ppr virt_written
 355                 $$ text (show freeregs) $$ ppr assig)
 356                 $ do
 357 -}
 358
 359     -- (b), (c) allocate real regs for all regs read by this instruction.
 360     (r_spills, r_allocd) <-
 361         allocateRegsAndSpill True{-reading-} virt_read [] [] virt_read
 362
 363     -- (d) Update block map for new destinations
 364     -- NB. do this before removing dead regs from the assignment, because
 365     -- these dead regs might in fact be live in the jump targets (they're
 366     -- only dead in the code that follows in the current basic block).
 367     (fixup_blocks, adjusted_instr)
 368         <- joinToTargets block_live block_id instr
 369
 370     -- (e) Delete all register assignments for temps which are read
 371     --     (only) and die here.  Update the free register list.
 372     releaseRegs r_dying
 373
 374     -- (f) Mark regs which are clobbered as unallocatable
 375     clobberRegs real_written
 376
 377     -- (g) Allocate registers for temporaries *written* (only)
 378     (w_spills, w_allocd) <-
 379         allocateRegsAndSpill False{-writing-} virt_written [] [] virt_written
 380
 381     -- (h) Release registers for temps which are written here and not
 382     -- used again.
 383     releaseRegs w_dying
 384
 385     let
 386         -- (i) Patch the instruction
 387         patch_map = listToUFM   [ (t,RealReg r) |
 388                                   (t,r) <- zip virt_read r_allocd
 389                                           ++ zip virt_written w_allocd ]
 390
 391         patched_instr = patchRegs adjusted_instr patchLookup
 392         patchLookup x = case lookupUFM patch_map x of
 393                                 Nothing -> x
 394                                 Just y  -> y
 395     -- in
 396
 397     -- pprTrace "patched" (docToSDoc (pprInstr patched_instr)) $ do
 398
 399     -- (j) free up stack slots for dead spilled regs
 400     -- TODO (can't be bothered right now)
 401
 402     -- erase reg->reg moves where the source and destination are the same.
 403     --  If the src temp didn't die in this instr but happened to be allocated
 404     --  to the same real reg as the destination, then we can erase the move anyway.
 405         squashed_instr  = case isRegRegMove patched_instr of
 406                                 Just (src, dst)
 407                                  | src == dst   -> []
 408                                 _               -> [patched_instr]
 409
 410     return (squashed_instr ++ w_spills ++ reverse r_spills
 411                  ++ clobber_saves ++ new_instrs,
 412             fixup_blocks)
 413   }}
 414
 415 -- -----------------------------------------------------------------------------
 416 -- releaseRegs
 417
 418 releaseRegs regs = do
 419   assig <- getAssigR
 420   free <- getFreeRegsR
 421   loop assig free regs
 422  where
 423   loop _     free _ | free `seq` False = undefined
 424   loop assig free [] = do setAssigR assig; setFreeRegsR free; return ()
 425   loop assig free (RealReg r : rs) = loop assig (releaseReg r free) rs
 426   loop assig free (r:rs) =
 427      case lookupUFM assig r of
 428         Just (InBoth real _) -> loop (delFromUFM assig r) (releaseReg real free) rs
 429         Just (InReg real) -> loop (delFromUFM assig r) (releaseReg real free) rs
 430         _other            -> loop (delFromUFM assig r) free rs
 431
 432 -- -----------------------------------------------------------------------------
 433 -- Clobber real registers
 434
 435 {-
 436 For each temp in a register that is going to be clobbered:
 437   - if the temp dies after this instruction, do nothing
 438   - otherwise, put it somewhere safe (another reg if possible,
 439     otherwise spill and record InBoth in the assignment).
 440
 441 for allocateRegs on the temps *read*,
 442   - clobbered regs are allocatable.
 443
 444 for allocateRegs on the temps *written*,
 445   - clobbered regs are not allocatable.
 446 -}
 447
 448 saveClobberedTemps
 449    :: [RegNo]              -- real registers clobbered by this instruction
 450    -> [Reg]                -- registers which are no longer live after this insn
 451    -> RegM [Instr]         -- return: instructions to spill any temps that will
 452                            -- be clobbered.
 453
 454 saveClobberedTemps [] _ = return [] -- common case
 455 saveClobberedTemps clobbered dying =  do
 456   assig <- getAssigR
 457   let
 458         to_spill  = [ (temp,reg) | (temp, InReg reg) <- ufmToList assig,
 459                                    reg `elem` clobbered,
 460                                    temp `notElem` map getUnique dying  ]
 461   -- in
 462   (instrs,assig') <- clobber assig [] to_spill
 463   setAssigR assig'
 464   return instrs
 465  where
 466   clobber assig instrs [] = return (instrs,assig)
 467   clobber assig instrs ((temp,reg):rest)
 468     = do
 469         --ToDo: copy it to another register if possible
 470         (spill,slot) <- spillR (RealReg reg) temp
 471         recordSpill (SpillClobber temp)
 472
 473         let new_assign  = addToUFM assig temp (InBoth reg slot)
 474         clobber new_assign (spill : COMMENT (fsLit "spill clobber") : instrs) rest
 475
 476 clobberRegs :: [RegNo] -> RegM ()
 477 clobberRegs [] = return () -- common case
 478 clobberRegs clobbered = do
 479   freeregs <- getFreeRegsR
 480 --  setFreeRegsR $! foldr grabReg freeregs clobbered
 481   setFreeRegsR $! foldr allocateReg freeregs clobbered
 482
 483   assig <- getAssigR
 484   setAssigR $! clobber assig (ufmToList assig)
 485  where
 486     -- if the temp was InReg and clobbered, then we will have
 487     -- saved it in saveClobberedTemps above.  So the only case
 488     -- we have to worry about here is InBoth.  Note that this
 489     -- also catches temps which were loaded up during allocation
 490     -- of read registers, not just those saved in saveClobberedTemps.
 491   clobber assig [] = assig
 492   clobber assig ((temp, InBoth reg slot) : rest)
 493         | reg `elem` clobbered
 494         = clobber (addToUFM assig temp (InMem slot)) rest
 495   clobber assig (_:rest)
 496         = clobber assig rest
 497
 498 -- -----------------------------------------------------------------------------
 499 -- allocateRegsAndSpill
 500
 501 -- This function does several things:
 502 --   For each temporary referred to by this instruction,
 503 --   we allocate a real register (spilling another temporary if necessary).
 504 --   We load the temporary up from memory if necessary.
 505 --   We also update the register assignment in the process, and
 506 --   the list of free registers and free stack slots.
 507
 508 allocateRegsAndSpill
 509         :: Bool                 -- True <=> reading (load up spilled regs)
 510         -> [Reg]                -- don't push these out
 511         -> [Instr]              -- spill insns
 512         -> [RegNo]              -- real registers allocated (accum.)
 513         -> [Reg]                -- temps to allocate
 514         -> RegM ([Instr], [RegNo])
 515
 516 allocateRegsAndSpill _       _    spills alloc []
 517   = return (spills,reverse alloc)
 518
 519 allocateRegsAndSpill reading keep spills alloc (r:rs) = do
 520   assig <- getAssigR
 521   case lookupUFM assig r of
 522   -- case (1a): already in a register
 523      Just (InReg my_reg) ->
 524         allocateRegsAndSpill reading keep spills (my_reg:alloc) rs
 525
 526   -- case (1b): already in a register (and memory)
 527   -- NB1. if we're writing this register, update its assignemnt to be
 528   -- InReg, because the memory value is no longer valid.
 529   -- NB2. This is why we must process written registers here, even if they
 530   -- are also read by the same instruction.
 531      Just (InBoth my_reg _) -> do
 532         when (not reading) (setAssigR (addToUFM assig r (InReg my_reg)))
 533         allocateRegsAndSpill reading keep spills (my_reg:alloc) rs
 534
 535   -- Not already in a register, so we need to find a free one...
 536      loc -> do
 537         freeregs <- getFreeRegsR
 538
 539         case getFreeRegs (regClass r) freeregs of
 540
 541         -- case (2): we have a free register
 542           my_reg:_ -> {- pprTrace "alloc" (ppr r <+> ppr my_reg <+> ppr freeClass) $ -}
 543             do
 544             spills'   <- loadTemp reading r loc my_reg spills
 545             let new_loc
 546                  | Just (InMem slot) <- loc, reading = InBoth my_reg slot
 547                  | otherwise                         = InReg my_reg
 548             setAssigR (addToUFM assig r $! new_loc)
 549             setFreeRegsR $ allocateReg my_reg freeregs
 550             allocateRegsAndSpill reading keep spills' (my_reg:alloc) rs
 551
 552         -- case (3): we need to push something out to free up a register
 553           [] -> do
 554             let
 555               keep' = map getUnique keep
 556               candidates1 = [ (temp,reg,mem)
 557                             | (temp, InBoth reg mem) <- ufmToList assig,
 558                               temp `notElem` keep', regClass (RealReg reg) == regClass r ]
 559               candidates2 = [ (temp,reg)
 560                             | (temp, InReg reg) <- ufmToList assig,
 561                               temp `notElem` keep', regClass (RealReg reg) == regClass r  ]
 562             -- in
 563             ASSERT2(not (null candidates1 && null candidates2),
 564                     text (show freeregs) <+> ppr r <+> ppr assig) do
 565
 566             case candidates1 of
 567
 568              -- we have a temporary that is in both register and mem,
 569              -- just free up its register for use.
 570              --
 571              (temp,my_reg,slot):_ -> do
 572                 spills' <- loadTemp reading r loc my_reg spills
 573                 let
 574                   assig1  = addToUFM assig temp (InMem slot)
 575                   assig2  = addToUFM assig1 r (InReg my_reg)
 576                 -- in
 577                 setAssigR assig2
 578                 allocateRegsAndSpill reading keep spills' (my_reg:alloc) rs
 579
 580              -- otherwise, we need to spill a temporary that currently
 581              -- resides in a register.
 582
 583
 584              [] -> do
 585
 586                 -- TODO: plenty of room for optimisation in choosing which temp
 587                 -- to spill.  We just pick the first one that isn't used in
 588                 -- the current instruction for now.
 589
 590                 let (temp_to_push_out, my_reg)
 591                         = case candidates2 of
 592                                 []      -> panic $ "RegAllocLinear.allocRegsAndSpill: no spill candidates"
 593                                         ++ "assignment: " ++ show (ufmToList assig) ++ "\n"
 594                                 (x:_)   -> x
 595
 596                 (spill_insn, slot) <- spillR (RealReg my_reg) temp_to_push_out
 597                 let spill_store  = (if reading then id else reverse)
 598                                         [ COMMENT (fsLit "spill alloc")
 599                                         , spill_insn ]
 600
 601                 -- record that this temp was spilled
 602                 recordSpill (SpillAlloc temp_to_push_out)
 603
 604                 -- update the register assignment
 605                 let assig1  = addToUFM assig temp_to_push_out   (InMem slot)
 606                 let assig2  = addToUFM assig1 r                 (InReg my_reg)
 607                 setAssigR assig2
 608
 609                 -- if need be, load up a spilled temp into the reg we've just freed up.
 610                 spills' <- loadTemp reading r loc my_reg spills
 611
 612                 allocateRegsAndSpill reading keep
 613                         (spill_store ++ spills')
 614                         (my_reg:alloc) rs
 615
 616
 617 -- | Load up a spilled temporary if we need to.
 618 loadTemp
 619         :: Bool
 620         -> Reg          -- the temp being loaded
 621         -> Maybe Loc    -- the current location of this temp
 622         -> RegNo        -- the hreg to load the temp into
 623         -> [Instr]
 624         -> RegM [Instr]
 625
 626 loadTemp True vreg (Just (InMem slot)) hreg spills
 627  = do
 628         insn <- loadR (RealReg hreg) slot
 629         recordSpill (SpillLoad $ getUnique vreg)
 630         return  $  COMMENT (fsLit "spill load") : insn : spills
 631
 632 loadTemp _ _ _ _ spills =
 633    return spills
 634